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