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 6e 65 20 7b 7d 7d 5d 0a 73 hread] ne {}}].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: 6e 65 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 ne {}}]..#.# 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 65 71 20 22 22 7d 20 7b 0a {$cmd eq ""} {.
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 6e 65 20 22 6d 61 63 69 6e 74 6f 73 rm) ne "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 65 71 ommands exec] eq
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 24 6c 69 6e 65 20 .. if {$line
1e30: 65 71 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 eq "--Marker--Ma
1e40: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d rker--Marker--"}
1e50: 20 7b 0a 09 09 69 66 20 7b 5b 6c 69 6e 64 65 78 {...if {[lindex
1e60: 20 24 72 65 73 70 20 30 5d 20 65 71 20 22 65 72 $resp 0] eq "er
1e70: 72 6f 72 22 7d 20 7b 0a 09 09 20 20 20 20 65 72 ror"} {... er
1e80: 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 ror [lindex $res
1e90: 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a p 1]...} else {.
1ea0: 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 .. return [li
1eb0: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
1ec0: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
1ed0: 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c ..append resp $l
1ee0: 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a ine "\n".. }.
1ef0: 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 .}. }.. se
1f00: 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 ndCommand [list
1f10: 70 72 6f 63 20 64 70 75 74 73 20 5b 69 6e 66 6f proc dputs [info
1f20: 20 61 72 67 73 20 64 70 75 74 73 5d 20 5b 69 6e args dputs] [in
1f30: 66 6f 20 62 6f 64 79 20 64 70 75 74 73 5d 5d 0a fo body dputs]].
1f40: 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 65 . proc sendCe
1f50: 72 74 56 61 6c 75 65 73 20 7b 7d 20 7b 0a 09 23 rtValues {} {..#
1f60: 20 57 65 20 6e 65 65 64 20 74 6f 20 62 65 20 61 We need to be a
1f70: 62 6c 65 20 74 6f 20 73 65 6e 64 20 63 65 72 74 ble to send cert
1f80: 69 66 69 63 61 74 65 20 76 61 6c 75 65 73 20 74 ificate values t
1f90: 68 61 74 20 6e 6f 72 6d 61 6c 69 7a 65 0a 09 23 hat normalize..#
1fa0: 20 66 69 6c 65 6e 61 6d 65 73 20 61 63 72 6f 73 filenames acros
1fb0: 73 20 70 6c 61 74 66 6f 72 6d 73 0a 09 73 65 6e s platforms..sen
1fc0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 dCommand {..
1fd0: 73 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69 set certsDir.[fi
1fe0: 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 le join [file di
1ff0: 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 rname [info scri
2000: 70 74 5d 5d 20 63 65 72 74 73 5d 0a 09 20 20 20 pt]] certs]..
2010: 20 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 set serverCert.
2020: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
2030: 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d sDir server.pem]
2040: 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 6e 74 .. set client
2050: 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 Cert.[file join
2060: 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 $certsDir client
2070: 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 .pem].. set c
2080: 61 43 65 72 74 09 09 5b 66 69 6c 65 20 6a 6f 69 aCert..[file joi
2090: 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 63 65 n $certsDir cace
20a0: 72 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 rt.pem].. set
20b0: 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 serverKey.[file
20c0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
20d0: 73 65 72 76 65 72 2e 6b 65 79 5d 0a 09 20 20 20 server.key]..
20e0: 20 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 09 5b set clientKey.[
20f0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
2100: 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 5d 0a Dir client.key].
2110: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 .}. }.}..test
2120: 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 67 20 tlsIO-1.1 {arg
2130: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2140: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2150: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2160: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2170: 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 ket -server} msg
2180: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2190: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
21a0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
21b0: 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e t -server comman
21c0: 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 d ?options? port
21d0: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
21e0: 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.2 {arg parsing
21f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2200: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2210: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2220: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2230: 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 rver foo} msg] $
2240: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2250: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2260: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2270: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2280: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
2290: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 33 ..test tlsIO-1.3
22a0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
22b0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
22c0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
22d0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
22e0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
22f0: 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b r} msg] $msg.} {
2300: 31 20 7b 22 2d 6d 79 61 64 64 72 22 20 6f 70 74 1 {"-myaddr" opt
2310: 69 6f 6e 20 6d 75 73 74 20 62 65 20 66 6f 6c 6c ion must be foll
2320: 6f 77 65 64 20 62 79 20 76 61 6c 75 65 7d 7d 0a owed by value}}.
2330: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 20 .test tlsIO-1.4
2340: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2350: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2360: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2370: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2380: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 ::socket -myaddr
2390: 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 127.0.0.1} msg]
23a0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
23b0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
23c0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
23d0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
23e0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
23f0: 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 sIO-1.5 {arg par
2400: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2410: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2420: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2430: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2440: 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 -myport} msg] $
2450: 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d 6d 79 70 6f msg.} {1 {"-mypo
2460: 72 74 22 20 6f 70 74 69 6f 6e 20 6d 75 73 74 20 rt" option must
2470: 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 20 76 be followed by v
2480: 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 alue}}..test tls
2490: 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 IO-1.6 {arg pars
24a0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
24b0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
24c0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
24d0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
24e0: 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 -myport xxxx} ms
24f0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2500: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2510: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2520: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2530: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2540: 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 tlsIO-1.7 {arg p
2550: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2560: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2570: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2580: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2590: 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d et -myport 2522}
25a0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
25b0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
25c0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
25d0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
25e0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
25f0: 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 st tlsIO-1.8 {ar
2600: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2610: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 2d 63 cket command} -c
2620: 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b onstraints {sock
2630: 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 et} -body {.
2640: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2650: 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a ::socket -froboz
2660: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d } msg] $msg.} -m
2670: 61 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 75 6c atch glob -resul
2680: 74 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 6f 6e t {1 {bad option
2690: 20 22 2d 66 72 6f 62 6f 7a 22 3a 20 6d 75 73 74 "-froboz": must
26a0: 20 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a be one of *}}..
26b0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 7b test tlsIO-1.9 {
26c0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
26d0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
26e0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
26f0: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
2700: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2710: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2720: 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 er foo -myport 2
2730: 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 521 3333} msg] $
2740: 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 6c 6f msg.} -match glo
2750: 62 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b 62 61 b -result {1 {ba
2760: 64 20 6f 70 74 69 6f 6e 20 22 2d 6d 79 70 6f 72 d option "-mypor
2770: 74 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 t": must be one
2780: 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 of *}}..test tls
2790: 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 72 IO-1.10 {arg par
27a0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
27b0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
27c0: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
27d0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
27e0: 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b host 2528 -junk
27f0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2800: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2810: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2820: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2830: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2840: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 20 7b est tlsIO-1.11 {
2850: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2860: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2870: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2880: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2890: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
28a0: 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d callback 2520 --
28b0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
28c0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
28d0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
28e0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
28f0: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2900: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2910: 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 20 70 lsIO-1.12 {arg p
2920: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2930: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2940: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2950: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2960: 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 et foo badport}
2970: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2980: 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 expected integer
2990: 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 but got "badpor
29a0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
29b0: 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.1 {tcp connec
29c0: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 tion} {socket st
29d0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
29e0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
29f0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2a00: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2a10: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
2a20: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
2a30: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
2a40: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2a50: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2a60: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2a70: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
2a80: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2a90: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2aa0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2ab0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2ac0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2ad0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2ae0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2af0: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
2b00: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2b10: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
2b20: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
2b30: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
2b40: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
2b50: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
2b60: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2b70: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2b80: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2b90: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
2ba0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2bb0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2bc0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
2bd0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
2be0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
2bf0: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
2c00: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2c10: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
2c20: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2c30: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2c40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2c50: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
2c60: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
2c70: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
2c80: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
2c90: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2ca0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2cb0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
2cc0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
2cd0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
2ce0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
2cf0: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 ady done {}}..if
2d00: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f [info exists po
2d10: 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 rt] {. incr p
2d20: 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 ort.} else {.
2d30: 20 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 set port [expr
2d40: 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 {$tlsServerPort
2d50: 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a 7d + [pid]%1024}].}
2d60: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 ..test tlsIO-2.2
2d70: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2d80: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 with client por
2d90: 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f t specified} {so
2da0: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
2db0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
2dc0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
2dd0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
2de0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
2df0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
2e00: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
2e10: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
2e20: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2e30: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2e40: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
2e50: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
2e60: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
2e70: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2e80: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
2e90: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2ea0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2eb0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2ec0: 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 y 8829 \]". p
2ed0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2ee0: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
2ef0: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
2f00: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
2f10: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
2f20: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 6f [gets $sock] $po
2f30: 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 rt".
2f40: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
2f50: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
2f60: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
2f70: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
2f80: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
2f90: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
2fa0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2fb0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
2fc0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
2fd0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
2fe0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
2ff0: 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f x. global po
3000: 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 rt. if {[catc
3010: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
3020: 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 myport $port \..
3030: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3040: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3050: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
3060: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3070: 2e 30 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 .0.0.1 8829} soc
3080: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
3090: 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 t x $sock..catch
30a0: 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f {close [tls::so
30b0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
30c0: 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 829]}. } else
30d0: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
30e0: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
30f0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
3100: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3110: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3120: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3130: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3140: 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 set x.} [list re
3150: 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 ady "hello $port
3160: 22 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 "]..test tlsIO-2
3170: 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .3 {tcp connecti
3180: 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 on with client i
3190: 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 nterface specifi
31a0: 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ed} {socket stdi
31b0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
31c0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
31d0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
31e0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
31f0: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
3200: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
3210: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3220: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3230: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
3240: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3250: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3260: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3270: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3280: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3290: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
32a0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
32b0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
32c0: 65 72 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d erverKey 8830 \]
32d0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
32e0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
32f0: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
3300: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
3310: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
3320: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
3330: 63 6b 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 ck] $addr".
3340: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
3350: 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 ck. s
3360: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
3370: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
3380: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3390: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
33a0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
33b0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
33c0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
33d0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
33e0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
33f0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
3400: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3410: 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 ocket -myaddr 12
3420: 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 72 74 7.0.0.1 \..-cert
3430: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3440: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3450: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3460: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3470: 31 20 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 1 8830} sock]} {
3480: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
3490: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
34a0: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
34b0: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 63 sock hello..catc
34c0: 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d 0a h {flush $sock}.
34d0: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
34e0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
34f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3500: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3510: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
3520: 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 37 ready {hello 127
3530: 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 74 .0.0.1}}..test t
3540: 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 6f lsIO-2.4 {tcp co
3550: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 73 65 nnection with se
3560: 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 20 73 rver interface s
3570: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
3580: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
3590: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
35a0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
35b0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
35c0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
35d0: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
35e0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
35f0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
3600: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
3610: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3620: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
3630: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
3640: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
3650: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
3660: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
3670: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
3680: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
3690: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d ile $serverKey -
36a0: 6d 79 61 64 64 72 20 6c 6f 63 61 6c 68 6f 73 74 myaddr localhost
36b0: 20 38 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 8831 \]". pu
36c0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
36d0: 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 cept {sock addr
36e0: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
36f0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
3700: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
3710: 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 gets $sock]".
3720: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
3730: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 sock.
3740: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
3750: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3760: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3770: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3780: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
3790: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
37a0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
37b0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
37c0: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
37d0: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
37e0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
37f0: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
3800: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3810: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3820: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3830: 74 4b 65 79 20 6c 6f 63 61 6c 68 6f 73 74 20 38 tKey localhost 8
3840: 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 831} sock]} {.
3850: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
3860: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 k. } else {.
3870: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 puts $soc
3880: 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 k hello..flush $
3890: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 sock. lap
38a0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
38b0: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
38c0: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
38d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
38e0: 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f x.} {ready hello
38f0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3900: 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 5 {tcp connectio
3910: 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 6e 74 n with redundant
3920: 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 7b 73 server port} {s
3930: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3940: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3950: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3960: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3970: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
3980: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
3990: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
39a0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
39b0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
39c0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
39d0: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
39e0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
39f0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3a00: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3a10: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3a20: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3a30: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
3a40: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
3a50: 65 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 ey 8832 \]".
3a60: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3a70: 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 accept {sock add
3a80: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
3a90: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3aa0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
3ab0: 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 "[gets $sock]".
3ac0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
3ad0: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 $sock.
3ae0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
3af0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
3b00: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
3b10: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
3b20: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
3b30: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3b40: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
3b50: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3b60: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3b70: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
3b80: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
3b90: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3ba0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3bb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3bc0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3bd0: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
3be0: 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8832} sock]} {.
3bf0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
3c00: 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ock. } else {
3c10: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
3c20: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
3c30: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
3c40: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3c50: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
3c60: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3c70: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3c80: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c t x.} {ready hel
3c90: 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 lo}.test tlsIO-2
3ca0: 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .6 {tcp connecti
3cb0: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 on} {socket} {.
3cc0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b set status ok
3cd0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
3ce0: 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a {set sock [tls:
3cf0: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
3d00: 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 1 8833]}]} {..if
3d10: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
3d20: 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 $sock}]} {..
3d30: 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 set status broke
3d40: 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 n..}..close $soc
3d50: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 k. }. set
3d60: 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 status.} ok..tes
3d70: 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 t tlsIO-2.7 {ech
3d80: 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 o server, one li
3d90: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ne} {socket stdi
3da0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
3db0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
3dc0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
3dd0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
3de0: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
3df0: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
3e00: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3e10: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3e20: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
3e30: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3e40: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3e50: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3e60: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3e70: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3e80: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
3e90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3ea0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
3eb0: 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c 5d erverKey 8834 \]
3ec0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3ed0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
3ee0: 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 a p} {.
3ef0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
3f00: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
3f10: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
3f20: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
3f30: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
3f40: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
3f50: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
3f60: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 20 {s} {.. set
3f70: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
3f80: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
3f90: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
3fa0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3fb0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
3fc0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
3fe0: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
3ff0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 } else {.
4000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4010: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
4020: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 }..}..pu
4030: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
4040: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
4050: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
4060: 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 ..puts done.
4070: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
4080: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
4090: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
40a0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
40b0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
40c0: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
40d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
40e0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
40f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4100: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
4110: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
4120: 20 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 8834]. fconf
4130: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
4140: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
4150: 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 ation lf. put
4160: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
4170: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 efghijklmnop".
4180: 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 after 1000.
4190: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d set x [gets $s]
41a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
41b0: 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 set y [gets $f
41c0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
41d0: 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 list $x $y.}
41e0: 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 {{hello abcdefgh
41f0: 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a ijklmnop} done}.
4200: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 .test tlsIO-2.8
4210: 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f {echo server, lo
4220: 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e op 50 times, sin
4230: 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 gle connection}
4240: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
4250: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4260: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4270: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
4280: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
4290: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
42a0: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
42b0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
42c0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
42d0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
42e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
42f0: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
4300: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
4310: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
4320: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
4330: 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 35 \]". puts
4340: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
4350: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
4360: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
4370: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
4380: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
4390: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
43a0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
43b0: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
43c0: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
43d0: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
43e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
43f0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
4400: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
4410: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
4420: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
4430: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
4440: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
4470: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
4480: 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 .. incr
4490: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
44a0: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
44b0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
44c0: 09 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 .set i 0..puts r
44d0: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
44e0: 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 [after 20000 "se
44f0: 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 t x done"]..vwai
4500: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
4510: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
4520: 24 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 $f..puts "done $
4530: 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f i". }. clo
4540: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
4550: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4560: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4570: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
4580: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
4590: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
45a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
45b0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
45c0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
45d0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
45e0: 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 7.0.0.1 8835].
45f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
4600: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4610: 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 catch {..for
4620: 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c {set x 0} {$x <
4630: 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 50} {incr x} {.
4640: 09 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 . puts $s "he
4650: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
4660: 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 mnop".. gets
4670: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
4680: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 close $s. cat
4690: 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 ch {set x [gets
46a0: 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]}. close $
46b0: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 f. set x.} {d
46c0: 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c one 50}..test tl
46d0: 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 sIO-2.9 {socket
46e0: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
46f0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
4700: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
4710: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4720: 20 38 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 8828]. remov
4730: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
4740: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
4750: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
4760: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
4770: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
4780: 68 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e h]. puts -non
4790: 65 77 6c 69 6e 65 20 24 66 20 7b 0a 09 70 61 63 ewline $f {..pac
47a0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
47b0: 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 ..tls::socket -s
47c0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
47d0: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 8. }. clos
47e0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
47f0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4800: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4810: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
4820: 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 gets $f. aft
4830: 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 er 100. set x
4840: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 [list [catch {c
4850: 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 5b 73 lose $f} msg] [s
4860: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 6d 73 67 tring range $msg
4870: 20 30 20 34 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 0 43]]. clos
4880: 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d e $s. set x.}
4890: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
48a0: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
48b0: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
48c0: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
48d0: 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 2.10 {close on a
48e0: 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 ccept, accepted
48f0: 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 socket lives} {s
4900: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
4910: 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 done 0. set
4920: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
4930: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
4940: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
4950: 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ss [tls::socket
4960: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4970: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4980: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4990: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
49a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
49b0: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
49c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
49d0: 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 obal ss..close $
49e0: 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ss..fileevent $s
49f0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
4a00: 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 t $s"..fconfigur
4a10: 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 e $s -trans lf.
4a20: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
4a30: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
4a40: 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 al done..gets $s
4a50: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 ..close $s..set
4a60: 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 done 1. }.
4a70: 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f set cs [tls::so
4a80: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
4a90: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
4aa0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4ab0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4ac0: 79 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 30 y localhost 8830
4ad0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a ]. close $cs.
4ae0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
4af0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
4b00: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 $timer. set
4b10: 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 done.} 1..test t
4b20: 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63 lsIO-2.11 {detec
4b30: 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b ting new data} {
4b40: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 70 72 socket} {. pr
4b50: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
4b60: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b } {..global sock
4b70: 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 ..# when doing a
4b80: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
4b90: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
4ba0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
4bb0: 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c ..# to be non-bl
4bc0: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
4bd0: 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 LS handshake. A
4be0: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 lso make sure..#
4bf0: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 to return the c
4c00: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
4c10: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 uffering mode...
4c20: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4c30: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
4c40: 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 20 73 ring line..set s
4c50: 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 65 6e ock $s..fileeven
4c60: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
4c70: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
4c80: 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 $s]. }..
4c90: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
4ca0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4cb0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
4cc0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4cd0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
4ce0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
4cf0: 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 65 74 ey 8400]. set
4d00: 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74 sock "". set
4d10: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
4d20: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4d30: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4d40: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4d50: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
4d60: 37 2e 30 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 7.0.0.1 8400].
4d70: 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 # when doing a
4d80: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
4d90: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
4da0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
4db0: 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e . # to be non
4dc0: 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 -blocking for th
4dd0: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
4de0: 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 Also make sure
4df0: 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 to. # return
4e00: 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c the channel to l
4e10: 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f ine buffering mo
4e20: 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 de (TLS sets it
4e30: 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 to 'none')..
4e40: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
4e50: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
4e60: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 ering line. v
4e70: 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 wait sock. pu
4e80: 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 ts $s2 one. f
4e90: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 23 20 6e lush $s2. # n
4ea0: 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f eed update to co
4eb0: 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73 mplete TLS hands
4ec0: 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a hake in-process.
4ed0: 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 61 update. a
4ee0: 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f fter 500. fco
4ef0: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
4f00: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 locking 0. se
4f10: 74 20 72 65 73 75 6c 74 20 61 3a 5b 67 65 74 73 t result a:[gets
4f20: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 $sock]. lapp
4f30: 65 6e 64 20 72 65 73 75 6c 74 20 62 3a 5b 67 65 end result b:[ge
4f40: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
4f50: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
4f60: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 blocking 1. p
4f70: 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20 uts $s2 two.
4f80: 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 63 flush $s2. fc
4f90: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
4fa0: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 6c blocking 1. l
4fb0: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 63 3a append result c:
4fc0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4fd0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4fe0: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
4ff0: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
5000: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
5010: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 se $sock. set
5020: 20 72 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 result.} {a:one
5030: 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 73 74 b: c:two}..test
5040: 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 tlsIO-2.12 {tcp
5050: 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 connection; no
5060: 63 65 72 74 69 66 69 63 61 74 65 73 20 73 70 65 certificates spe
5070: 63 69 66 69 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b cified} \..{sock
5080: 65 74 20 73 74 64 69 6f 20 75 6e 69 78 4f 6e 6c et stdio unixOnl
5090: 79 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 y} {. # There
50a0: 20 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65 is a debug asse
50b0: 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 rtion on Windows
50c0: 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 /SSL that causes
50d0: 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 a crash when th
50e0: 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63 e. # certific
50f0: 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 ate isn't specif
5100: 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 ied.. removeF
5110: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5120: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5130: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5140: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
5150: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
5160: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5170: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5180: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
5190: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
51a0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
51b0: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
51c0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
51d0: 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 8828]..proc acc
51e0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
51f0: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
5200: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
5210: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
5220: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
5230: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
5240: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
5250: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
5260: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
5270: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
5280: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5290: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
52a0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
52b0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
52c0: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
52d0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
52e0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 t 127.0.0.1 8828
52f0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
5300: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
5310: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5320: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
5330: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
5340: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
5350: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
5360: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
5370: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
5380: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
5390: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 .test tlsIO-3.1
53a0: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
53b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
53c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
53d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
53e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
53f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
5400: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
5410: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
5420: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
5430: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5440: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
5450: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
5460: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5470: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
5480: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
5490: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
54a0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
54b0: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
54c0: 75 74 73 20 24 66 20 7b 0a 09 70 75 74 73 20 72 uts $f {..puts r
54d0: 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e eady..gets stdin
54e0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
54f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5500: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
5510: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
5520: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
5530: 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 ]" r+]. gets
5540: 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 $f. set x [li
5550: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
5560: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5570: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5580: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5590: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
55a0: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 2d ientKey \. .-
55b0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
55c0: 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 28} msg] \...$ms
55d0: 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 g]. puts $f b
55e0: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ye. close $f.
55f0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b set x.} {1 {
5600: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
5610: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
5620: 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a ready in use}}..
5630: 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 32 20 7b test tlsIO-3.2 {
5640: 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 server with seve
5650: 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f ral clients} {so
5660: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
5670: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
5680: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
5690: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
56a0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
56b0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
56c0: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
56d0: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
56e0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
56f0: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
5700: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
5710: 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 ut"]..set t2 [af
5720: 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 ter 31000 "set x
5730: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
5740: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
5750: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
5760: 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 ut"]..set counte
5770: 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 r 0. }. pu
5780: 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 ts $f "set s \[t
5790: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
57a0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
57b0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
57c0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
57d0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
57e0: 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 Key 8828 \]".
57f0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
5800: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
5810: 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 {.. fileevent
5820: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
5830: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
5840: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
5850: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
5860: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
5870: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
5880: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 x. s
5890: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
58a0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
58b0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
58d0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
58e0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
58f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
5900: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
5910: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
5920: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
5930: 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 }..}..puts read
5940: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
5950: 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 r cancel $t1..vw
5960: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5970: 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 20 78 cel $t2..vwait x
5980: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5990: 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 t3..close $s..pu
59a0: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
59b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
59c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
59d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
59e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
59f0: 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 ]. set x [get
5a00: 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 73 31 s $f]. set s1
5a10: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
5a20: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5a30: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5a40: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5a50: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5a60: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5a70: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
5a80: 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 gure $s1 -buffer
5a90: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5aa0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
5ab0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5ac0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5ad0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5ae0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5af0: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5b00: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
5b10: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 nfigure $s2 -buf
5b20: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5b30: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
5b40: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
5b50: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
5b60: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
5b70: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
5b80: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
5b90: 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 0.0.1 8828].
5ba0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d fconfigure $s3 -
5bb0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
5bc0: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
5bd0: 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 {$i < 100} {inc
5be0: 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 r i} {..puts $s1
5bf0: 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 hello,tlsIO-3.2
5c00: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
5c10: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 74 6c uts $s2 hello,tl
5c20: 73 49 4f 2d 33 2e 32 2c 73 32 0a 09 67 65 74 73 sIO-3.2,s2..gets
5c30: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
5c40: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 ello,tlsIO-3.2,s
5c50: 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 3..gets $s3.
5c60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
5c70: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
5c80: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
5c90: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
5ca0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
5cb0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
5cc0: 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 ady done}..test
5cd0: 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 tlsIO-4.1 {serve
5ce0: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
5cf0: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
5d00: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 68 stdio} {. # h
5d10: 61 76 65 20 73 65 65 6e 20 69 6e 74 65 72 6d 69 ave seen intermi
5d20: 74 74 65 6e 74 20 68 61 6e 67 73 20 6f 6e 20 57 ttent hangs on W
5d30: 69 6e 64 6f 77 73 0a 20 20 20 20 72 65 6d 6f 76 indows. remov
5d40: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5d50: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5d60: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
5d70: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
5d80: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
5d90: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
5da0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
5db0: 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 e tls..gets stdi
5dc0: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 n. }. puts
5dd0: 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 $f "set s \[tls
5de0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
5df0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
5e00: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5e10: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
5e20: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 ey 127.0.0.1 882
5e30: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
5e40: 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 f {..fconfigure
5e50: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
5e60: 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ne..for {set i 0
5e70: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
5e80: 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr i} {.. put
5e90: 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 s $s hello..
5ea0: 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 gets $s..}..clos
5eb0: 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 0a 09 e $s..puts bye..
5ec0: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5ed0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5ee0: 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 set p1 [open "
5ef0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
5f00: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
5f10: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e t]" r+]. fcon
5f20: 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 figure $p1 -buff
5f30: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
5f40: 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c et p2 [open "|[l
5f50: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
5f60: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
5f70: 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 r+]. fconfig
5f80: 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 72 69 ure $p2 -bufferi
5f90: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
5fa0: 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 p3 [open "|[list
5fb0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5fc0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
5fd0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
5fe0: 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 $p3 -buffering
5ff0: 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 line. proc ac
6000: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6010: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
6020: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 uffering line..f
6030: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
6040: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
6050: 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s]. }. pr
6060: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 oc echo {s} {..g
6070: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
6080: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
6090: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
60a0: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
60b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
60c0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
60d0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c one. } el
60e0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
60f0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
6100: 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }. }.
6110: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
6120: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6130: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 _out"]. set t
6140: 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 2 [after 31000 "
6150: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6160: 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 ]. set t3 [af
6170: 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 ter 32000 "set x
6180: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6190: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
61a0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
61b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
61c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
61d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
61e0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
61f0: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
6200: 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 . puts $p1 op
6210: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 en. puts $p2
6220: 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 open. puts $p
6230: 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 3 open. vwait
6240: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
6250: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
6260: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a fter cancel $t1.
6270: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6280: 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 $t2. after c
6290: 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c ancel $t3. cl
62a0: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c ose $s. set l
62b0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
62c0: 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 l [list p1 [gets
62d0: 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p1] $x]. la
62e0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 ppend l [list p2
62f0: 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a [gets $p2] $x].
6300: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6310: 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 ist p3 [gets $p3
6320: 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 ] $x]. puts $
6330: 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 p1 bye. puts
6340: 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p2 bye. puts
6350: 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f $p3 bye. clo
6360: 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 se $p1. close
6370: 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $p2. close $
6380: 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b p3. set l.} {
6390: 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 {p1 bye done} {p
63a0: 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 2 bye done} {p3
63b0: 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 bye done}}..test
63c0: 20 74 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 65 tlsIO-4.2 {byte
63d0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
63e0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
63f0: 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d htons} {socket}
6400: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b 0a {. set x ok.
6410: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
6420: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6430: 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 7d ver dodo 0x3000}
6440: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 msg]} {..set x
6450: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
6460: 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 {..close $msg.
6470: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
6480: 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 ok..test tlsIO-5
6490: 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .1 {byte order p
64a0: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
64b0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
64c0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f \..{socket unixO
64d0: 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 nly notRoot} {.
64e0: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
64f0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6500: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 not owner}. i
6510: 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a f {![catch {tls:
6520: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6530: 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d 20 dodo 0x1} msg]}
6540: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
6550: 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 {htons problem,
6560: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
6570: 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 owed, are you ru
6580: 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 nning as SU?}..c
6590: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
65a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
65b0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
65c0: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 t: not owner}.te
65d0: 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 st tlsIO-5.2 {by
65e0: 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d te order problem
65f0: 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 s, socket number
6600: 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 s, htons} {socke
6610: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
6620: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
6630: 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 cket: port numbe
6640: 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 r too high}.
6650: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
6660: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6670: 20 64 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 6d dodo 0x10000} m
6680: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 sg]} {..set x {p
6690: 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 ort resolution p
66a0: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
66b0: 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 e disallowed}..c
66c0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
66d0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
66e0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
66f0: 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 t: port number t
6700: 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 20 74 6c oo high}.test tl
6710: 73 49 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 sIO-5.3 {byte or
6720: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
6730: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
6740: 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ons} \..{socket
6750: 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 unixOnly notRoot
6760: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 } {. set x {c
6770: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
6780: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
6790: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
67a0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
67b0: 72 76 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 rver dodo 21} ms
67c0: 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 g]} {..set x {ht
67d0: 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f ons problem, sho
67e0: 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 uld be disallowe
67f0: 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 d, are you runni
6800: 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 ng as SU?}..clos
6810: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
6820: 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e set x.} {couldn
6830: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6840: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 not owner}..test
6850: 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 tlsIO-6.1 {acce
6860: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
6870: 72 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f r} {socket stdio
6880: 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 } {. # There
6890: 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65 72 is a debug asser
68a0: 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f tion on Windows/
68b0: 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 SSL that causes
68c0: 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 a crash when the
68d0: 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63 61 . # certifica
68e0: 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 te isn't specifi
68f0: 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 ed.. removeFi
6900: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6910: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6920: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6930: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
6940: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
6950: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
6960: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
6970: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
6980: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
6990: 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a s $f [list tls::
69a0: 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 socket -cafile $
69b0: 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 caCert 127.0.0.1
69c0: 20 38 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 8848]. close
69d0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
69e0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
69f0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6a00: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6a10: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
6a20: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
6a30: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
6a40: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
6a50: 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 t {s a p} {expr
6a60: 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 10 / 0}. set
6a70: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
6a80: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
6a90: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6aa0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6ab0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6ac0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
6ad0: 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 848]. puts $f
6ae0: 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 hello. close
6af0: 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $f. set time
6b00: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
6b10: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6b20: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
6b30: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6b40: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6b50: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
6b60: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
6b70: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
6b80: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c zero}}..test tl
6b90: 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 sIO-7.1 {testing
6ba0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6bb0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6bc0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
6bd0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
6be0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6bf0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
6c00: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
6c10: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
6c20: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
6c30: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
6c40: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
6c50: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
6c60: 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 t tls::socket -s
6c70: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
6c80: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
6c90: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
6ca0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6cb0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
6cc0: 32 30 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 20]. puts $f
6cd0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 {..proc accept a
6ce0: 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rgs {.. globa
6cf0: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
6d00: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
6d10: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
6d20: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
6d30: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 x timed_out"]..v
6d40: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
6d50: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6d60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
6d70: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6d80: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6d90: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6da0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
6db0: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
6dc0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
6dd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
6de0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
6df0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6e00: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
6e10: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 30 127.0.0.1 8820
6e20: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
6e30: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
6e40: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
6e50: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
6e60: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
6e70: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 lappend l [stri
6e80: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
6e90: 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 ex $p 0] 127.0.0
6ea0: 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 .1]. lappend
6eb0: 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 l [string compar
6ec0: 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 e [lindex $p 2]
6ed0: 38 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 8820]. lappen
6ee0: 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d d l [llength $p]
6ef0: 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 .} {0 0 3}..test
6f00: 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 tlsIO-7.2 {test
6f10: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6f20: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
6f30: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
6f40: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
6f50: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
6f60: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
6f70: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
6f80: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
6f90: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
6fa0: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
6fb0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
6fc0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
6fd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6fe0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
6ff0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
7000: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7010: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7020: 72 4b 65 79 20 38 38 32 31 22 0a 20 20 20 20 70 rKey 8821". p
7030: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
7040: 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 ccept args {..
7050: 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 global x..
7060: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
7070: 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 uts ready..set t
7080: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
7090: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
70a0: 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 ut"]..vwait x..a
70b0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
70c0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
70d0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
70e0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
70f0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
7100: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
7110: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
7120: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7130: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
7140: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
7150: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7160: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
7170: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
7180: 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 73 65 74 .1 8821]. set
7190: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
71a0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
71b0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
71c0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c ose $f. set l
71d0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
71e0: 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 l [llength $p].
71f0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
7200: 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 20 20 6c ndex $p 0]. l
7210: 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 append l [string
7220: 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 78 20 24 equal [lindex $
7230: 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 7b 33 20 p 2] 8821].} {3
7240: 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 127.0.0.1 0}..te
7250: 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 65 st tlsIO-7.3 {te
7260: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7270: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
7280: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
7290: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
72a0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
72b0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
72c0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
72d0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
72e0: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
72f0: 65 70 74 20 38 38 32 32 5d 0a 20 20 20 20 73 65 ept 8822]. se
7300: 74 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 5b 66 63 t l [llength [fc
7310: 6f 6e 66 69 67 75 72 65 20 24 73 5d 5d 0a 20 20 onfigure $s]].
7320: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 close $s. u
7330: 70 64 61 74 65 0a 20 20 20 20 23 20 41 20 62 75 pdate. # A bu
7340: 67 20 66 69 78 65 64 20 69 6e 20 66 63 6f 6e 66 g fixed in fconf
7350: 69 67 75 72 65 20 66 6f 72 20 38 2e 33 2e 34 2b igure for 8.3.4+
7360: 20 6d 61 6b 65 20 74 68 69 73 20 72 65 74 75 72 make this retur
7370: 6e 20 31 34 20 6e 6f 72 6d 61 6c 6c 79 2c 0a 20 n 14 normally,.
7380: 20 20 20 23 20 62 75 74 20 31 32 20 69 6e 20 6f # but 12 in o
7390: 6c 64 65 72 20 76 65 72 73 69 6f 6e 73 2e 0a 20 lder versions..
73a0: 20 20 20 65 78 70 72 20 7b 24 6c 20 3e 3d 20 31 expr {$l >= 1
73b0: 32 20 26 26 20 28 28 24 6c 20 25 20 32 29 20 3d 2 && (($l % 2) =
73c0: 3d 20 30 29 7d 0a 7d 20 31 0a 0a 23 20 62 75 67 = 0)}.} 1..# bug
73d0: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
73e0: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
73f0: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
7400: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
7410: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 est tlsIO-7.4 {t
7420: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
7430: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
7440: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
7450: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7460: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
7470: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7480: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7490: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
74a0: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
74b0: 63 65 70 74 20 38 38 32 33 5d 0a 20 20 20 20 70 cept 8823]. p
74c0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
74d0: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
74e0: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
74f0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
7500: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
7510: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
7520: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7530: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7540: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7550: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7560: 74 4b 65 79 20 5c 0a 20 20 20 20 09 6c 6f 63 61 tKey \. .loca
7570: 6c 68 6f 73 74 20 38 38 32 33 5d 0a 20 20 20 20 lhost 8823].
7580: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7590: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
75a0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
75b0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
75c0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
75d0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
75e0: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
75f0: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
7600: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 d l [lindex $x 2
7610: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
7620: 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 {8823 3}..# bug
7630: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
7640: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
7650: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
7660: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
7670: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 est tlsIO-7.5 {t
7680: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
7690: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
76a0: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 {socket unixOrPc
76b0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
76c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
76d0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
76e0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
76f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7700: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
7710: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
7720: 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 t 8829]. proc
7730: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7740: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
7750: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
7760: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
7770: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
7780: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
7790: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
77a0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
77b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
77c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
77d0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
77e0: 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 .0.0.1 8829].
77f0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
7800: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
7810: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
7820: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
7830: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
7840: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
7850: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
7860: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
7870: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 nd l [lindex $x
7880: 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 0] [lindex $x 2]
7890: 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 [llength $x].}
78a0: 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 {127.0.0.1 8829
78b0: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 3}..test tlsIO-8
78c0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 .1 {testing -asy
78d0: 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 nc flag on socke
78e0: 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ts} {socket} {.
78f0: 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 # NOTE: This
7900: 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e test may fail on
7910: 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e some Solaris 2.
7920: 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 20 20 23 4 systems.. #
7930: 20 53 65 65 20 6e 6f 74 65 73 20 69 6e 20 54 63 See notes in Tc
7940: 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 73 74 2e l's socket.test.
7950: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7960: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7970: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7980: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7990: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
79a0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
79b0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
79c0: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
79d0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
79e0: 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 6e global x..# when
79f0: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
7a00: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
7a10: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
7a20: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
7a30: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
7a40: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
7a50: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
7a60: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
7a70: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
7a80: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
7a90: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
7aa0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
7ab0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
7ac0: 65 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 e..puts $s bye..
7ad0: 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 30 # Only OpenSSL 0
7ae0: 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 73 .9.5a on Windows
7af0: 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 74 seems to need t
7b00: 68 65 20 61 66 74 65 72 20 28 64 65 6c 61 79 65 he after (delaye
7b10: 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 74 d)..# close, but
7b20: 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 74 it works just t
7b30: 68 65 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c 20 he same for all
7b40: 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a 09 others. -hobbs..
7b50: 61 66 74 65 72 20 35 30 30 20 63 6c 6f 73 65 20 after 500 close
7b60: 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 $s..set x done.
7b70: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
7b80: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7b90: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
7ba0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7bb0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7bc0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7bd0: 09 20 20 20 20 2d 61 73 79 6e 63 20 6c 6f 63 61 . -async loca
7be0: 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 20 lhost 8830].
7bf0: 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 # when doing an
7c00: 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e in-process clien
7c10: 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 t/server test, b
7c20: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 oth sides need.
7c30: 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 # to be non-b
7c40: 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 locking for the
7c50: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 TLS handshake A
7c60: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f lso make sure to
7c70: 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 . # return th
7c80: 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e e channel to lin
7c90: 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 e buffering mode
7ca0: 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f (TLS sets it to
7cb0: 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 'none').. fc
7cc0: 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 6c onfigure $s1 -bl
7cd0: 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 ocking 0 -buffer
7ce0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 ing line. vwa
7cf0: 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 68 it x. # TLS h
7d00: 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 73 andshaking needs
7d10: 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 74 one byte from t
7d20: 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 20 he client....
7d30: 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 20 puts $s1 a.
7d40: 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 6f # need update to
7d50: 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 complete TLS ha
7d60: 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 ndshake in-proce
7d70: 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 ss. update.
7d80: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
7d90: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
7da0: 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 31 set z [gets $s1
7db0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
7dc0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7dd0: 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 set z.} bye..te
7de0: 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b 74 65 st tlsIO-9.1 {te
7df0: 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 sting spurious e
7e00: 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 vents} {socket}
7e10: 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a {. set len 0.
7e20: 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 set spurious
7e30: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
7e40: 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 0. proc readl
7e50: 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f ittle {s} {..glo
7e60: 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e bal spurious don
7e70: 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 e len..set l [re
7e80: 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 ad $s 1]..if {[s
7e90: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
7ea0: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
7eb0: 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 {![eof $s]} {..
7ec0: 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 .incr spurious..
7ed0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 } else {...c
7ee0: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
7ef0: 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 ne 1.. }..} e
7f00: 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 lse {.. incr
7f10: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
7f20: 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a th $l]..}. }.
7f30: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
7f40: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
7f50: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
7f60: 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 ng 0..fileevent
7f70: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
7f80: 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 t do_handshake $
7f90: 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 6c s readable readl
7fa0: 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 65 ittle \...-buffe
7fb0: 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d ring none]. }
7fc0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7fd0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7fe0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7ff0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8000: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8010: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8020: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
8030: 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 831]. set c [
8040: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8050: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8060: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8070: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8080: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8090: 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 localhost 88
80a0: 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 20 64 31]. # This d
80b0: 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b iffers from sock
80c0: 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 62 et-9.1 in that b
80d0: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 20 74 oth sides need t
80e0: 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 o be. # non-b
80f0: 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 65 20 locking because
8100: 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 65 64 of TLS' required
8110: 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 handshake. f
8120: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
8130: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
8140: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 s -nonewline $c
8150: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
8160: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
8170: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
8180: 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 89. close $c.
8190: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
81a0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
81b0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
81c0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
81d0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
81e0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
81f0: 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 73 e $s. list $s
8200: 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b purious $len.} {
8210: 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 0 50}..test tlsI
8220: 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 O-9.2 {testing a
8230: 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 sync write, file
8240: 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e events, flush on
8250: 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 7d close} {socket}
8260: 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 {. set first
8270: 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 block [string re
8280: 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 20 73 peat a 31]. s
8290: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b et secondblock [
82a0: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 string repeat b
82b0: 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f 63 20 65535]. proc
82c0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
82d0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
82e0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c -blocking 0..fil
82f0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
8300: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
8310: 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c shake $s readabl
8320: 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 2d e readable \...-
8330: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
8340: 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 buffersize 16384
8350: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8360: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
8370: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
8380: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
8390: 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c 22 5b ..dputs "got \"[
83a0: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
83b0: 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c l 10 end-3 ...]\
83c0: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
83d0: 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f 6d 20 ength $l]) from
83e0: 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $s"..fileevent $
83f0: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 s readable {}..a
8400: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
8410: 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 d $s. }. p
8420: 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 roc respond {s}
8430: 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 {..global firstb
8440: 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e lock..dputs "sen
8450: 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c d \"[string repl
8460: 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 6b 20 ace $firstblock
8470: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8480: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8490: 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d gth $firstblock]
84a0: 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 ) down $s"..puts
84b0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
84c0: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 firstblock..afte
84d0: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
84e0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
84f0: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
8500: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e {..global secon
8510: 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 dblock..dputs "s
8520: 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 end \"[string re
8530: 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 6c 6f place $secondblo
8540: 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ck 10 end-3 ...]
8550: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
8560: 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 6c length $secondbl
8570: 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 ock]) down $s"..
8580: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
8590: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
85a0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
85b0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
85c0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
85d0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
85e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
85f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
8600: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
8610: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
8620: 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 32]. set c [t
8630: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8640: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8650: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8660: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8670: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8680: 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 localhost 883
8690: 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 2]. fconfigur
86a0: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
86b0: 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 -trans lf -buff
86c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
86d0: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 et count 0. p
86e0: 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 20 uts $c hello.
86f0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
8700: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
8710: 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 20 done..set data
8720: 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 75 74 73 [read $s]..dputs
8730: 20 22 72 65 61 64 20 5c 22 5b 73 74 72 69 6e 67 "read \"[string
8740: 20 72 65 70 6c 61 63 65 20 24 64 61 74 61 20 31 replace $data 1
8750: 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0 end-3 ...]\" \
8760: 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 ...([string leng
8770: 74 68 20 24 64 61 74 61 5d 29 20 66 72 6f 6d 20 th $data]) from
8780: 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 $s"..incr count
8790: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
87a0: 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 data]..if {[eof
87b0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
87c0: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
87d0: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
87e0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
87f0: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
8800: 24 63 22 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 $c". set done
8810: 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 0. set timer
8820: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
8830: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
8840: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
8850: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
8860: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
8870: 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 lose $s. list
8880: 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 $count $done.}
8890: 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 20 {65566 1}..test
88a0: 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 tlsIO-9.3 {testi
88b0: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
88c0: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 s} {unexplainedF
88d0: 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 7b ailure socket} {
88e0: 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 . # HOBBS: ne
88f0: 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 ver worked corre
8900: 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 6f ctly. proc co
8910: 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b unt_to_eof {s} {
8920: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 ..global count d
8930: 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c one timer..set l
8940: 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b [gets $s]..if {
8950: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
8960: 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 incr count..
8970: 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d if {$count > 9}
8980: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
8990: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 set done true...
89a0: 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 set count {eof i
89b0: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
89c0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
89d0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
89e0: 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 proc timerpr
89f0: 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 oc {} {..global
8a00: 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 done count c..se
8a10: 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 t done true..set
8a20: 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 count {timer we
8a30: 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e nt off, eof is n
8a40: 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 ot sticky}..clos
8a50: 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $c. }. s
8a60: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 et count 0. s
8a70: 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 et done false.
8a80: 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 proc write_the
8a90: 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 n_close {s} {..p
8aa0: 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 uts $s bye..clos
8ab0: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 e $s. }. p
8ac0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8ad0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
8ae0: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
8af0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
8b00: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
8b10: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 .fileevent $s wr
8b20: 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f itable [list do_
8b30: 68 61 6e 64 73 68 61 6b 65 20 24 73 20 77 72 69 handshake $s wri
8b40: 74 61 62 6c 65 20 77 72 69 74 65 5f 74 68 65 6e table write_then
8b50: 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 66 66 _close \...-buff
8b60: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
8b70: 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 20 slation lf].
8b80: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8b90: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8ba0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8bb0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
8bc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8bd0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
8be0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8bf0: 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 8833]. set c
8c00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8c10: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8c20: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8c30: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8c40: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8c50: 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 . localhost 8
8c60: 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 833]. fconfig
8c70: 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 ure $c -blocking
8c80: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
8c90: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
8ca0: 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 lf. fileevent
8cb0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f $c readable "co
8cc0: 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 unt_to_eof $c".
8cd0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
8ce0: 74 65 72 20 32 30 30 30 20 74 69 6d 65 72 70 72 ter 2000 timerpr
8cf0: 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f oc]. vwait do
8d00: 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a ne. close $s.
8d10: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
8d20: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
8d30: 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 .removeFile scri
8d40: 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 pt..test tlsIO-1
8d50: 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 0.1 {testing soc
8d60: 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 ket accept callb
8d70: 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 ack error handli
8d80: 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ng} {socket} {.
8d90: 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 set goterror
8da0: 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 0. proc bgerr
8db0: 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 or args {global
8dc0: 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 67 6f goterror; set go
8dd0: 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 terror 1}. se
8de0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8df0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8e00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8e10: 38 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 8898]. proc a
8e20: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
8e30: 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a lose $s; error}.
8e40: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
8e50: 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 socket -cafile $
8e60: 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 caCert 127.0.0.1
8e70: 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 74 8898]. vwait
8e80: 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 6c goterror. cl
8e90: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
8ea0: 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 65 $c. set gote
8eb0: 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 rror.} 1..test t
8ec0: 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 lsIO-11.1 {tcp c
8ed0: 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b onnection} {sock
8ee0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8ef0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8f00: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
8f10: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8f20: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
8f30: 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 1_test_server [t
8f40: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
8f50: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
8f60: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8f70: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8f80: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
8f90: 72 76 65 72 4b 65 79 20 38 38 33 34 5d 0a 09 70 rverKey 8834]..p
8fa0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8fb0: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
8fc0: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
8fd0: 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 puts $s done..
8fe0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
8ff0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
9000: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9010: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9020: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9030: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9040: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9050: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9060: 72 49 50 20 38 38 33 34 5d 0a 20 20 20 20 73 65 rIP 8834]. se
9070: 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t r [gets $s].
9080: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
9090: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
90a0: 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 e $socket9_1_tes
90b0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
90c0: 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 t r.} done..test
90d0: 20 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 tlsIO-11.2 {cli
90e0: 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 74 ent specifies it
90f0: 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 s port} {socket
9100: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
9110: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 69 eServer} {. i
9120: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
9130: 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 port]} {..incr p
9140: 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ort. } else {
9150: 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 ..set port [expr
9160: 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 {$tlsServerPort
9170: 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a + [pid]%1024}].
9180: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 }. sendCe
9190: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
91a0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
91b0: 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 socket9_2_test_s
91c0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
91d0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
91e0: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
91f0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
9200: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9210: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
9220: 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 8835]..proc acce
9230: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
9240: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
9250: 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 $s.. puts $s
9260: 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 $p.. close $
9270: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9280: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
9290: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
92a0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
92b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
92c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
92d0: 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 ey \.. -mypor
92e0: 74 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 t $port $remoteS
92f0: 65 72 76 65 72 49 50 20 38 38 33 35 5d 0a 20 20 erverIP 8835].
9300: 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 set r [gets $s
9310: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
9320: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9330: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 close $socket9_2
9340: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
9350: 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 if {$r == $por
9360: 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 t} {..set result
9370: 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ok. } else {
9380: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f ..set result bro
9390: 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ken. }. se
93a0: 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 t result.} ok..t
93b0: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 33 20 7b est tlsIO-11.3 {
93c0: 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 trying to connec
93d0: 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 t, no server} {s
93e0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
93f0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9400: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
9410: 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 ok. if {![cat
9420: 63 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a ch {set s [tls::
9430: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9440: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9450: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9460: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9470: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9480: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 38 remoteServerIp 8
9490: 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 836]}]} {..if {!
94a0: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d [catch {gets $s}
94b0: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 ]} {.. set st
94c0: 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 atus broken..}..
94d0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
94e0: 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 set status.}
94f0: 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ok..test tlsIO-1
9500: 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 1.4 {remote echo
9510: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
9520: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9530: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9540: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
9550: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9560: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
9570: 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_6_test_server
9580: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9590: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
95a0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
95b0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
95c0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
95d0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
95e0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
95f0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
9600: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
9610: 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 s.. fileevent
9620: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
9630: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
9640: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
9650: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
9660: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
9670: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
9680: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
9690: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
96a0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
96b0: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
96c0: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
96d0: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
96e0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b }. set f [
96f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9700: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9710: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9720: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9730: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9740: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9750: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
9760: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 onfigure $f -tra
9770: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
9780: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
9790: 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a puts $f hello.
97a0: 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 set r [gets
97b0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
97c0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
97d0: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
97e0: 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0_6_test_server}
97f0: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 6c . set r.} hel
9800: 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 lo..test tlsIO-1
9810: 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 1.5 {remote echo
9820: 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 , 50 lines} {soc
9830: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9840: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9850: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
9860: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9870: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
9880: 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_7_test_server
9890: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
98a0: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
98b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
98c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
98d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
98e0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a serverKey 8836].
98f0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9900: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
9910: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
9920: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
9930: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
9940: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
9950: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
9960: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
9970: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a slation crlf..}.
9980: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
9990: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
99a0: 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b s $s].. if {[
99b0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
99c0: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
99d0: 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c e {...puts $s $l
99e0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
99f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a . set f [tls:
9a00: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9a10: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9a20: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9a30: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9a40: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9a50: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9a60: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
9a70: 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 gure $f -transla
9a80: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
9a90: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
9aa0: 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 r {set cnt 0} {$
9ab0: 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 cnt < 50} {incr
9ac0: 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 cnt} {..puts $f
9ad0: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 "hello, $cnt"..i
9ae0: 66 20 7b 5b 67 65 74 73 20 24 66 5d 20 6e 65 20 f {[gets $f] ne
9af0: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 7d 20 7b "hello, $cnt"} {
9b00: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
9b10: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9b20: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
9b30: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
9b40: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
9b50: 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 }. set cnt.}
9b60: 35 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 50..# Macintosh
9b70: 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 sockets can have
9b80: 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 more than one s
9b90: 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 erver per port.i
9ba0: 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d f {$tcl_platform
9bb0: 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 6d (platform) eq "m
9bc0: 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 acintosh"} {.
9bd0: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
9be0: 75 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 ult {0 8836}.} e
9bf0: 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f lse {. set co
9c00: 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 nflictResult {1
9c10: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
9c20: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
9c30: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
9c40: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
9c50: 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .6 {socket confl
9c60: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ict} {socket doT
9c70: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9c80: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9c90: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
9ca0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9cb0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9cc0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9cd0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9ce0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
9cf0: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 accept 8836].
9d00: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 if {[catch {set
9d10: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9d20: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9d30: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
9d40: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9d50: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
9d60: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
9d70: 20 61 63 63 65 70 74 20 38 38 33 36 5d 7d 20 6d accept 8836]} m
9d80: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 sg]} {..set resu
9d90: 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d lt [list 1 $msg]
9da0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
9db0: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
9dc0: 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 0 [lindex [fconf
9dd0: 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e igure $s2 -sockn
9de0: 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 ame] 2]]..close
9df0: 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s2. }. cl
9e00: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
9e10: 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 result.} $confli
9e20: 63 74 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 ctResult..test t
9e30: 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 lsIO-11.7 {serve
9e40: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
9e50: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
9e60: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
9e70: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
9e80: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
9e90: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9ea0: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f .set socket10_9_
9eb0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
9ec0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
9ed0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9ee0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9ef0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9f00: 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 verKey \...-serv
9f10: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
9f20: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9f30: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e a p} {.. fcon
9f40: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
9f50: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
9f60: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
9f70: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
9f80: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 $s]..}..proc ech
9f90: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
9fa0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
9fb0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
9fc0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
9fd0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
9fe0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
9ff0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
a000: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
a010: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a020: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a030: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a040: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a050: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a060: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
a070: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
a080: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a090: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
a0a0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
a0b0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a0c0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a0d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a0e0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a0f0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a100: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
a110: 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 igure $s2 -buffe
a120: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
a130: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
a140: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a150: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a160: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a170: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a180: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
a190: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
a1a0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
a1b0: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
a1c0: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
a1d0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
a1e0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
a1f0: 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s1 hello,tlsIO
a200: 2d 31 31 2e 37 2c 73 31 0a 09 67 65 74 73 20 24 -11.7,s1..gets $
a210: 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c s1..puts $s2 hel
a220: 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 32 lo,tlsIO-11.7,s2
a230: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
a240: 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s3 hello,tlsIO
a250: 2d 31 31 2e 37 2c 73 33 0a 09 67 65 74 73 20 24 -11.7,s3..gets $
a260: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
a270: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
a280: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
a290: 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 s3. sendComma
a2a0: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
a2b0: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
a2c0: 72 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 r}. set i.} 1
a2d0: 30 30 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 00..test tlsIO-1
a2e0: 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 1.8 {client with
a2f0: 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 several servers
a300: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
a310: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
a320: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
a330: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
a340: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a Command {..tls::
a350: 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 init -certfile $
a360: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a370: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a380: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 ile $serverKey..
a390: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a3a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a3b0: 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a ept 4003" 4003].
a3c0: 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f .set s2 [tls::so
a3d0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
a3e0: 63 65 70 74 20 34 30 30 34 22 20 34 30 30 34 5d cept 4004" 4004]
a3f0: 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 ..set s3 [tls::s
a400: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
a410: 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 ccept 4005" 4005
a420: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
a430: 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 e {s mp} {..
a440: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a450: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a460: 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 } elseif {[catch
a470: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
a480: 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a $s} result]} {.
a490: 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 ..# Some errors
a4a0: 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 are normal...
a4b0: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
a4c0: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 lt == 1} {...# H
a4d0: 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 andshake complet
a4e0: 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 e...fileevent $s
a4f0: 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 readable ""...p
a500: 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f uts $s $mp...clo
a510: 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a se $s.. }..}.
a520: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 .proc accept {mp
a530: 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 s a p} {.. #
a540: 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 These have to a
a550: 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 ccept non-blocki
a560: 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 ng, because the
a570: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 handshaking..
a580: 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 # order isn't d
a590: 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 eterministic..
a5a0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
a5b0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
a5c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
a5d0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
a5e0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e adable [list han
a5f0: 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 dshake $s $mp]..
a600: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a }. }. tls:
a610: 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 :init -certfile
a620: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a630: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a640: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a file $clientKey.
a650: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
a660: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
a670: 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 erverIP 4003].
a680: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
a690: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a6a0: 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 verIP 4004].
a6b0: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a6c0: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
a6d0: 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 rIP 4005]. se
a6e0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
a6f0: 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 nd l [gets $s1]
a700: 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 [gets $s1] [eof
a710: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s1] [gets $s2]
a720: 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 [gets $s2] [eof
a730: 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 $s2] \..[gets $s
a740: 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 3] [gets $s3] [e
a750: 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 of $s3]. clos
a760: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a770: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a780: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a790: 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 d {..close $s1..
a7a0: 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 close $s2..close
a7b0: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s3. }. s
a7c0: 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 et l.} {4003 {}
a7d0: 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 1 4004 {} 1 4005
a7e0: 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 {} 1}..test tls
a7f0: 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 IO-11.9 {accept
a800: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 callback error}
a810: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a820: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a830: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
a840: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a850: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
a860: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a870: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a880: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
a890: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
a8a0: 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 8836]. proc
a8b0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a8c0: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
a8d0: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
a8e0: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
a8f0: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
a900: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
a910: 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 lues. if {[ca
a920: 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 tch {sendCommand
a930: 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 {.. set peer
a940: 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 name [fconfigure
a950: 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d $callerSocket -
a960: 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 peername].. s
a970: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
a980: 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 t \... -certf
a990: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a9a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a9b0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a9c0: 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e Key \... [lin
a9d0: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
a9e0: 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 8836].. clos
a9f0: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
aa00: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
aa10: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
aa20: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
aa30: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
aa40: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
aa50: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
aa60: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
aa70: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
aa80: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
aa90: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
aaa0: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
aab0: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ero}}..test tlsI
aac0: 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 O-11.10 {testing
aad0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
aae0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
aaf0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
ab00: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
ab10: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
ab20: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
ab30: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
ab40: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 12_test_server [
ab50: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
ab60: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
ab70: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
ab80: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
ab90: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
aba0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
abb0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
abc0: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
abd0: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
abe0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
abf0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ac00: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
ac10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ac20: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
ac30: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
ac40: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
ac50: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
ac60: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
ac70: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
ac80: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
ac90: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
aca0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
acb0: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
acc0: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
acd0: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
ace0: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
acf0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
ad00: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
ad10: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
ad20: 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 .} {8836 3 3}..t
ad30: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 est tlsIO-11.11
ad40: 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 {testing spuriou
ad50: 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 s events} {socke
ad60: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
ad70: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
ad80: 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 # remote equiva
ad90: 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 lent of 9.1.
ada0: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
adb0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
adc0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 ..set socket_tes
add0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
ade0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
adf0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
ae00: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
ae10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ae20: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
ae30: 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 ey 8836]..proc h
ae40: 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 andshake {s} {..
ae50: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
ae60: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
ae70: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 } elseif {[c
ae80: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
ae90: 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d hake $s} result]
aea0: 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 } {...# Some err
aeb0: 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a ors are normal..
aec0: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
aed0: 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 result == 1} {..
aee0: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
aef0: 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e plete...fileeven
af00: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 t $s writable ""
af10: 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 72 69 ...after 100 wri
af20: 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d tesome $s.. }
af30: 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ..}..proc accept
af40: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
af50: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
af60: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
af70: 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 lf".. fileev
af80: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
af90: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
afa0: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s]..}..proc wri
afb0: 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 tesome {s} {..
afc0: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
afd0: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
afe0: 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 i} {...puts $s
aff0: 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 "line $i from re
b000: 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 mote server"..
b010: 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 }.. close $
b020: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b030: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
b040: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
b050: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
b060: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
b070: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
b080: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
b090: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
b0a0: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
b0b0: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
b0c0: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
b0d0: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
b0e0: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
b0f0: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
b100: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
b110: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
b120: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
b130: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
b140: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b150: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
b160: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b170: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b180: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b190: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b1a0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
b1b0: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
b1c0: 20 20 23 20 47 65 74 20 74 68 65 20 62 75 66 66 # Get the buff
b1d0: 65 72 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a ering corrected.
b1e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
b1f0: 63 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e c -buffering lin
b200: 65 0a 20 20 20 20 23 20 50 75 74 20 61 20 62 79 e. # Put a by
b210: 74 65 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 te into the clie
b220: 6e 74 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 nt pipe to trigg
b230: 65 72 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 er TLS handshaki
b240: 6e 67 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 ng. puts $c a
b250: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b260: 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 c readable [list
b270: 20 72 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a readlittle $c].
b280: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
b290: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
b2a0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
b2b0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b2c0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
b2d0: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
b2e0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
b2f0: 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 socket_test_serv
b300: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
b310: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
b320: 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 2690}..test tls
b330: 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e IO-11.12 {testin
b340: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
b350: 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 } {unexplainedFa
b360: 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 ilure socket doT
b370: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b380: 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 rver} {. # re
b390: 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 mote equivalent
b3a0: 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 of 9.3. # HOB
b3b0: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 BS: never worked
b3c0: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 correctly. s
b3d0: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
b3e0: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
b3f0: 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 proc count_up {s
b400: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
b410: 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 ter done after_i
b420: 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 d..set l [gets $
b430: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
b440: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
b450: 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 unter.. if {$
b460: 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 counter > 9} {..
b470: 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 .set done {EOF i
b480: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
b490: 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f r cancel $after_
b4a0: 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 id...close $s..
b4b0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
b4c0: 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 proc timed_out
b4d0: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 {} {..global c
b4e0: 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b done..set done {
b4f0: 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 timed_out, EOF i
b500: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
b510: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 lose $c. }.
b520: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
b530: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b540: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
b550: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _14_test_server
b560: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b570: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
b580: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
b590: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b5a0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
b5b0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
b5c0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
b5d0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b5e0: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
b5f0: 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 s.. after 100
b600: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
b610: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
b620: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b630: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b640: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b650: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b660: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b670: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b680: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 8836]. file
b690: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
b6a0: 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a e "count_up $c".
b6b0: 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 set after_id
b6c0: 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d [after 1000 tim
b6d0: 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 ed_out]. vwai
b6e0: 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 t done. sendC
b6f0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
b700: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
b710: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
b720: 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 done.} {EOF is s
b730: 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 ticky}..test tls
b740: 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e IO-11.13 {testin
b750: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 g async write, a
b760: 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e sync flush, asyn
b770: 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 c close} \..{soc
b780: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b790: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b7a0: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
b7b0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
b7c0: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
b7d0: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
b7e0: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
b7f0: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
b800: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
b810: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
b820: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
b830: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
b840: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
b850: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
b860: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
b870: 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 eat a 31]..set s
b880: 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 econdblock [stri
b890: 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 35 33 ng repeat b 6553
b8a0: 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 5]..set l [tls::
b8b0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
b8c0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
b8d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b8e0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
b8f0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
b900: 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 accept 8845]..p
b910: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b920: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b930: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b940: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
b950: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
b960: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
b970: 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 ersize 16384 \..
b980: 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 . -buffering
b990: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
b9a0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
b9b0: 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d "readable $s"..}
b9c0: 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 ..proc readable
b9d0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
b9e0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
b9f0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
ba00: 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 dable {}.. af
ba10: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
ba20: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 $s..}..proc res
ba30: 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 pond {s} {..
ba40: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
ba50: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
ba60: 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 ewline $s $first
ba70: 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 block.. after
ba80: 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 1000 writedata
ba90: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
baa0: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 edata {s} {..
bab0: 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c global secondbl
bac0: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
bad0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
bae0: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c ondblock.. cl
baf0: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
bb00: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
bb10: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
bb20: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
bb30: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
bb40: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
bb50: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
bb60: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
bb70: 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 845]. fconfig
bb80: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
bb90: 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 0 -translation
bba0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
bbb0: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
bbc0: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
bbd0: 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 ello. fileeve
bbe0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
bbf0: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
bc00: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
bc10: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
bc20: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
bc30: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
bc40: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
bc50: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
bc60: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
bc70: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
bc80: 35 36 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 566..proc getdat
bc90: 61 20 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a a {type file} {.
bca0: 20 20 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c # Read handl
bcb0: 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 er on the accept
bcc0: 65 64 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 ed socket.. g
bcd0: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 lobal x. glob
bce0: 61 6c 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 al failed. se
bcf0: 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 t status [catch
bd00: 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 {read $file} dat
bd10: 61 5d 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 a]. if {$stat
bd20: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 us != 0} {..set
bd30: 78 20 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 x "read failed,
bd40: 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 error was $data"
bd50: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
bd60: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
bd70: 73 65 69 66 20 7b 24 64 61 74 61 20 6e 65 20 7b seif {$data ne {
bd80: 7d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 }} {. } elsei
bd90: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
bda0: 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 le]} {. } els
bdb0: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
bdc0: 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 6c 65 64 } {..if {$failed
bdd0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 } {.. set x "
bde0: 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 $type socket was
bdf0: 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d 20 65 inherited"..} e
be00: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
be10: 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 "$type socket w
be20: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
be30: 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c "..}..catch { cl
be40: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 ose $file }.
be50: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 78 20 } else {..set x
be60: 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 {impossible case
be70: 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 }..catch { close
be80: 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 $file }. }.
be90: 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 return.}..tes
bea0: 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 t tlsIO-12.1 {te
beb0: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
bec0: 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b e of server sock
bed0: 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 ets} {socket exe
bee0: 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c c} {. makeFil
bef0: 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 e {} script1.
bf00: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
bf10: 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 ipt2.. # Scri
bf20: 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 pt1 is just a 10
bf30: 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 second delay.
bf40: 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f If the server so
bf50: 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e cket. # is in
bf60: 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c herited, it will
bf70: 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f be held open fo
bf80: 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 r 10 seconds..
bf90: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
bfa0: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
bfb0: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
bfc0: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
bfd0: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
bfe0: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
bff0: 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 65 # Script2 create
c000: 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 s the server soc
c010: 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 ket, launches sc
c020: 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 ript1,. # wai
c030: 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 ts a second, and
c040: 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 exits. The ser
c050: 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 ver socket will
c060: 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f now. # be clo
c070: 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 sed unless scrip
c080: 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e t1 inherited it.
c090: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c0a0: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
c0b0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
c0c0: 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 et tclsh $::tclt
c0d0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
c0e0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c0f0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
c100: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
c110: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
c120: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
c130: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
c140: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c150: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
c160: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
c170: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
c180: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c190: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
c1a0: 4b 65 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 Key 8828\]".
c1b0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
c1c0: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 accept { file ad
c1d0: 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 dr port } {..
c1e0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
c1f0: 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 .exec $tclsh scr
c200: 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 ipt1 &..close $f
c210: 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 ..after 1000 exi
c220: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
c230: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c240: 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 $f.. # Launc
c250: 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 h script2 and wa
c260: 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 it 5 seconds..
c270: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
c280: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
c290: 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 t2 &. after 5
c2a0: 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 000 { set ok_to_
c2b0: 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 proceed 1 }.
c2c0: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
c2d0: 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 eed.. # If we
c2e0: 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 can still conne
c2f0: 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 ct to the server
c300: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 , the socket got
c310: 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 inherited...
c320: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
c330: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
c340: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
c350: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c360: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
c370: 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 ntKey \. . 127
c380: 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 .0.0.1 8828} msg
c390: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 ]} {..set x {ser
c3a0: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
c3b0: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 ot inherited}.
c3c0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
c3d0: 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 e $msg..set x {s
c3e0: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
c3f0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
c400: 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }.. set x.} {
c410: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
c420: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
c430: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e ..test tlsIO-12.
c440: 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 2 {testing inher
c450: 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 itance of client
c460: 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 sockets} {socke
c470: 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 t exec} {. ma
c480: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
c490: 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 1. makeFile {
c4a0: 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 } script2.. #
c4b0: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
c4c0: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
c4d0: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
c4e0: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
c4f0: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
c500: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
c510: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
c520: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
c530: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
c540: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
c550: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
c560: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c570: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c580: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f . # Script2 o
c590: 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 pens the client
c5a0: 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 socket and write
c5b0: 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 s to it. It the
c5c0: 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 n. # launches
c5d0: 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 script1 and exi
c5e0: 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c ts. If the chil
c5f0: 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 d process inheri
c600: 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c ted the. # cl
c610: 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 ient socket, the
c620: 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 socket will sti
c630: 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 ll be open...
c640: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c650: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
c660: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
c670: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
c680: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
c690: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
c6a0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
c6b0: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
c6c0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
c6d0: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
c6e0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
c6f0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
c700: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
c710: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c720: 43 65 72 74 20 5c 0a 09 20 20 20 20 2d 6b 65 79 Cert \.. -key
c730: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
c740: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5c 5d 127.0.0.1 8829\]
c750: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
c760: 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 .exec $tclsh scr
c770: 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 ipt1 &..puts $f
c780: 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 testing..flush $
c790: 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 f..after 1000 ex
c7a0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
c7b0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c7c0: 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 e $f.. # Crea
c7d0: 74 65 20 74 68 65 20 73 65 72 76 65 72 20 73 6f te the server so
c7e0: 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 cket.. set se
c7f0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
c800: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
c810: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
c820: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
c830: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
c840: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
c850: 72 20 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 r accept 8829].
c860: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
c870: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
c880: 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 68 65 20 } {..# When the
c890: 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c client connects,
c8a0: 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 establish the r
c8b0: 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f ead handler..glo
c8c0: 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 bal server..clos
c8d0: 65 20 24 73 65 72 76 65 72 0a 09 66 63 6f 6e 66 e $server..fconf
c8e0: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 6c 6f igure $file -blo
c8f0: 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 cking 0..fileeve
c900: 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c nt $file readabl
c910: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 e [list do_hands
c920: 68 61 6b 65 20 24 66 69 6c 65 20 72 65 61 64 61 hake $file reada
c930: 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 20 67 65 ble \...[list ge
c940: 74 64 61 74 61 20 63 6c 69 65 6e 74 5d 20 2d 62 tdata client] -b
c950: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 uffering line]..
c960: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 return. }..
c970: 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 # If the socke
c980: 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e t doesn't hit en
c990: 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 d-of-file in 5 s
c9a0: 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 econds, the.
c9b0: 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 # script1 proces
c9c0: 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 s must have inhe
c9d0: 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 rited the client
c9e0: 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 ... set faile
c9f0: 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 d 0. after 50
ca00: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 00 [list set fai
ca10: 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 led 1].. # La
ca20: 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 unch the script2
ca30: 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 process.. ex
ca40: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
ca50: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
ca60: 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 .. vwait x.
ca70: 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 if {!$failed}
ca80: 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a {..vwait failed.
ca90: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
caa0: 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 } {client socket
cab0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
cac0: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
cad0: 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.3 {testing in
cae0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 heritance of acc
caf0: 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c epted sockets} \
cb00: 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 63 20 75 ..{socket exec u
cb10: 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d nixOnly} {. m
cb20: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
cb30: 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 t1. makeFile
cb40: 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 {} script2..
cb50: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
cb60: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
cb70: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
cb80: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
cb90: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
cba0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 close $f.. se
cbb0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
cbc0: 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 2 w]. puts $f
cbd0: 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 [list set tclsh
cbe0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
cbf0: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
cc00: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
cc10: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
cc20: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
cc30: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
cc40: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
cc50: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
cc60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
cc70: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
cc80: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
cc90: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
cca0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
ccb0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 39 33 30 $serverKey 8930
ccc0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
ccd0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
cce0: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
ccf0: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
cd00: 74 63 6c 73 68 0a 09 20 20 20 20 66 63 6f 6e 66 tclsh.. fconf
cd10: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 igure $file -buf
cd20: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
cd30: 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 puts $file {tes
cd40: 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 t data on socket
cd50: 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 6c }.. exec $tcl
cd60: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 sh script1 &..
cd70: 20 20 61 66 74 65 72 20 31 30 30 30 20 65 78 69 after 1000 exi
cd80: 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 t..}..vwait fore
cd90: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
cda0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 ose $f.. # La
cdb0: 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 unch the script2
cdc0: 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e process and con
cdd0: 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 nect to it. See
cde0: 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 how long. #
cdf0: 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 the socket stays
ce00: 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 open.. exec
ce10: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
ce20: 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 est script2 &..
ce30: 20 20 20 61 66 74 65 72 20 32 30 30 30 20 73 65 after 2000 se
ce40: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
ce50: 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 1. vwait ok_t
ce60: 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 o_proceed.. s
ce70: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
ce80: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
ce90: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
cea0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ceb0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
cec0: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
ced0: 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 0.1 8930]. fc
cee0: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 onfigure $f -buf
cef0: 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f fering full -blo
cf00: 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 cking 0. # We
cf10: 20 6e 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 need to put a b
cf20: 79 74 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 yte into the rea
cf30: 64 20 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 d queue, otherwi
cf40: 73 65 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 se the. # TLS
cf50: 20 68 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e handshake doesn
cf60: 27 74 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 't finish. pu
cf70: 74 73 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 ts $f a; flush $
cf80: 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 f. fileevent
cf90: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
cfa0: 74 20 67 65 74 64 61 74 61 20 61 63 63 65 70 74 t getdata accept
cfb0: 65 64 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 ed $f].. # If
cfc0: 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 the socket is s
cfd0: 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 till open after
cfe0: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 5 seconds, the s
cff0: 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 cript1 process.
d000: 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 # must have i
d010: 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 nherited the acc
d020: 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 epted socket...
d030: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
d040: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 after 5000 s
d050: 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 et failed 1..
d060: 20 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 vwait x. set
d070: 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 x.} {accepted s
d080: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
d090: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 herited}..test t
d0a0: 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 73 74 69 lsIO-13.1 {Testi
d0b0: 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 ng use of shared
d0c0: 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 socket between
d0d0: 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 two threads} \..
d0e0: 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 {socket testthre
d0f0: 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 ad} {. # HOBB
d100: 53 3a 20 6e 65 76 65 72 20 74 65 73 74 65 64 0a S: never tested.
d110: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
d120: 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 cript. thread
d130: 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 Reap.. makeFi
d140: 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 le {. .packag
d150: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
d160: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
d170: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
d180: 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 8828]..proc acc
d190: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 ept {s a p} {.
d1a0: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 fileev
d1b0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
d1c0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
d1d0: 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 fconf
d1e0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
d1f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
d200: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
d210: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c } {.. global
d220: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d230: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
d240: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
d250: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
d260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
d270: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
d280: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
d290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d2a0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
d2b0: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
d2c0: 20 7b 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 {.. inc
d2d0: 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 r i.
d2e0: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
d2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
d300: 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 }..set i 0..vwai
d310: 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 t x..close $f...
d320: 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 # thread cleans
d330: 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 itself up...test
d340: 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 thread exit.
d350: 7d 20 73 63 72 69 70 74 0a 0a 20 20 20 20 23 20 } script.. #
d360: 63 72 65 61 74 65 20 61 20 74 68 72 65 61 64 0a create a thread.
d370: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 74 68 set serverth
d380: 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 64 read [testthread
d390: 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 65 create { source
d3a0: 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 script } ].
d3b0: 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 update.. afte
d3c0: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 r 1000. set s
d3d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
d3e0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
d3f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
d400: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
d410: 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 75 . catch {..pu
d420: 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 ts $s "hello"..g
d430: 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 20 ets $s result.
d440: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
d450: 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 . update..
d460: 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 20 after 2000.
d470: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
d480: 74 68 72 65 61 64 52 65 61 70 5d 0a 0a 20 20 20 threadReap]..
d490: 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b set result..} {
d4a0: 68 65 6c 6c 6f 20 31 7d 0a 0a 74 65 73 74 20 74 hello 1}..test t
d4b0: 6c 73 49 4f 2d 31 34 2e 31 20 7b 74 65 73 74 20 lsIO-14.1 {test
d4c0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b tls::unimport} {
d4d0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
d4e0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
d4f0: 75 6e 69 6d 70 6f 72 74 7d 20 6d 73 67 5d 20 24 unimport} msg] $
d500: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
d510: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
d520: 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 e "tls::unimport
d530: 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 channel"}}.test
d540: 20 74 6c 73 49 4f 2d 31 34 2e 32 20 7b 74 65 73 tlsIO-14.2 {tes
d550: 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d t tls::unimport}
d560: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
d570: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
d580: 3a 3a 75 6e 69 6d 70 6f 72 74 20 66 6f 6f 20 62 ::unimport foo b
d590: 61 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 ar} msg] $msg.}
d5a0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
d5b0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
d5c0: 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e ::unimport chann
d5d0: 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f el"}}.test tlsIO
d5e0: 2d 31 34 2e 33 20 7b 74 65 73 74 20 74 6c 73 3a -14.3 {test tls:
d5f0: 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b :unimport} {sock
d600: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
d610: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d catch {tls::unim
d620: 70 6f 72 74 20 62 6f 67 75 73 7d 20 6d 73 67 5d port bogus} msg]
d630: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 63 61 6e 20 $msg.} {1 {can
d640: 6e 6f 74 20 66 69 6e 64 20 63 68 61 6e 6e 65 6c not find channel
d650: 20 6e 61 6d 65 64 20 22 62 6f 67 75 73 22 7d 7d named "bogus"}}
d660: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 34 .test tlsIO-14.4
d670: 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d {test tls::unim
d680: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b port} {socket} {
d690: 0a 20 20 20 20 23 20 73 74 64 69 6e 20 63 61 6e . # stdin can
d6a0: 20 74 61 6b 65 20 64 69 66 66 65 72 65 6e 74 20 take different
d6b0: 6e 61 6d 65 73 20 61 73 20 74 68 65 20 22 74 6f names as the "to
d6c0: 70 22 20 63 68 61 6e 6e 65 6c 0a 20 20 20 20 6c p" channel. l
d6d0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
d6e0: 3a 75 6e 69 6d 70 6f 72 74 20 73 74 64 69 6e 7d :unimport stdin}
d6f0: 20 6d 73 67 5d 20 5c 0a 09 5b 73 74 72 69 6e 67 msg] \..[string
d700: 20 6d 61 74 63 68 20 7b 62 61 64 20 63 68 61 6e match {bad chan
d710: 6e 65 6c 20 22 2a 22 3a 20 6e 6f 74 20 61 20 73 nel "*": not a s
d720: 74 61 63 6b 65 64 20 63 68 61 6e 6e 65 6c 7d 20 tacked channel}
d730: 24 6d 73 67 5d 0a 7d 20 7b 31 20 31 7d 0a 74 65 $msg].} {1 1}.te
d740: 73 74 20 74 6c 73 49 4f 2d 31 34 2e 35 20 7b 74 st tlsIO-14.5 {t
d750: 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 est tls::unimpor
d760: 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 t} {socket} {.
d770: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
d780: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
d790: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
d7a0: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
d7b0: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
d7c0: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
d7d0: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
d7e0: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
d7f0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
d800: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
d810: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
d820: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
d830: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
d840: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
d850: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
d860: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
d870: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
d880: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
d890: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
d8a0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
d8b0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
d8c0: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
d8d0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
d8e0: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 _handshake $s re
d8f0: 61 64 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c adable readlittl
d900: 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 e \...-buffering
d910: 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 none]. }.
d920: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
d930: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ket -certfile $s
d940: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
d950: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
d960: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
d970: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
d980: 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 ept 8831]. se
d990: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
d9a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
d9b0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
d9c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
d9d0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
d9e0: 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 localhost 8831
d9f0: 5d 0a 20 20 20 20 23 20 6f 6e 6c 79 20 74 68 65 ]. # only the
da00: 20 63 6c 69 65 6e 74 20 67 65 74 73 20 74 6c 73 client gets tls
da10: 3a 3a 69 6d 70 6f 72 74 0a 20 20 20 20 73 65 74 ::import. set
da20: 20 72 65 73 20 5b 74 6c 73 3a 3a 75 6e 69 6d 70 res [tls::unimp
da30: 6f 72 74 20 24 63 5d 0a 20 20 20 20 6c 69 73 74 ort $c]. list
da40: 20 24 72 65 73 20 5b 63 61 74 63 68 20 7b 63 6c $res [catch {cl
da50: 6f 73 65 20 24 63 7d 20 65 72 72 5d 20 24 65 72 ose $c} err] $er
da60: 72 20 5c 0a 09 5b 63 61 74 63 68 20 7b 63 6c 6f r \..[catch {clo
da70: 73 65 20 24 73 7d 20 65 72 72 5d 20 24 65 72 72 se $s} err] $err
da80: 0a 7d 20 7b 7b 7d 20 30 20 7b 7d 20 30 20 7b 7d .} {{} 0 {} 0 {}
da90: 7d 0a 0a 74 65 73 74 20 74 6c 73 2d 62 75 67 35 }..test tls-bug5
daa0: 38 2d 31 2e 30 20 7b 74 65 73 74 20 70 72 6f 74 8-1.0 {test prot
dab0: 6f 63 6f 6c 20 6e 65 67 6f 74 69 61 74 69 6f 6e ocol negotiation
dac0: 20 66 61 69 6c 75 72 65 7d 20 7b 73 6f 63 6b 65 failure} {socke
dad0: 74 7d 20 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f t} {. # Follo
dae0: 77 69 6e 67 20 63 6f 64 65 20 69 73 20 62 61 73 wing code is bas
daf0: 65 64 20 6f 6e 20 77 68 61 74 20 77 61 73 20 72 ed on what was r
db00: 65 70 6f 72 74 65 64 20 69 6e 20 62 75 67 20 23 eported in bug #
db10: 35 38 2e 20 50 72 69 6f 72 0a 20 20 20 20 23 20 58. Prior. #
db20: 74 6f 20 66 69 78 20 74 68 65 20 70 72 6f 67 72 to fix the progr
db30: 61 6d 20 77 6f 75 6c 64 20 63 72 61 73 68 20 77 am would crash w
db40: 69 74 68 20 61 20 73 65 67 66 61 75 6c 74 2e 0a ith a segfault..
db50: 20 20 20 20 70 72 6f 63 20 41 63 63 65 70 74 20 proc Accept
db60: 7b 73 6f 63 6b 20 61 72 67 73 7d 20 7b 0a 20 20 {sock args} {.
db70: 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 fconfigure
db80: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
db90: 20 30 3b 0a 20 20 20 20 20 20 20 20 66 69 6c 65 0;. file
dba0: 65 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 event $sock read
dbb0: 61 62 6c 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 able [list Hands
dbc0: 68 61 6b 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 hake $sock].
dbd0: 7d 0a 20 20 20 20 70 72 6f 63 20 48 61 6e 64 73 }. proc Hands
dbe0: 68 61 6b 65 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 hake {sock} {.
dbf0: 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 set ::done
dc00: 20 48 41 4e 44 0a 20 20 20 20 20 20 20 20 63 61 HAND. ca
dc10: 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 tch {tls::handsh
dc20: 61 6b 65 20 24 73 6f 63 6b 7d 20 6d 73 67 0a 20 ake $sock} msg.
dc30: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e set ::don
dc40: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
dc50: 20 23 20 4e 4f 54 45 3a 20 77 68 65 6e 20 64 6f # NOTE: when do
dc60: 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 ing an in-proces
dc70: 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 s client/server
dc80: 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 test, both sides
dc90: 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 need. # to b
dca0: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
dcb0: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
dcc0: 68 61 6b 65 0a 0a 20 20 20 20 23 20 53 65 72 76 hake.. # Serv
dcd0: 65 72 20 2d 20 4f 6e 6c 79 20 61 63 63 65 70 74 er - Only accept
dce0: 20 54 4c 53 20 31 2e 32 0a 20 20 20 20 73 65 74 TLS 1.2. set
dcf0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
dd00: 5c 0a 20 20 20 20 20 20 20 20 2d 63 65 72 74 66 \. -certf
dd10: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
dd20: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
dd30: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
dd40: 4b 65 79 20 2d 72 65 71 75 65 73 74 20 30 20 5c Key -request 0 \
dd50: 0a 09 2d 72 65 71 75 69 72 65 20 30 20 2d 73 73 ..-require 0 -ss
dd60: 6c 32 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c l2 0 -ssl3 0 -tl
dd70: 73 31 20 30 20 2d 74 6c 73 31 2e 31 20 30 20 2d s1 0 -tls1.1 0 -
dd80: 74 6c 73 31 2e 32 20 31 20 2d 74 6c 73 31 2e 33 tls1.2 1 -tls1.3
dd90: 20 30 20 5c 0a 20 20 20 20 20 20 20 20 2d 73 65 0 \. -se
dda0: 72 76 65 72 20 41 63 63 65 70 74 20 38 38 33 31 rver Accept 8831
ddb0: 5d 0a 20 20 20 20 23 20 43 6c 69 65 6e 74 20 2d ]. # Client -
ddc0: 20 4f 6e 6c 79 20 70 72 6f 70 6f 73 65 20 54 4c Only propose TL
ddd0: 53 31 2e 30 0a 20 20 20 20 73 65 74 20 63 20 5b S1.0. set c [
dde0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 61 73 79 tls::socket -asy
ddf0: 6e 63 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 nc -cafile $caCe
de00: 72 74 20 2d 72 65 71 75 65 73 74 20 30 20 2d 72 rt -request 0 -r
de10: 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 73 73 6c equire 0 \..-ssl
de20: 32 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 2 0 -ssl3 0 -tls
de30: 31 20 31 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 1 1 -tls1.1 0 -t
de40: 6c 73 31 2e 32 20 30 20 2d 74 6c 73 31 2e 33 20 ls1.2 0 -tls1.3
de50: 30 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 0 localhost 8831
de60: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
de70: 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a $c -blocking 0.
de80: 20 20 20 20 70 75 74 73 20 24 63 20 61 20 3b 20 puts $c a ;
de90: 66 6c 75 73 68 20 24 63 0a 20 20 20 20 61 66 74 flush $c. aft
dea0: 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 er 5000 [list se
deb0: 74 20 3a 3a 64 6f 6e 65 20 74 69 6d 65 6f 75 74 t ::done timeout
dec0: 5d 0a 20 20 20 20 76 77 61 69 74 20 3a 3a 64 6f ]. vwait ::do
ded0: 6e 65 0a 20 20 20 20 73 77 69 74 63 68 20 2d 65 ne. switch -e
dee0: 78 61 63 74 20 2d 2d 20 24 3a 3a 64 6f 6e 65 20 xact -- $::done
def0: 7b 0a 20 20 20 20 20 20 20 20 22 68 61 6e 64 73 {. "hands
df00: 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f hake failed: wro
df10: 6e 67 20 73 73 6c 20 76 65 72 73 69 6f 6e 22 20 ng ssl version"
df20: 2d 0a 20 20 20 20 20 20 20 20 22 68 61 6e 64 73 -. "hands
df30: 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 75 6e 73 hake failed: uns
df40: 75 70 70 6f 72 74 65 64 20 70 72 6f 74 6f 63 6f upported protoco
df50: 6c 22 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 l" {.
df60: 20 73 65 74 20 3a 3a 64 6f 6e 65 20 22 68 61 6e set ::done "han
df70: 64 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 dshake failed: w
df80: 72 6f 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d rong version num
df90: 62 65 72 22 0a 20 20 20 20 20 20 20 20 7d 0a 20 ber". }.
dfa0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 3a 3a 64 }. set ::d
dfb0: 6f 6e 65 0a 7d 20 7b 68 61 6e 64 73 68 61 6b 65 one.} {handshake
dfc0: 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 failed: wrong v
dfd0: 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 7d 0a 0a ersion number}..
dfe0: 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 # cleanup.if {[s
dff0: 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b tring match sock
e000: 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 * $commandSocket
e010: 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 ] == 1} {. put
e020: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
e030: 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 exit. flush $
e040: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a commandSocket.}.
e050: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f catch {close $co
e060: 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 mmandSocket}.cat
e070: 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 ch {close $remot
e080: 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c eProcChan}.::tcl
e090: 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 test::cleanupTes
e0a0: 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a ts.flush stdout.
e0b0: 72 65 74 75 72 6e 0a return.