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 6c verKey -myaddr l
3700: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 20 5c 5d ocalhost 8831 \]
3710: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3720: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
3730: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
3740: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
3750: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
3760: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
3770: 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 ck]".
3780: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3790: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
37a0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
37b0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
37c0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
37d0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
37e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
37f0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3800: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3810: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3820: 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 ] 2> /dev/null"
3830: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
3840: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
3850: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
3860: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3870: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3880: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3890: 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 clientKey localh
38a0: 6f 73 74 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d ost 8831} sock]}
38b0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
38c0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
38d0: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
38e0: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
38f0: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
3900: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
3910: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
3920: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
3930: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3940: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
3950: 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 hello}..test tls
3960: 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e IO-2.5 {tcp conn
3970: 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 ection with redu
3980: 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 ndant server por
3990: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
39a0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
39b0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
39c0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
39d0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
39e0: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
39f0: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
3a00: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3a10: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3a20: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
3a30: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
3a40: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
3a50: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3a60: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3a70: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3a80: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3a90: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3aa0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
3ab0: 72 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 rverKey 8832 \]"
3ac0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3ad0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 proc accept {soc
3ae0: 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 k addr port} {.
3af0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
3b00: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
3b10: 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 puts "[gets $soc
3b20: 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 k]".
3b30: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3b40: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3b50: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
3b60: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
3b70: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
3b80: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
3b90: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3ba0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3bb0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3bc0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3bd0: 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2> /dev/null" r
3be0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
3bf0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
3c00: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3c10: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3c20: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3c30: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3c40: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3c50: 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 .1 8832} sock]}
3c60: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3c70: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3c80: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
3c90: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
3ca0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
3cb0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3cc0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3cd0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3ce0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3cf0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3d00: 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f ello}.test tlsIO
3d10: 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.6 {tcp connec
3d20: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tion} {socket} {
3d30: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
3d40: 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 ok. if {![cat
3d50: 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c ch {set sock [tl
3d60: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3d70: 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 0.1 8833]}]} {..
3d80: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 if {![catch {get
3d90: 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 s $sock}]} {..
3da0: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
3db0: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
3dc0: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ock. }. se
3dd0: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
3de0: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 est tlsIO-2.7 {e
3df0: 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 cho server, one
3e00: 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 line} {socket st
3e10: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
3e20: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3e30: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3e40: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3e50: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
3e60: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
3e70: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
3e80: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3e90: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3ea0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3eb0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3ec0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3ed0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3ee0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3ef0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3f00: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3f10: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3f20: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 $serverKey 8834
3f30: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3f40: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3f50: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
3f60: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
3f70: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
3f80: 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 echo $s].. f
3f90: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
3fa0: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
3fb0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
3fc0: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
3fd0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 o {s} {.. se
3fe0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
3ff0: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
4000: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
4010: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
4020: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
4030: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
4040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4050: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
4060: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
4070: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4080: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
4090: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
40a0: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
40b0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
40c0: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
40d0: 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 $f..puts done.
40e0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
40f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4100: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4110: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4120: 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c ipt] 2> /dev/nul
4130: 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 l" r]. gets $
4140: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
4150: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4160: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4170: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4180: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4190: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
41a0: 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8834]. fconfi
41b0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
41c0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
41d0: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 tion lf. puts
41e0: 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 $s "hello abcde
41f0: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 fghijklmnop".
4200: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 after 1000.
4210: 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a set x [gets $s].
4220: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4230: 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d set y [gets $f]
4240: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4250: 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b list $x $y.} {
4260: 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 {hello abcdefghi
4270: 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a jklmnop} done}..
4280: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b test tlsIO-2.8 {
4290: 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f echo server, loo
42a0: 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 p 50 times, sing
42b0: 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b le connection} {
42c0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
42d0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
42e0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
42f0: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
4300: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
4310: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
4320: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
4330: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
4340: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
4350: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
4360: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4370: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
4380: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
4390: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
43a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
43b0: 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 5 \]". puts $
43c0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
43d0: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
43e0: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
43f0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
4400: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
4410: 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 fconfigu
4420: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
4430: 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a line. }.
4440: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
4450: 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a .. global i.
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
4470: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
4480: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
4490: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
44a0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
44b0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
44c0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
44e0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
44f0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
4500: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
4510: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4520: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
4530: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
4540: 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 set i 0..puts re
4550: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
4560: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
4570: 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 x done"]..vwait
4580: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
4590: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
45a0: 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 f..puts "done $i
45b0: 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 ". }. clos
45c0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
45d0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
45e0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
45f0: 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 script] 2> /dev
4600: 2f 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 /null" r]. ge
4610: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
4620: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4630: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4640: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4650: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4660: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
4670: 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 20 66 63 0.1 8835]. fc
4680: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
4690: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
46a0: 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 catch {..for {se
46b0: 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d t x 0} {$x < 50}
46c0: 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 {incr x} {..
46d0: 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 puts $s "hello
46e0: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
46f0: 22 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 ".. gets $s..
4700: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 }. }. clos
4710: 65 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b e $s. catch {
4720: 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 7d set x [gets $f]}
4730: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4740: 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 set x.} {done
4750: 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 50}..test tlsIO-
4760: 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 2.9 {socket conf
4770: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
4780: 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 dio} {. set s
4790: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
47a0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
47b0: 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 8]. removeFil
47c0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
47d0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
47e0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
47f0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
4800: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
4810: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
4820: 6e 65 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ne $f {..package
4830: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c require tls..tl
4840: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4850: 72 20 61 63 63 65 70 74 20 38 38 32 38 0a 20 20 r accept 8828.
4860: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4870: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4880: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4890: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
48a0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
48b0: 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 s $f. after 1
48c0: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 00. set x [li
48d0: 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 st [catch {close
48e0: 20 24 66 7d 20 6d 73 67 5d 20 5b 73 74 72 69 6e $f} msg] [strin
48f0: 67 20 72 61 6e 67 65 20 24 6d 73 67 20 30 20 34 g range $msg 0 4
4900: 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 3]]. close $s
4910: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
4920: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
4930: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
4940: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
4950: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 .test tlsIO-2.10
4960: 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 {close on accep
4970: 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b t, accepted sock
4980: 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 et lives} {socke
4990: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e t} {. set don
49a0: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
49b0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
49c0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
49d0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 ut"]. set ss
49e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
49f0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4a00: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4a10: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4a20: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 t \..-keyfile $s
4a30: 65 72 76 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 erverKey 8830].
4a40: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
4a50: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
4a60: 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 ss..close $ss..
4a70: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4a80: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
4a90: 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 "..fconfigure $s
4aa0: 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d -trans lf. }
4ab0: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
4ac0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 {s} {..global d
4ad0: 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c one..gets $s..cl
4ae0: 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 ose $s..set done
4af0: 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 1. }. set
4b00: 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 cs [tls::socket
4b10: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4b20: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4b30: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4b40: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f le $clientKey lo
4b50: 63 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 calhost 8830].
4b60: 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 close $cs..
4b70: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
4b80: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
4b90: 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 mer. set done
4ba0: 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f .} 1..test tlsIO
4bb0: 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 -2.11 {detecting
4bc0: 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b new data} {sock
4bd0: 65 74 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 et} {. proc a
4be0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
4bf0: 09 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 20 .global sock..#
4c00: 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e when doing an in
4c10: 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f -process client/
4c20: 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 server test, bot
4c30: 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 h sides need..#
4c40: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
4c50: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
4c60: 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 andshake. Also
4c70: 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 make sure..# to
4c80: 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e return the chann
4c90: 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 el to line buffe
4ca0: 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e ring mode...fcon
4cb0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
4cc0: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
4cd0: 20 6c 69 6e 65 0a 09 73 65 74 20 73 6f 63 6b 20 line..set sock
4ce0: 24 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 $s..fileevent $s
4cf0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
4d00: 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 5d do_handshake $s]
4d10: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
4d20: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4d30: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
4d40: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
4d50: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4d60: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
4d70: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
4d80: 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 400]. set soc
4d90: 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 k "". set s2
4da0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4db0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4dc0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4dd0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4de0: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
4df0: 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 23 20 0.1 8400]. #
4e00: 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e when doing an in
4e10: 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f -process client/
4e20: 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 server test, bot
4e30: 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 h sides need.
4e40: 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f # to be non-blo
4e50: 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c cking for the TL
4e60: 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 S handshake Als
4e70: 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 o make sure to.
4e80: 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 20 # return the
4e90: 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 channel to line
4ea0: 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 buffering mode (
4eb0: 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 27 TLS sets it to '
4ec0: 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e none').. fcon
4ed0: 66 69 67 75 72 65 20 24 73 32 20 2d 62 6c 6f 63 figure $s2 -bloc
4ee0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
4ef0: 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 74 g line. vwait
4f00: 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 sock. puts $
4f10: 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 s2 one. flush
4f20: 20 24 73 32 0a 20 20 20 20 23 20 6e 65 65 64 20 $s2. # need
4f30: 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 update to comple
4f40: 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 te TLS handshake
4f50: 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 in-process.
4f60: 75 70 64 61 74 65 0a 20 20 20 20 61 66 74 65 72 update. after
4f70: 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 500. fconfig
4f80: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4f90: 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 ing 0. set re
4fa0: 73 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 73 6f sult a:[gets $so
4fb0: 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 ck]. lappend
4fc0: 72 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 20 24 result b:[gets $
4fd0: 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 sock]. fconfi
4fe0: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
4ff0: 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 king 1. puts
5000: 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 $s2 two. flus
5010: 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 h $s2. fconfi
5020: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
5030: 6b 69 6e 67 20 31 0a 20 20 20 20 6c 61 70 70 65 king 1. lappe
5040: 6e 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 65 74 nd result c:[get
5050: 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f s $sock]. fco
5060: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
5070: 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c locking 1. cl
5080: 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 ose $s2. clos
5090: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
50a0: 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 73 sock. set res
50b0: 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 ult.} {a:one b:
50c0: 63 3a 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 c:two}..test tls
50d0: 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e IO-2.12 {tcp con
50e0: 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 nection; no cert
50f0: 69 66 69 63 61 74 65 73 20 73 70 65 63 69 66 69 ificates specifi
5100: 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 ed} \..{socket s
5110: 74 64 69 6f 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b tdio unixOnly} {
5120: 0a 20 20 20 20 23 20 54 68 65 72 65 20 69 73 20 . # There is
5130: 61 20 64 65 62 75 67 20 61 73 73 65 72 74 69 6f a debug assertio
5140: 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c n on Windows/SSL
5150: 20 74 68 61 74 20 63 61 75 73 65 73 20 61 20 63 that causes a c
5160: 72 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 rash when the.
5170: 20 20 23 20 63 65 72 74 69 66 69 63 61 74 65 20 # certificate
5180: 69 73 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e isn't specified.
5190: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
51a0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
51b0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
51c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
51d0: 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 st set auto_path
51e0: 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 $auto_path].
51f0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
5200: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
5210: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
5220: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 69 r 2000 "set x ti
5230: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 med_out"]..set f
5240: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
5250: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
5260: 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 8]..proc accept
5270: 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d {file addr port}
5280: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
5290: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
52a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
52b0: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 se $file..}..put
52c0: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
52d0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
52e0: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
52f0: 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 .puts $x. }.
5300: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5310: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
5320: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
5330: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 tcltest script]
5340: 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 2> /dev/null" r]
5350: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
5360: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
5370: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
5380: 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d .0.1 8828} msg]}
5390: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
53a0: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
53b0: 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 {. lappe
53c0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
53d0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 close $ms
53e0: 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 g. }. lapp
53f0: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
5400: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5410: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
5420: 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 done {}}..test t
5430: 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 lsIO-3.1 {socket
5440: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
5450: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
5460: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
5470: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
5480: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
5490: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
54a0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
54b0: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
54c0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
54d0: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
54e0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
54f0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
5500: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5510: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
5520: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
5530: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5540: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
5550: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
5560: 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 {..puts ready..g
5570: 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 ets stdin..close
5580: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
5590: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
55a0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
55b0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
55c0: 73 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 st script] 2> /d
55d0: 65 76 2f 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 ev/null" r+].
55e0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
55f0: 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 x [list [catch
5600: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 {tls::socket \..
5610: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
5620: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5630: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5640: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5650: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
5660: 65 70 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 5c ept 8828} msg] \
5670: 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 ...$msg]. put
5680: 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f s $f bye. clo
5690: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
56a0: 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f } {1 {couldn't o
56b0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 pen socket: addr
56c0: 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 ess already in u
56d0: 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f se}}..test tlsIO
56e0: 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 -3.2 {server wit
56f0: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
5700: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
5710: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
5720: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
5730: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
5740: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
5750: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
5760: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
5770: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
5780: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
5790: 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 74 65 ls..set t1 [afte
57a0: 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 r 30000 "set x t
57b0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
57c0: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
57d0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
57e0: 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 65 "]..set t3 [afte
57f0: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 r 32000 "set x t
5800: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
5810: 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 7d 0a counter 0. }.
5820: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5830: 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s \[tls::socket
5840: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
5850: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
5860: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
5870: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5880: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c serverKey 8828 \
5890: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
58a0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
58b0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c a p} {.. fil
58c0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
58d0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
58e0: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
58f0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
5900: 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 line..}..proc ec
5910: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
5920: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
5930: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
5940: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
5950: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
5960: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
5970: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
5980: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
5990: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
59a0: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 p
59c0: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
59d0: 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 }..}..put
59e0: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
59f0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5a00: 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t1..vwait x..aft
5a10: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 er cancel $t2..v
5a20: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5a30: 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 ncel $t3..close
5a40: 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 $s..puts $x.
5a50: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
5a60: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
5a70: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
5a80: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
5a90: 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 t] 2> /dev/null"
5aa0: 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b r+]. set x [
5ab0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 gets $f]. set
5ac0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
5ad0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5ae0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5af0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5b00: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5b10: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5b20: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
5b30: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 nfigure $s1 -buf
5b40: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5b50: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
5b60: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
5b70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
5b80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
5b90: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
5ba0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
5bb0: 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 0.0.1 8828].
5bc0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
5bd0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
5be0: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
5bf0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5c00: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5c10: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5c20: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5c30: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
5c40: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 27.0.0.1 8828].
5c50: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5c60: 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 3 -buffering lin
5c70: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 e. for {set i
5c80: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
5c90: 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 incr i} {..puts
5ca0: 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d $s1 hello,tlsIO-
5cb0: 33 2e 32 2c 73 31 0a 09 67 65 74 73 20 24 73 31 3.2,s1..gets $s1
5cc0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
5cd0: 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 32 0a 09 67 ,tlsIO-3.2,s2..g
5ce0: 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 ets $s2..puts $s
5cf0: 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 3 hello,tlsIO-3.
5d00: 32 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 2,s3..gets $s3.
5d10: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5d20: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
5d30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
5d40: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
5d50: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
5d60: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
5d70: 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 {ready done}..te
5d80: 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 st tlsIO-4.1 {se
5d90: 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 rver with severa
5da0: 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b l clients} {sock
5db0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
5dc0: 23 20 68 61 76 65 20 73 65 65 6e 20 69 6e 74 65 # have seen inte
5dd0: 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 73 20 6f rmittent hangs o
5de0: 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 72 65 n Windows. re
5df0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
5e00: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5e10: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
5e20: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
5e30: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
5e40: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
5e50: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
5e60: 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 uire tls..gets s
5e70: 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 tdin. }. p
5e80: 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b uts $f "set s \[
5e90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
5ea0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5eb0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5ec0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5ed0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
5ee0: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
5ef0: 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 s $f {..fconfigu
5f00: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
5f10: 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 line..for {set
5f20: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
5f30: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 {incr i} {..
5f40: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 puts $s hello..
5f50: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 gets $s..}..c
5f60: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 lose $s..puts by
5f70: 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 e..gets stdin.
5f80: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
5f90: 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 . set p1 [ope
5fa0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5fb0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5fc0: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 ript] 2> /dev/nu
5fd0: 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e ll" r+]. fcon
5fe0: 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 figure $p1 -buff
5ff0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
6000: 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c et p2 [open "|[l
6010: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6020: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 tcltest script]
6030: 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2b 2> /dev/null" r+
6040: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
6050: 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $p2 -buffering
6060: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 line. set p3
6070: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
6080: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
6090: 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 t script] 2> /de
60a0: 76 2f 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 v/null" r+].
60b0: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d fconfigure $p3 -
60c0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
60d0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
60e0: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
60f0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
6100: 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 ng line..fileeve
6110: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
6120: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 list echo $s].
6130: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 }. proc ech
6140: 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 o {s} {..global
6150: 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 x. set l
6160: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
6170: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
6180: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c {. cl
6190: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
61a0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
61b0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 } else {.
61c0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
61d0: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a $s $l. }.
61e0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 }. set t1
61f0: 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 [after 30000 "s
6200: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
6210: 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 . set t2 [aft
6220: 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 er 31000 "set x
6230: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
6240: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
6250: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6260: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 _out"]. set s
6270: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
6280: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6290: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
62a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
62b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
62c0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
62d0: 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 cept 8828]. p
62e0: 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 uts $p1 open.
62f0: 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 puts $p2 open.
6300: 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e puts $p3 open
6310: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
6320: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
6330: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
6340: 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 ancel $t1. af
6350: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 ter cancel $t2.
6360: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6370: 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $t3. close $s
6380: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
6390: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
63a0: 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 t p1 [gets $p1]
63b0: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
63c0: 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 l [list p2 [gets
63d0: 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p2] $x]. la
63e0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 ppend l [list p3
63f0: 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a [gets $p3] $x].
6400: 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 puts $p1 bye
6410: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 . puts $p2 by
6420: 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 e. puts $p3 b
6430: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 ye. close $p1
6440: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 . close $p2.
6450: 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 close $p3.
6460: 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 set l.} {{p1 by
6470: 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 e done} {p2 bye
6480: 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f done} {p3 bye do
6490: 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ne}}..test tlsIO
64a0: 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -4.2 {byte order
64b0: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
64c0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
64d0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
64e0: 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 set x ok. if
64f0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
6500: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
6510: 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d do 0x3000} msg]}
6520: 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 {..set x $msg.
6530: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f } else {..clo
6540: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
6550: 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 set x.} ok..te
6560: 73 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 st tlsIO-5.1 {by
6570: 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d te order problem
6580: 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 s, socket number
6590: 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f s, htons} \..{so
65a0: 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f cket unixOnly no
65b0: 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 tRoot} {. set
65c0: 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 x {couldn't ope
65d0: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
65e0: 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 ner}. if {![c
65f0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
6600: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
6610: 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 x1} msg]} {.
6620: 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 set x {htons
6630: 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 problem, should
6640: 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 be disallowed,
6650: 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 are you running
6660: 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 as SU?}..close $
6670: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
6680: 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 t x.} {couldn't
6690: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
66a0: 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 owner}.test tls
66b0: 49 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 IO-5.2 {byte ord
66c0: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
66d0: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
66e0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
66f0: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
6700: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6710: 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 port number too
6720: 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b high}. if {![
6730: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
6740: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
6750: 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0x10000} msg]} {
6760: 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 ..set x {port re
6770: 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d solution problem
6780: 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 , should be disa
6790: 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 llowed}..close $
67a0: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
67b0: 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 t x.} {couldn't
67c0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 open socket: por
67d0: 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 t number too hig
67e0: 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e h}.test tlsIO-5.
67f0: 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 3 {byte order pr
6800: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
6810: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c umbers, htons} \
6820: 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e ..{socket unixOn
6830: 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 ly notRoot} {.
6840: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
6850: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
6860: 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 ot owner}. if
6870: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a {![catch {tls::
6880: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
6890: 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a odo 21} msg]} {.
68a0: 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 .set x {htons pr
68b0: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
68c0: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
68d0: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
68e0: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
68f0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
6900: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
6910: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
6920: 6e 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ner}..test tlsIO
6930: 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c -6.1 {accept cal
6940: 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f lback error} {so
6950: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
6960: 20 20 23 20 54 68 65 72 65 20 69 73 20 61 20 64 # There is a d
6970: 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f ebug assertion o
6980: 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 n Windows/SSL th
6990: 61 74 20 63 61 75 73 65 73 20 61 20 63 72 61 73 at causes a cras
69a0: 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 h when the. #
69b0: 20 63 65 72 74 69 66 69 63 61 74 65 20 69 73 6e certificate isn
69c0: 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 't specified..
69d0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
69e0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
69f0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
6a00: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
6a10: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
6a20: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
6a30: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
6a40: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
6a50: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 ..gets stdin.
6a60: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b }. puts $f [
6a70: 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 list tls::socket
6a80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6a90: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 5d 127.0.0.1 8848]
6aa0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
6ab0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
6ac0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
6ad0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
6ae0: 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 ] 2> /dev/null"
6af0: 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 r+]. proc bge
6b00: 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f rror args {..glo
6b10: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 bal x..set x $ar
6b20: 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f gs. }. pro
6b30: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
6b40: 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 {expr 10 / 0}.
6b50: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
6b60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6b70: 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cept \.. -cer
6b80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
6b90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6ba0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
6bb0: 65 72 4b 65 79 20 38 38 34 38 5d 0a 20 20 20 20 erKey 8848].
6bc0: 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 puts $f hello.
6bd0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6be0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
6bf0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
6c00: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
6c10: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
6c20: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
6c30: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
6c40: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
6c50: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
6c60: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
6c70: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b test tlsIO-7.1 {
6c80: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6c90: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6ca0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
6cb0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
6cc0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
6cd0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
6ce0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
6cf0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
6d00: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
6d10: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
6d20: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
6d30: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
6d40: 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f $f [list tls::so
6d50: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
6d60: 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ept \.. -cert
6d70: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
6d80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6d90: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
6da0: 72 4b 65 79 20 38 38 32 30 5d 0a 20 20 20 20 70 rKey 8820]. p
6db0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
6dc0: 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 ccept args {..
6dd0: 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 global x..
6de0: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
6df0: 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 uts ready..set t
6e00: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6e10: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6e20: 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 ut"]..vwait x..a
6e30: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
6e40: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
6e50: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
6e60: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
6e70: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
6e80: 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 t script] 2> /de
6e90: 76 2f 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 v/null" r]. g
6ea0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
6eb0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
6ec0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6ed0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6ee0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6ef0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6f00: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
6f10: 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 8820]. set p
6f20: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6f30: 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c peername]. cl
6f40: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
6f50: 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $f. set l ""
6f60: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6f70: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
6f80: 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 lindex $p 0] 127
6f90: 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 .0.0.1]. lapp
6fa0: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f end l [string co
6fb0: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 mpare [lindex $p
6fc0: 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c 61 2] 8820]. la
6fd0: 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 ppend l [llength
6fe0: 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a $p].} {0 0 3}..
6ff0: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b test tlsIO-7.2 {
7000: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
7010: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
7020: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
7030: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
7040: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
7050: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
7060: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
7070: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
7080: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
7090: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
70a0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
70b0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
70c0: 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 $f "tls::socket
70d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
70e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
70f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7100: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7110: 65 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 erverKey 8821".
7120: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
7130: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
7140: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
7150: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
7160: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
7170: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
7180: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
7190: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
71a0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
71b0: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
71c0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
71d0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
71e0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
71f0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 32 3e ltest script] 2>
7200: 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 0a 20 /dev/null" r].
7210: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
7220: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7230: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
7240: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7250: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7260: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7270: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
7280: 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 73 65 0.1 8821]. se
7290: 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t p [fconfigure
72a0: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 $s -sockname].
72b0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
72c0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
72d0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
72e0: 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a l [llength $p].
72f0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
7300: 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 20 20 index $p 0].
7310: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
7320: 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 78 20 g equal [lindex
7330: 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 7b 33 $p 2] 8821].} {3
7340: 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 127.0.0.1 0}..t
7350: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 est tlsIO-7.3 {t
7360: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
7370: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
7380: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
7390: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
73a0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
73b0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
73c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
73d0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
73e0: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
73f0: 63 65 70 74 20 38 38 32 32 5d 0a 20 20 20 20 73 cept 8822]. s
7400: 65 74 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 5b 66 et l [llength [f
7410: 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 5d 0a 20 configure $s]].
7420: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
7430: 75 70 64 61 74 65 0a 20 20 20 20 23 20 41 20 62 update. # A b
7440: 75 67 20 66 69 78 65 64 20 69 6e 20 66 63 6f 6e ug fixed in fcon
7450: 66 69 67 75 72 65 20 66 6f 72 20 38 2e 33 2e 34 figure for 8.3.4
7460: 2b 20 6d 61 6b 65 20 74 68 69 73 20 72 65 74 75 + make this retu
7470: 72 6e 20 31 34 20 6e 6f 72 6d 61 6c 6c 79 2c 0a rn 14 normally,.
7480: 20 20 20 20 23 20 62 75 74 20 31 32 20 69 6e 20 # but 12 in
7490: 6f 6c 64 65 72 20 76 65 72 73 69 6f 6e 73 2e 0a older versions..
74a0: 20 20 20 20 65 78 70 72 20 7b 24 6c 20 3e 3d 20 expr {$l >=
74b0: 31 32 20 26 26 20 28 28 24 6c 20 25 20 32 29 20 12 && (($l % 2)
74c0: 3d 3d 20 30 29 7d 0a 7d 20 31 0a 0a 23 20 62 75 == 0)}.} 1..# bu
74d0: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
74e0: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
74f0: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
7500: 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a or '-sockname'..
7510: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b test tlsIO-7.4 {
7520: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
7530: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
7540: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
7550: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
7560: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7570: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7580: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7590: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
75a0: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
75b0: 63 63 65 70 74 20 38 38 32 33 5d 0a 20 20 20 20 ccept 8823].
75c0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
75d0: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a p} {..global x.
75e0: 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 .set x [fconfigu
75f0: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
7600: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7610: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
7620: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7630: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
7640: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7650: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7660: 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 6c 6f 63 ntKey \. .loc
7670: 61 6c 68 6f 73 74 20 38 38 32 33 5d 0a 20 20 20 alhost 8823].
7680: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
7690: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
76a0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
76b0: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
76c0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
76d0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
76e0: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
76f0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
7700: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 nd l [lindex $x
7710: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 2] [llength $x].
7720: 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 } {8823 3}..# bu
7730: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
7740: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
7750: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
7760: 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a or '-sockname'..
7770: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b test tlsIO-7.5 {
7780: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
7790: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
77a0: 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 {socket unixOrP
77b0: 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b c} {. set s [
77c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
77d0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
77e0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
77f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7800: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
7810: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
7820: 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 8829]. pro
7830: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
7840: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
7850: 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t x [fconfigure
7860: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 $s -sockname]..c
7870: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
7880: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
7890: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
78a0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
78b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
78c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
78d0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
78e0: 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 7.0.0.1 8829].
78f0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
7900: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
7910: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
7920: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
7930: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
7940: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
7950: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
7960: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
7970: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 end l [lindex $x
7980: 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 0] [lindex $x 2
7990: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
79a0: 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 {127.0.0.1 8829
79b0: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
79c0: 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 8.1 {testing -as
79d0: 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b ync flag on sock
79e0: 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ets} {socket} {.
79f0: 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 # NOTE: This
7a00: 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f test may fail o
7a10: 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 n some Solaris 2
7a20: 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 20 20 .4 systems..
7a30: 23 20 53 65 65 20 6e 6f 74 65 73 20 69 6e 20 54 # See notes in T
7a40: 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 73 74 cl's socket.test
7a50: 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 .. set s [tls
7a60: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
7a70: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
7a80: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
7a90: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7aa0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
7ab0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7ac0: 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 8830]. proc a
7ad0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7ae0: 09 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 .global x..# whe
7af0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
7b00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
7b10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
7b20: 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 ides need..# to
7b30: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
7b40: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
7b50: 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b shake. Also mak
7b60: 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 e sure..# to ret
7b70: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
7b80: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
7b90: 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 g mode...fconfig
7ba0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
7bb0: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
7bc0: 6e 65 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a ne..puts $s bye.
7bd0: 09 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 .# Only OpenSSL
7be0: 30 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 0.9.5a on Window
7bf0: 73 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 s seems to need
7c00: 74 68 65 20 61 66 74 65 72 20 28 64 65 6c 61 79 the after (delay
7c10: 65 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 ed)..# close, bu
7c20: 74 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 t it works just
7c30: 74 68 65 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c the same for all
7c40: 20 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a others. -hobbs.
7c50: 09 61 66 74 65 72 20 35 30 30 20 63 6c 6f 73 65 .after 500 close
7c60: 20 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a $s..set x done.
7c70: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
7c80: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7c90: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7ca0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7cb0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7cc0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7cd0: 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 6c 6f 63 .. -async loc
7ce0: 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 alhost 8830].
7cf0: 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e # when doing an
7d00: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
7d10: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
7d20: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
7d30: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
7d40: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
7d50: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 TLS handshake
7d60: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 Also make sure t
7d70: 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 o. # return t
7d80: 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 he channel to li
7d90: 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 ne buffering mod
7da0: 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 e (TLS sets it t
7db0: 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 o 'none').. f
7dc0: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
7dd0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7de0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 ring line. vw
7df0: 61 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 ait x. # TLS
7e00: 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 handshaking need
7e10: 73 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 s one byte from
7e20: 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 the client....
7e30: 20 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 puts $s1 a.
7e40: 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 # need update t
7e50: 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 o complete TLS h
7e60: 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 andshake in-proc
7e70: 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 ess. update.
7e80: 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 set z [gets $
7e90: 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 s1]. close $s
7ea0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
7eb0: 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a set z.} bye..
7ec0: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b test tlsIO-9.1 {
7ed0: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
7ee0: 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 events} {socket
7ef0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 } {. set len
7f00: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
7f10: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
7f20: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
7f30: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
7f40: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
7f50: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
7f60: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
7f70: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
7f80: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
7f90: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
7fa0: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
7fb0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
7fc0: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
7fd0: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
7fe0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
7ff0: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
8000: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
8010: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
8020: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
8030: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
8040: 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e king 0..fileeven
8050: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
8060: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
8070: 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 $s readable rea
8080: 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 dlittle \...-buf
8090: 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 fering none].
80a0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
80b0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
80c0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
80d0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
80e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
80f0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
8100: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
8110: 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 8831]. set c
8120: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8130: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8140: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8150: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8160: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
8170: 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 .. localhost
8180: 38 38 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 8831]. # This
8190: 20 64 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f differs from so
81a0: 63 6b 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 cket-9.1 in that
81b0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
81c0: 20 74 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e to be. # non
81d0: 2d 62 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 -blocking becaus
81e0: 65 20 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 e of TLS' requir
81f0: 65 64 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 ed handshake.
8200: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
8210: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 blocking 0. p
8220: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
8230: 63 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 c 01234567890123
8240: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
8250: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
8260: 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 6789. close $
8270: 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 c. set timer
8280: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
8290: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
82a0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
82b0: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
82c0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
82d0: 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 ose $s. list
82e0: 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d $spurious $len.}
82f0: 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c {0 50}..test tl
8300: 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 sIO-9.2 {testing
8310: 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 async write, fi
8320: 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 leevents, flush
8330: 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 on close} {socke
8340: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 t} {. set fir
8350: 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 stblock [string
8360: 72 65 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 repeat a 31].
8370: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
8380: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
8390: 62 20 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f b 65535]. pro
83a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
83b0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
83c0: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 s -blocking 0..f
83d0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
83e0: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
83f0: 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 ndshake $s reada
8400: 62 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 ble readable \..
8410: 09 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 .-translation lf
8420: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
8430: 38 34 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 84 -buffering li
8440: 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ne]. }. pr
8450: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
8460: 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 {..set l [gets $
8470: 73 5d 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c s]..dputs "got \
8480: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8490: 20 24 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e $l 10 end-3 ...
84a0: 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 ]\" \...([string
84b0: 20 6c 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f length $l]) fro
84c0: 6d 20 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 m $s"..fileevent
84d0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a $s readable {}.
84e0: 09 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 .after 1000 resp
84f0: 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ond $s. }.
8500: 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 proc respond {s
8510: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 } {..global firs
8520: 74 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 tblock..dputs "s
8530: 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 end \"[string re
8540: 70 6c 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 place $firstbloc
8550: 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c k 10 end-3 ...]\
8560: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
8570: 65 6e 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 ength $firstbloc
8580: 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 k]) down $s"..pu
8590: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
85a0: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 $firstblock..af
85b0: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
85c0: 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 ta $s. }.
85d0: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
85e0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 s} {..global sec
85f0: 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 ondblock..dputs
8600: 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 "send \"[string
8610: 72 65 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 replace $secondb
8620: 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e lock 10 end-3 ..
8630: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e .]\" \...([strin
8640: 67 20 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 g length $second
8650: 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 block]) down $s"
8660: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
8670: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
8680: 6b 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 k..close $s.
8690: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
86a0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
86b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
86c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
86d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
86e0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
86f0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8700: 38 38 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 8832]. set c
8710: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8720: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8730: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8740: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8750: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8760: 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 . localhost 8
8770: 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 832]. fconfig
8780: 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 ure $c -blocking
8790: 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 0 -trans lf -bu
87a0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
87b0: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
87c0: 20 70 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a 20 puts $c hello.
87d0: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
87e0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
87f0: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 74 nt done..set dat
8800: 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 75 a [read $s]..dpu
8810: 74 73 20 22 72 65 61 64 20 5c 22 5b 73 74 72 69 ts "read \"[stri
8820: 6e 67 20 72 65 70 6c 61 63 65 20 24 64 61 74 61 ng replace $data
8830: 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 10 end-3 ...]\"
8840: 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 \...([string le
8850: 6e 67 74 68 20 24 64 61 74 61 5d 29 20 66 72 6f ngth $data]) fro
8860: 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 6e m $s"..incr coun
8870: 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 t [string length
8880: 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 6f $data]..if {[eo
8890: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
88a0: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
88b0: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
88c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
88d0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
88e0: 74 20 24 63 22 0a 20 20 20 20 73 65 74 20 64 6f t $c". set do
88f0: 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d ne 0. set tim
8900: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
8910: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
8920: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
8930: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
8940: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
8950: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 close $s. li
8960: 73 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 0a st $count $done.
8970: 7d 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 73 } {65566 1}..tes
8980: 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 t tlsIO-9.3 {tes
8990: 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e ting EOF stickyn
89a0: 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 ess} {unexplaine
89b0: 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 7d dFailure socket}
89c0: 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 {. # HOBBS:
89d0: 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 never worked cor
89e0: 72 65 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 20 rectly. proc
89f0: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d count_to_eof {s}
8a00: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
8a10: 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 done timer..set
8a20: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
8a30: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
8a40: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 incr count..
8a50: 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 if {$count >
8a60: 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 9} {...close $s.
8a70: 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
8a80: 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 ..set count {eof
8a90: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
8aa0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
8ab0: 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 r.. }..}.
8ac0: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 }. proc timer
8ad0: 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 proc {} {..globa
8ae0: 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 l done count c..
8af0: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 set done true..s
8b00: 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 et count {timer
8b10: 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 went off, eof is
8b20: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
8b30: 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 ose $c. }.
8b40: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
8b50: 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a set done false.
8b60: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 proc write_t
8b70: 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a hen_close {s} {.
8b80: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c .puts $s bye..cl
8b90: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
8ba0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
8bb0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
8bc0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
8bd0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
8be0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
8bf0: 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 f..fileevent $s
8c00: 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 writable [list d
8c10: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 77 o_handshake $s w
8c20: 72 69 74 61 62 6c 65 20 77 72 69 74 65 5f 74 68 ritable write_th
8c30: 65 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 en_close \...-bu
8c40: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8c50: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 anslation lf].
8c60: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
8c70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8c80: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
8c90: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
8ca0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8cb0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
8cc0: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
8cd0: 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 t 8833]. set
8ce0: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
8cf0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8d00: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8d10: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8d20: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8d30: 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 \.. localhost
8d40: 20 38 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 8833]. fconf
8d50: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
8d60: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
8d70: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
8d80: 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 n lf. fileeve
8d90: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 nt $c readable "
8da0: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 count_to_eof $c"
8db0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
8dc0: 61 66 74 65 72 20 32 30 30 30 20 74 69 6d 65 72 after 2000 timer
8dd0: 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 proc]. vwait
8de0: 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 done. close $
8df0: 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a s. set count.
8e00: 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 } {eof is sticky
8e10: 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 }..removeFile sc
8e20: 72 69 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f ript..test tlsIO
8e30: 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 -10.1 {testing s
8e40: 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c ocket accept cal
8e50: 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 lback error hand
8e60: 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ling} {socket} {
8e70: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
8e80: 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 r 0. proc bge
8e90: 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 rror args {globa
8ea0: 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 l goterror; set
8eb0: 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 goterror 1}.
8ec0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
8ed0: 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 et -cafile $caCe
8ee0: 72 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 rt -server accep
8ef0: 74 20 38 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 t 8898]. proc
8f00: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8f10: 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 {close $s; error
8f20: 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 }. set c [tls
8f30: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
8f40: 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 $caCert 127.0.0
8f50: 2e 31 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 .1 8898]. vwa
8f60: 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 it goterror.
8f70: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
8f80: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f se $c. set go
8f90: 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 terror.} 1..test
8fa0: 20 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 tlsIO-11.1 {tcp
8fb0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
8fc0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8fd0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8fe0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
8ff0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
9000: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
9010: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_1_test_server
9020: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
9030: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
9040: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9050: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9060: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9070: 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 5d 0a serverKey 8834].
9080: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9090: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
90a0: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
90b0: 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a puts $s done.
90c0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
90d0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
90e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
90f0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9100: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9110: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9120: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9130: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9140: 76 65 72 49 50 20 38 38 33 34 5d 0a 20 20 20 20 verIP 8834].
9150: 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a set r [gets $s].
9160: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
9170: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9180: 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 ose $socket9_1_t
9190: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
91a0: 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 set r.} done..te
91b0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 st tlsIO-11.2 {c
91c0: 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 lient specifies
91d0: 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 its port} {socke
91e0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
91f0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
9200: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
9210: 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 s port]} {..incr
9220: 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 port. } else
9230: 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 {..set port [ex
9240: 70 72 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f pr {$tlsServerPo
9250: 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d rt + [pid]%1024}
9260: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 ]. }. send
9270: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
9280: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9290: 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 t socket9_2_test
92a0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
92b0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
92c0: 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ept \...-certfil
92d0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
92e0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
92f0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
9300: 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 y 8835]..proc ac
9310: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9320: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9330: 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 ke $s.. puts
9340: 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 $s $p.. close
9350: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
9360: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
9370: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9380: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9390: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
93a0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
93b0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 tKey \.. -myp
93c0: 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 ort $port $remot
93d0: 65 53 65 72 76 65 72 49 50 20 38 38 33 35 5d 0a eServerIP 8835].
93e0: 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 set r [gets
93f0: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
9400: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9410: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 {close $socket9
9420: 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _2_test_server}.
9430: 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 if {$r == $p
9440: 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 ort} {..set resu
9450: 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 lt ok. } else
9460: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 62 {..set result b
9470: 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 roken. }.
9480: 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a set result.} ok.
9490: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 33 .test tlsIO-11.3
94a0: 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e {trying to conn
94b0: 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 ect, no server}
94c0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
94d0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
94e0: 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 {. set statu
94f0: 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 s ok. if {![c
9500: 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 atch {set s [tls
9510: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9520: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9530: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9540: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9550: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9560: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 $remoteServerIp
9570: 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 8836]}]} {..if
9580: 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 {![catch {gets $
9590: 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 s}]} {.. set
95a0: 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d status broken..}
95b0: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
95c0: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a . set status.
95d0: 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f } ok..test tlsIO
95e0: 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 -11.4 {remote ec
95f0: 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 ho, one line} {s
9600: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9610: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9620: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
9630: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
9640: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9650: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
9660: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
9670: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9680: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9690: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
96a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
96b0: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
96c0: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
96d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
96e0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
96f0: 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s.. fileeve
9700: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
9710: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
9720: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
9730: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9740: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
9750: 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f lf..}..proc echo
9760: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
9770: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
9780: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
9790: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
97a0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 } else {...puts
97b0: 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d $s $l.. }..}
97c0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 . }. set f
97d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
97e0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
97f0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9800: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9810: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9820: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9830: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
9840: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 fconfigure $f -t
9850: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
9860: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9870: 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c puts $f hell
9880: 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 o. set r [get
9890: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
98a0: 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $f. sendComma
98b0: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
98c0: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
98d0: 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 68 r}. set r.} h
98e0: 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 4f ello..test tlsIO
98f0: 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 -11.5 {remote ec
9900: 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 ho, 50 lines} {s
9910: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9920: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9930: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
9940: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
9950: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9960: 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 t10_7_test_serve
9970: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
9980: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
9990: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
99a0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
99b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
99c0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
99d0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
99e0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
99f0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
9a00: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9a10: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
9a20: 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 echo $s].. f
9a30: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
9a40: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
9a50: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 anslation crlf..
9a60: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
9a70: 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 {.. set l [g
9a80: 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 ets $s].. if
9a90: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
9aa0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
9ab0: 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 lse {...puts $s
9ac0: 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $l.. }..}.
9ad0: 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c }. set f [tl
9ae0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9af0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9b00: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9b10: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9b20: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9b30: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9b40: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
9b50: 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 figure $f -trans
9b60: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
9b70: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9b80: 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 for {set cnt 0}
9b90: 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 {$cnt < 50} {inc
9ba0: 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 r cnt} {..puts $
9bb0: 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a f "hello, $cnt".
9bc0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
9bd0: 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 22 pare [gets $f] "
9be0: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d hello, $cnt"] !=
9bf0: 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0} {.. break
9c00: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ..}. }. cl
9c10: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 ose $f. sendC
9c20: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
9c30: 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 ocket10_7_test_s
9c40: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 63 erver}. set c
9c50: 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 6e nt.} 50..# Macin
9c60: 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 6e tosh sockets can
9c70: 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 have more than
9c80: 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 70 one server per p
9c90: 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 ort.if {$tcl_pla
9ca0: 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 tform(platform)
9cb0: 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 == "macintosh"}
9cc0: 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 {. set confli
9cd0: 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 33 36 ctResult {0 8836
9ce0: 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 }.} else {. s
9cf0: 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c et conflictResul
9d00: 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f t {1 {couldn't o
9d10: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 pen socket: addr
9d20: 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 ess already in u
9d30: 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 se}}.}..test tls
9d40: 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 IO-11.6 {socket
9d50: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
9d60: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
9d70: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
9d80: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
9d90: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9da0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
9db0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9dc0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
9dd0: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
9de0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
9df0: 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 ]. if {[catch
9e00: 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 {set s2 [tls::s
9e10: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9e20: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9e30: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9e40: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9e50: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
9e60: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
9e70: 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 6]} msg]} {..set
9e80: 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 result [list 1
9e90: 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 $msg]. } else
9ea0: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b {..set result [
9eb0: 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b list 0 [lindex [
9ec0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
9ed0: 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 sockname] 2]]..c
9ee0: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 lose $s2. }.
9ef0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
9f00: 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 set result.} $c
9f10: 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a 74 onflictResult..t
9f20: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 7b est tlsIO-11.7 {
9f30: 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 server with seve
9f40: 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f ral clients} {so
9f50: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
9f60: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
9f70: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
9f80: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
9f90: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
9fa0: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
9fb0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9fc0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
9fd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9fe0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9ff0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
a000: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
a010: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
a020: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
a030: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
a040: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
a050: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
a060: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
a070: 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f echo $s]..}..pro
a080: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
a090: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
a0a0: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
a0b0: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
a0c0: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
a0d0: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
a0e0: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
a0f0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
a100: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
a110: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
a120: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
a130: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
a140: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
a150: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
a160: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
a170: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
a180: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
a190: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a1a0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a1b0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
a1c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a1d0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
a1e0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
a1f0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
a200: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
a210: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
a220: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
a230: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
a240: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a250: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a260: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a270: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a280: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a290: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
a2a0: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
a2b0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
a2c0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
a2d0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
a2e0: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
a2f0: 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 31 0a 09 67 tlsIO-11.7,s1..g
a300: 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 ets $s1..puts $s
a310: 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2 hello,tlsIO-11
a320: 2e 37 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a .7,s2..gets $s2.
a330: 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c .puts $s3 hello,
a340: 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 33 0a 09 67 tlsIO-11.7,s3..g
a350: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
a360: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
a370: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
a380: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
a390: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
a3a0: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
a3b0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
a3c0: 69 0a 7d 20 31 30 30 0a 0a 74 65 73 74 20 74 6c i.} 100..test tl
a3d0: 73 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 sIO-11.8 {client
a3e0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 with several se
a3f0: 72 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 rvers} {socket d
a400: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
a410: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
a420: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
a430: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
a440: 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 tls::init -certf
a450: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
a460: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a470: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a480: 4b 65 79 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 Key..set s1 [tls
a490: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
a4a0: 20 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 "accept 4003" 4
a4b0: 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 003]..set s2 [tl
a4c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
a4d0: 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 r "accept 4004"
a4e0: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
a4f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
a500: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 er "accept 4005"
a510: 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 68 61 6e 4005]..proc han
a520: 64 73 68 61 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a dshake {s mp} {.
a530: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
a540: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
a550: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
a560: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 catch {tls::hand
a570: 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 shake $s} result
a580: 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 ]} {...# Some er
a590: 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e rors are normal.
a5a0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b .. } elseif {
a5b0: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a $result == 1} {.
a5c0: 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f ..# Handshake co
a5d0: 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 mplete...fileeve
a5e0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
a5f0: 22 0a 09 09 70 75 74 73 20 24 73 20 24 6d 70 0a "...puts $s $mp.
a600: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a610: 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 }..}..proc accep
a620: 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 t {mp s a p} {..
a630: 20 20 20 20 23 20 54 68 65 73 65 20 68 61 76 65 # These have
a640: 20 74 6f 20 61 63 63 65 70 74 20 6e 6f 6e 2d 62 to accept non-b
a650: 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 61 75 73 65 locking, because
a660: 20 74 68 65 20 68 61 6e 64 73 68 61 6b 69 6e 67 the handshaking
a670: 0a 09 20 20 20 20 23 20 6f 72 64 65 72 20 69 73 .. # order is
a680: 6e 27 74 20 64 65 74 65 72 6d 69 6e 69 73 74 69 n't deterministi
a690: 63 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 c.. fconfigur
a6a0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
a6b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a6c0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
a6d0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
a6e0: 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73 20 24 t handshake $s $
a6f0: 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 mp]..}. }.
a700: 20 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 tls::init -cert
a710: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a720: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a730: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a740: 74 4b 65 79 0a 20 20 20 20 73 65 74 20 73 31 20 tKey. set s1
a750: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a760: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a770: 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 3]. set s2 [t
a780: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
a790: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 5d teServerIP 4004]
a7a0: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
a7b0: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
a7c0: 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 ServerIP 4005].
a7d0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
a7e0: 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 lappend l [gets
a7f0: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 $s1] [gets $s1]
a800: 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 [eof $s1] [gets
a810: 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s2] [gets $s2]
a820: 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 [eof $s2] \..[ge
a830: 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 ts $s3] [gets $s
a840: 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 3] [eof $s3].
a850: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
a860: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
a870: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
a880: 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 ommand {..close
a890: 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 $s1..close $s2..
a8a0: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a close $s3. }.
a8b0: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 set l.} {400
a8c0: 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 3 {} 1 4004 {} 1
a8d0: 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 4005 {} 1}..tes
a8e0: 74 20 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 t tlsIO-11.9 {ac
a8f0: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
a900: 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ror} {socket doT
a910: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
a920: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
a930: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
a940: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a950: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
a960: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a970: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
a980: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
a990: 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 ccept 8836].
a9a0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
a9b0: 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 p} {expr 10 / 0
a9c0: 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 }. proc bgerr
a9d0: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
a9e0: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
a9f0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
aa00: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 69 66 ertValues. if
aa10: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
aa20: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
aa30: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
aa40: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
aa50: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
aa60: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
aa70: 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d socket \... -
aa80: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
aa90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
aaa0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
aab0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 20 20 20 lientKey \...
aac0: 20 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 [lindex $peerna
aad0: 6d 65 20 30 5d 20 38 38 33 36 5d 0a 09 20 20 20 me 0] 8836]..
aae0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 close $s. .
aaf0: 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 }} msg]} {..clos
ab00: 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 e $s..error $msg
ab10: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
ab20: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
ab30: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
ab40: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
ab50: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
ab60: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
ab70: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
ab80: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
ab90: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
aba0: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
abb0: 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 tlsIO-11.10 {te
abc0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
abd0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
abe0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
abf0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
ac00: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
ac10: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
ac20: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
ac30: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
ac40: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
ac50: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
ac60: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
ac70: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ac80: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
ac90: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
aca0: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
acb0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c cept {s a p} {cl
acc0: 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 ose $s}. }.
acd0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
ace0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
acf0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
ad00: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
ad10: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
ad20: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
ad30: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
ad40: 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6]. set p [fc
ad50: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 onfigure $s -pee
ad60: 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e rname]. set n
ad70: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
ad80: 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 -sockname]. s
ad90: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
ada0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 end l [lindex $p
adb0: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 2] [llength $p]
adc0: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 [llength $p].
add0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
ade0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
adf0: 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 e $socket10_12_t
ae00: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
ae10: 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 set l.} {8836 3
ae20: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 3}..test tlsIO-1
ae30: 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 1.11 {testing sp
ae40: 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b urious events} {
ae50: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
ae60: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
ae70: 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 {. # remote e
ae80: 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 quivalent of 9.1
ae90: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
aea0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
aeb0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
aec0: 74 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 t_test_server [t
aed0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
aee0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
aef0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
af00: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
af10: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
af20: 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 rverKey 8836]..p
af30: 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 roc handshake {s
af40: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f } {.. if {[eo
af50: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
af60: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 $s.. } elsei
af70: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
af80: 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 handshake $s} re
af90: 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d sult]} {...# Som
afa0: 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 e errors are nor
afb0: 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 mal... } else
afc0: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
afd0: 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b } {...# Handshak
afe0: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c e complete...fil
aff0: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
b000: 6c 65 20 22 22 0a 09 09 61 66 74 65 72 20 31 30 le ""...after 10
b010: 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 0 writesome $s..
b020: 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 }..}..proc a
b030: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
b040: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
b050: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
b060: 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 "auto lf".. f
b070: 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 ileevent $s writ
b080: 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 able [list hands
b090: 68 61 6b 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f hake $s]..}..pro
b0a0: 63 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 c writesome {s}
b0b0: 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 {.. for {set
b0c0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
b0d0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 {incr i} {...put
b0e0: 73 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 s $s "line $i fr
b0f0: 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 om remote server
b100: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c ".. }.. cl
b110: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
b120: 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 set len 0.
b130: 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 set spurious 0
b140: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
b150: 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 proc readlit
b160: 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 tle {s} {..globa
b170: 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 l spurious done
b180: 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 len..set l [read
b190: 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 $s 1]..if {[str
b1a0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d ing length $l] =
b1b0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b = 0} {.. if {
b1c0: 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 ![eof $s]} {...i
b1d0: 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 ncr spurious..
b1e0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f } else {...clo
b1f0: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
b200: 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 1.. }..} els
b210: 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 e {.. incr le
b220: 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 n [string length
b230: 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 $l]..}. }.
b240: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
b250: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
b260: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
b270: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
b280: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
b290: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
b2a0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
b2b0: 36 5d 0a 20 20 20 20 23 20 47 65 74 20 74 68 65 6]. # Get the
b2c0: 20 62 75 66 66 65 72 69 6e 67 20 63 6f 72 72 65 buffering corre
b2d0: 63 74 65 64 0a 20 20 20 20 66 63 6f 6e 66 69 67 cted. fconfig
b2e0: 75 72 65 20 24 63 20 2d 62 75 66 66 65 72 69 6e ure $c -bufferin
b2f0: 67 20 6c 69 6e 65 0a 20 20 20 20 23 20 50 75 74 g line. # Put
b300: 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 a byte into the
b310: 20 63 6c 69 65 6e 74 20 70 69 70 65 20 74 6f 20 client pipe to
b320: 74 72 69 67 67 65 72 20 54 4c 53 20 68 61 6e 64 trigger TLS hand
b330: 73 68 61 6b 69 6e 67 0a 20 20 20 20 70 75 74 73 shaking. puts
b340: 20 24 63 20 61 0a 20 20 20 20 66 69 6c 65 65 76 $c a. fileev
b350: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b360: 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 [list readlittle
b370: 20 24 63 5d 0a 20 20 20 20 73 65 74 20 74 69 6d $c]. set tim
b380: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
b390: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
b3a0: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
b3b0: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
b3c0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
b3d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
b3e0: 6f 73 65 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 ose $socket_test
b3f0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 _server}. lis
b400: 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e t $spurious $len
b410: 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 .} {0 2690}..tes
b420: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 t tlsIO-11.12 {t
b430: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
b440: 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 yness} {unexplai
b450: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
b460: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b470: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b480: 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 # remote equiva
b490: 6c 65 6e 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 lent of 9.3.
b4a0: 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 # HOBBS: never w
b4b0: 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a orked correctly.
b4c0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 set counter
b4d0: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0. set done 0
b4e0: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
b4f0: 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c up {s} {..global
b500: 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 counter done af
b510: 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 ter_id..set l [g
b520: 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f ets $s]..if {[eo
b530: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e f $s]} {.. in
b540: 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 cr counter..
b550: 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 if {$counter > 9
b560: 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b } {...set done {
b570: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 EOF is sticky}..
b580: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 .after cancel $a
b590: 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 fter_id...close
b5a0: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $s.. }..}.
b5b0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
b5c0: 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 d_out {} {..glob
b5d0: 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 al c done..set d
b5e0: 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 one {timed_out,
b5f0: 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b EOF is not stick
b600: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
b610: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
b620: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
b630: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
b640: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b650: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
b660: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
b670: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
b680: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b690: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
b6a0: 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 \...-server acce
b6b0: 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 8836]..proc a
b6c0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
b6d0: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
b6e0: 61 6b 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 ake $s.. afte
b6f0: 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 r 100 close $s..
b700: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
b710: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
b720: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
b730: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
b740: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b750: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
b760: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
b770: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
b780: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
b790: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 adable "count_up
b7a0: 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 $c". set aft
b7b0: 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 er_id [after 100
b7c0: 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 0 timed_out].
b7d0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
b7e0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
b7f0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f se $socket10_14_
b800: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
b810: 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 set done.} {EOF
b820: 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 is sticky}..tes
b830: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 t tlsIO-11.13 {t
b840: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
b850: 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c te, async flush,
b860: 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a async close} \.
b870: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
b880: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
b890: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 } {. proc rea
b8a0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
b8b0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
b8c0: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
b8d0: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
b8e0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
b8f0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
b900: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
b910: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
b920: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
b930: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
b940: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 Command {..set f
b950: 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e irstblock [strin
b960: 67 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a 09 g repeat a 31]..
b970: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
b980: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 [string repeat b
b990: 20 36 35 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 65535]..set l [
b9a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
b9b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
b9c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
b9d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
b9e0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
b9f0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 34 erver accept 884
ba00: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
ba10: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
ba20: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
ba30: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
ba40: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
ba50: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
ba60: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
ba70: 34 20 5c 0a 09 09 20 20 20 20 2d 62 75 66 66 65 4 \... -buffe
ba80: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
ba90: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
baa0: 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 able "readable $
bab0: 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 s"..}..proc read
bac0: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 able {s} {..
bad0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
bae0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
baf0: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 s readable {}..
bb00: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 65 after 1000 re
bb10: 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f spond $s..}..pro
bb20: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
bb30: 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 . global firs
bb40: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 tblock.. puts
bb50: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
bb60: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
bb70: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
bb80: 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 data $s..}..proc
bb90: 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b writedata {s} {
bba0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 .. global sec
bbb0: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 ondblock.. pu
bbc0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
bbd0: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 $secondblock..
bbe0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
bbf0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
bc00: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
bc10: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
bc20: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
bc30: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
bc40: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
bc50: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
bc60: 72 49 50 20 38 38 34 35 5d 0a 20 20 20 20 66 63 rIP 8845]. fc
bc70: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
bc80: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 cking 0 -transla
bc90: 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 tion lf -bufferi
bca0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
bcb0: 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 count 0. puts
bcc0: 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 $s hello. fi
bcd0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
bce0: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
bcf0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
bd00: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
bd10: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
bd20: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
bd30: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
bd40: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
bd50: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
bd60: 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 l}. set count
bd70: 0a 7d 20 36 35 35 36 36 0a 0a 70 72 6f 63 20 67 .} 65566..proc g
bd80: 65 74 64 61 74 61 20 7b 74 79 70 65 20 66 69 6c etdata {type fil
bd90: 65 7d 20 7b 0a 20 20 20 20 23 20 52 65 61 64 20 e} {. # Read
bda0: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 handler on the a
bdb0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
bdc0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
bdd0: 20 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 20 global failed.
bde0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 5b 63 set status [c
bdf0: 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 atch {read $file
be00: 7d 20 64 61 74 61 5d 0a 20 20 20 20 69 66 20 7b } data]. if {
be10: 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a $status != 0} {.
be20: 09 73 65 74 20 78 20 22 72 65 61 64 20 66 61 69 .set x "read fai
be30: 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 led, error was $
be40: 64 61 74 61 22 0a 09 63 61 74 63 68 20 7b 20 63 data"..catch { c
be50: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 lose $file }.
be60: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 } elseif {[stri
be70: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
be80: 61 74 61 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c ata]} {. } el
be90: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
bea0: 24 66 69 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 $file]} {. }
beb0: 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 elseif {[eof $fi
bec0: 6c 65 5d 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 le]} {..if {$fai
bed0: 6c 65 64 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 led} {.. set
bee0: 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 x "$type socket
bef0: 77 61 73 20 69 6e 68 65 72 69 74 65 64 22 0a 09 was inherited"..
bf00: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
bf10: 74 20 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 t x "$type socke
bf20: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
bf30: 74 65 64 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b ted"..}..catch {
bf40: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 close $file }.
bf50: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
bf60: 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 x {impossible c
bf70: 61 73 65 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c ase}..catch { cl
bf80: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 ose $file }.
bf90: 7d 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a }. return.}..
bfa0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 test tlsIO-12.1
bfb0: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
bfc0: 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 ance of server s
bfd0: 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 ockets} {socket
bfe0: 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 exec} {. make
bff0: 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a File {} script1.
c000: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 makeFile {}
c010: 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 script2.. # S
c020: 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 cript1 is just a
c030: 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 10 second delay
c040: 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 . If the server
c050: 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 socket. # is
c060: 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 inherited, it w
c070: 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e ill be held open
c080: 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a for 10 seconds.
c090: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
c0a0: 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 script1 w].
c0b0: 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 puts $f {..after
c0c0: 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 10000 exit..vwa
c0d0: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c0e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c0f0: 20 20 20 23 20 53 63 72 69 70 74 32 20 63 72 65 # Script2 cre
c100: 61 74 65 73 20 74 68 65 20 73 65 72 76 65 72 20 ates the server
c110: 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 socket, launches
c120: 20 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 script1,. #
c130: 77 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 waits a second,
c140: 61 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 and exits. The
c150: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 server socket wi
c160: 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 ll now. # be
c170: 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 closed unless sc
c180: 72 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 ript1 inherited
c190: 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b it... set f [
c1a0: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
c1b0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c1c0: 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 t set tclsh $::t
c1d0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
c1e0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
c1f0: 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 st set auto_path
c200: 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 $auto_path].
c210: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
c220: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
c230: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
c240: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
c250: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
c260: 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 ccept \.. -ce
c270: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
c280: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c290: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
c2a0: 76 65 72 4b 65 79 20 38 38 32 38 5c 5d 22 0a 20 verKey 8828\]".
c2b0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
c2c0: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
c2d0: 20 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 addr port } {..
c2e0: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
c2f0: 09 7d 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 .}..exec $tclsh
c300: 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 script1 &..close
c310: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
c320: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c330: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c340: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 ose $f.. # La
c350: 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 unch script2 and
c360: 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a wait 5 seconds.
c370: 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c . exec $::tcl
c380: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
c390: 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 74 65 ript2 &. afte
c3a0: 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f r 5000 { set ok_
c3b0: 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 to_proceed 1 }.
c3c0: 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 vwait ok_to_p
c3d0: 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 49 66 roceed.. # If
c3e0: 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f we can still co
c3f0: 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 nnect to the ser
c400: 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 ver, the socket
c410: 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a got inherited...
c420: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
c430: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
c440: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
c450: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c460: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
c470: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 lientKey \. .
c480: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 127.0.0.1 8828}
c490: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b msg]} {..set x {
c4a0: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
c4b0: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
c4c0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 . } else {..c
c4d0: 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 lose $msg..set x
c4e0: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c4f0: 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 was inherited}.
c500: 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a }.. set x.
c510: 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 } {server socket
c520: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c530: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
c540: 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.2 {testing in
c550: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 heritance of cli
c560: 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f ent sockets} {so
c570: 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 cket exec} {.
c580: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
c590: 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c ipt1. makeFil
c5a0: 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 e {} script2..
c5b0: 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a # Script1 is j
c5c0: 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 ust a 10 second
c5d0: 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 delay. If the s
c5e0: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 erver socket.
c5f0: 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c # is inherited,
c600: 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 it will be held
c610: 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 open for 10 sec
c620: 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 onds.. set f
c630: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
c640: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c650: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
c660: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c670: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c680: 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 $f.. # Script
c690: 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 2 opens the clie
c6a0: 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 nt socket and wr
c6b0: 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 ites to it. It
c6c0: 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 then. # launc
c6d0: 68 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 hes script1 and
c6e0: 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 exits. If the c
c6f0: 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 hild process inh
c700: 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 erited the. #
c710: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 client socket,
c720: 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 the socket will
c730: 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a still be open...
c740: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c750: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c760: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c770: 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 tclsh $::tcltes
c780: 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 t::tcltest].
c790: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
c7a0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
c7b0: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
c7c0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
c7d0: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
c7e0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
c7f0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
c800: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
c810: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
c820: 24 63 61 43 65 72 74 20 5c 0a 09 20 20 20 20 2d $caCert \.. -
c830: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
c840: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 ey 127.0.0.1 882
c850: 39 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 9\]". puts $f
c860: 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 {..exec $tclsh
c870: 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 script1 &..puts
c880: 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 $f testing..flus
c890: 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 h $f..after 1000
c8a0: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
c8b0: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
c8c0: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 lose $f.. # C
c8d0: 72 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 reate the server
c8e0: 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 socket.. set
c8f0: 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f server [tls::so
c900: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
c910: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
c920: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c930: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
c940: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
c950: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 39 rver accept 8829
c960: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
c970: 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f t { file host po
c980: 72 74 20 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 rt } {..# When t
c990: 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 he client connec
c9a0: 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 ts, establish th
c9b0: 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 e read handler..
c9c0: 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 global server..c
c9d0: 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 63 lose $server..fc
c9e0: 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d onfigure $file -
c9f0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 blocking 0..file
ca00: 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 event $file read
ca10: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
ca20: 6e 64 73 68 61 6b 65 20 24 66 69 6c 65 20 72 65 ndshake $file re
ca30: 61 64 61 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 adable \...[list
ca40: 20 67 65 74 64 61 74 61 20 63 6c 69 65 6e 74 5d getdata client]
ca50: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
ca60: 5d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a ]..return. }.
ca70: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
ca80: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
ca90: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
caa0: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
cab0: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
cac0: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
cad0: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
cae0: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
caf0: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
cb00: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
cb10: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
cb20: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
cb30: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
cb40: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
cb50: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
cb60: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
cb70: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
cb80: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
cb90: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ed. }. set
cba0: 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 x.} {client soc
cbb0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
cbc0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
cbd0: 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 IO-12.3 {testing
cbe0: 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 inheritance of
cbf0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 accepted sockets
cc00: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 } \..{socket exe
cc10: 63 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 c unixOnly} {.
cc20: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
cc30: 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 ript1. makeFi
cc40: 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 le {} script2..
cc50: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
cc60: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
cc70: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
cc80: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
cc90: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
cca0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
ccb0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
ccc0: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
ccd0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
cce0: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
ccf0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
cd00: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
cd10: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
cd20: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
cd30: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
cd40: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
cd50: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
cd60: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
cd70: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
cd80: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
cd90: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
cda0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
cdb0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
cdc0: 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 930\]". puts
cdd0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
cde0: 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f t { file host po
cdf0: 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 rt } {.. glob
ce00: 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 66 63 al tclsh.. fc
ce10: 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d onfigure $file -
ce20: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
ce30: 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b puts $file {
ce40: 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 test data on soc
ce50: 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 ket}.. exec $
ce60: 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a tclsh script1 &.
ce70: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
ce80: 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 exit..}..vwait f
ce90: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
cea0: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
ceb0: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
cec0: 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 pt2 process and
ced0: 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 connect to it.
cee0: 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 See how long.
cef0: 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 # the socket st
cf00: 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 ays open.. ex
cf10: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
cf20: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
cf30: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
cf40: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
cf50: 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f ed 1. vwait o
cf60: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 k_to_proceed..
cf70: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
cf80: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
cf90: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
cfa0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
cfb0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
cfc0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
cfd0: 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 .0.0.1 8930].
cfe0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
cff0: 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d buffering full -
d000: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 blocking 0. #
d010: 20 57 65 20 6e 65 65 64 20 74 6f 20 70 75 74 20 We need to put
d020: 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 a byte into the
d030: 72 65 61 64 20 71 75 65 75 65 2c 20 6f 74 68 65 read queue, othe
d040: 72 77 69 73 65 20 74 68 65 0a 20 20 20 20 23 20 rwise the. #
d050: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 64 6f TLS handshake do
d060: 65 73 6e 27 74 20 66 69 6e 69 73 68 0a 20 20 20 esn't finish.
d070: 20 70 75 74 73 20 24 66 20 61 3b 20 66 6c 75 73 puts $f a; flus
d080: 68 20 24 66 0a 20 20 20 20 66 69 6c 65 65 76 65 h $f. fileeve
d090: 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b nt $f readable [
d0a0: 6c 69 73 74 20 67 65 74 64 61 74 61 20 61 63 63 list getdata acc
d0b0: 65 70 74 65 64 20 24 66 5d 0a 0a 20 20 20 20 23 epted $f].. #
d0c0: 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 If the socket i
d0d0: 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 s still open aft
d0e0: 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 er 5 seconds, th
d0f0: 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 e script1 proces
d100: 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 s. # must hav
d110: 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 e inherited the
d120: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e accepted socket.
d130: 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 .. set failed
d140: 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0. after 500
d150: 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 0 set failed 1..
d160: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
d170: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
d180: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
d190: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
d1a0: 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 t tlsIO-13.1 {Te
d1b0: 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 sting use of sha
d1c0: 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 red socket betwe
d1d0: 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 en two threads}
d1e0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 \..{socket testt
d1f0: 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 hread} {. # H
d200: 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 65 73 74 OBBS: never test
d210: 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ed. removeFil
d220: 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 e script. thr
d230: 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b eadReap.. mak
d240: 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 eFile {. .pac
d250: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
d260: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
d270: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
d280: 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 ept 8828]..proc
d290: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
d2a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
d2b0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
d2c0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
d2d0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
d2e0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
d2f0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
d300: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
d310: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
d320: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
d330: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
d340: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
d350: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
d360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d370: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
d380: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
d390: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d3a0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
d3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
d3c0: 6c 73 65 20 7b 0a 09 20 20 20 20 20 20 20 20 20 lse {..
d3d0: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
d3e0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
d3f0: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
d400: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 }..}..set i 0..v
d410: 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 wait x..close $f
d420: 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 ...# thread clea
d430: 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 ns itself up...t
d440: 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 estthread exit.
d450: 20 20 20 7d 20 73 63 72 69 70 74 0a 0a 20 20 20 } script..
d460: 20 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 # create a thre
d470: 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 ad. set serve
d480: 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 rthread [testthr
d490: 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 ead create { sou
d4a0: 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 rce script } ].
d4b0: 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 update.. a
d4c0: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 fter 1000. se
d4d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
d4e0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
d4f0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
d500: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d510: 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a ne.. catch {.
d520: 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 .puts $s "hello"
d530: 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 ..gets $s result
d540: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
d550: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a $s. update..
d560: 20 20 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 after 2000.
d570: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
d580: 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 0a t [threadReap]..
d590: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a set result..
d5a0: 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 74 65 73 } {hello 1}..tes
d5b0: 74 20 74 6c 73 49 4f 2d 31 34 2e 31 20 7b 74 65 t tlsIO-14.1 {te
d5c0: 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 st tls::unimport
d5d0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
d5e0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
d5f0: 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 6d 73 67 s::unimport} msg
d600: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
d610: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
d620: 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 d be "tls::unimp
d630: 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 ort channel"}}.t
d640: 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 32 20 7b est tlsIO-14.2 {
d650: 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f test tls::unimpo
d660: 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 rt} {socket} {.
d670: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
d680: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 66 6f tls::unimport fo
d690: 6f 20 62 61 72 7d 20 6d 73 67 5d 20 24 6d 73 67 o bar} msg] $msg
d6a0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
d6b0: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
d6c0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 tls::unimport ch
d6d0: 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c annel"}}.test tl
d6e0: 73 49 4f 2d 31 34 2e 33 20 7b 74 65 73 74 20 74 sIO-14.3 {test t
d6f0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 ls::unimport} {s
d700: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
d710: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 t [catch {tls::u
d720: 6e 69 6d 70 6f 72 74 20 62 6f 67 75 73 7d 20 6d nimport bogus} m
d730: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 63 sg] $msg.} {1 {c
d740: 61 6e 20 6e 6f 74 20 66 69 6e 64 20 63 68 61 6e an not find chan
d750: 6e 65 6c 20 6e 61 6d 65 64 20 22 62 6f 67 75 73 nel named "bogus
d760: 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 "}}.test tlsIO-1
d770: 34 2e 34 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 4.4 {test tls::u
d780: 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 nimport} {socket
d790: 7d 20 7b 0a 20 20 20 20 23 20 73 74 64 69 6e 20 } {. # stdin
d7a0: 63 61 6e 20 74 61 6b 65 20 64 69 66 66 65 72 65 can take differe
d7b0: 6e 74 20 6e 61 6d 65 73 20 61 73 20 74 68 65 20 nt names as the
d7c0: 22 74 6f 70 22 20 63 68 61 6e 6e 65 6c 0a 20 20 "top" channel.
d7d0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
d7e0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 73 74 64 ls::unimport std
d7f0: 69 6e 7d 20 6d 73 67 5d 20 5c 0a 09 5b 73 74 72 in} msg] \..[str
d800: 69 6e 67 20 6d 61 74 63 68 20 7b 62 61 64 20 63 ing match {bad c
d810: 68 61 6e 6e 65 6c 20 22 2a 22 3a 20 6e 6f 74 20 hannel "*": not
d820: 61 20 54 4c 53 20 63 68 61 6e 6e 65 6c 7d 20 24 a TLS channel} $
d830: 6d 73 67 5d 0a 7d 20 7b 31 20 31 7d 0a 74 65 73 msg].} {1 1}.tes
d840: 74 20 74 6c 73 49 4f 2d 31 34 2e 35 20 7b 74 65 t tlsIO-14.5 {te
d850: 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 st tls::unimport
d860: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
d870: 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 set len 0. s
d880: 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 et spurious 0.
d890: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
d8a0: 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 proc readlittle
d8b0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
d8c0: 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e purious done len
d8d0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
d8e0: 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 1]..if {[string
d8f0: 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 length $l] == 0
d900: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 } {.. if {![e
d910: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 of $s]} {...incr
d920: 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d spurious.. }
d930: 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 else {...close
d940: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a $s...set done 1.
d950: 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b . }..} else {
d960: 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b .. incr len [
d970: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
d980: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ]..}. }. p
d990: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
d9a0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
d9b0: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a $s -blocking 0.
d9c0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
d9d0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f adable [list do_
d9e0: 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 handshake $s rea
d9f0: 64 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 dable readlittle
da00: 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 \...-buffering
da10: 6e 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 none]. }.
da20: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
da30: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
da40: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
da50: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
da60: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
da70: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
da80: 65 72 20 61 63 63 65 70 74 20 38 38 33 31 5d 0a er accept 8831].
da90: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
daa0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
dab0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
dac0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
dad0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
dae0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c ientKey \.. l
daf0: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 ocalhost 8831].
db00: 20 20 20 23 20 6f 6e 6c 79 20 74 68 65 20 63 6c # only the cl
db10: 69 65 6e 74 20 67 65 74 73 20 74 6c 73 3a 3a 69 ient gets tls::i
db20: 6d 70 6f 72 74 0a 20 20 20 20 73 65 74 20 72 65 mport. set re
db30: 73 20 5b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 s [tls::unimport
db40: 20 24 63 5d 0a 20 20 20 20 6c 69 73 74 20 24 72 $c]. list $r
db50: 65 73 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 es [catch {close
db60: 20 24 63 7d 20 65 72 72 5d 20 24 65 72 72 20 5c $c} err] $err \
db70: 0a 09 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 ..[catch {close
db80: 24 73 7d 20 65 72 72 5d 20 24 65 72 72 0a 7d 20 $s} err] $err.}
db90: 7b 7b 7d 20 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a {{} 0 {} 0 {}}..
dba0: 74 65 73 74 20 74 6c 73 2d 62 75 67 35 38 2d 31 test tls-bug58-1
dbb0: 2e 30 20 7b 74 65 73 74 20 70 72 6f 74 6f 63 6f .0 {test protoco
dbc0: 6c 20 6e 65 67 6f 74 69 61 74 69 6f 6e 20 66 61 l negotiation fa
dbd0: 69 6c 75 72 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 ilure} {socket}
dbe0: 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f 77 69 6e {. # Followin
dbf0: 67 20 63 6f 64 65 20 69 73 20 62 61 73 65 64 20 g code is based
dc00: 6f 6e 20 77 68 61 74 20 77 61 73 20 72 65 70 6f on what was repo
dc10: 72 74 65 64 20 69 6e 20 62 75 67 20 23 35 38 2e rted in bug #58.
dc20: 20 50 72 69 6f 72 0a 20 20 20 20 23 20 74 6f 20 Prior. # to
dc30: 66 69 78 20 74 68 65 20 70 72 6f 67 72 61 6d 20 fix the program
dc40: 77 6f 75 6c 64 20 63 72 61 73 68 20 77 69 74 68 would crash with
dc50: 20 61 20 73 65 67 66 61 75 6c 74 2e 0a 20 20 20 a segfault..
dc60: 20 70 72 6f 63 20 41 63 63 65 70 74 20 7b 73 6f proc Accept {so
dc70: 63 6b 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 20 ck args} {.
dc80: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
dc90: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 3b ock -blocking 0;
dca0: 0a 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 . fileeve
dcb0: 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 62 6c nt $sock readabl
dcc0: 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 68 61 6b e [list Handshak
dcd0: 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 7d 0a 20 e $sock]. }.
dce0: 20 20 20 70 72 6f 63 20 48 61 6e 64 73 68 61 6b proc Handshak
dcf0: 65 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 20 e {sock} {.
dd00: 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 48 41 set ::done HA
dd10: 4e 44 0a 20 20 20 20 20 20 20 20 63 61 74 63 68 ND. catch
dd20: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
dd30: 20 24 73 6f 63 6b 7d 20 6d 73 67 0a 20 20 20 20 $sock} msg.
dd40: 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 24 set ::done $
dd50: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 msg. }. #
dd60: 4e 4f 54 45 3a 20 77 68 65 6e 20 64 6f 69 6e 67 NOTE: when doing
dd70: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
dd80: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
dd90: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
dda0: 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e ed. # to be n
ddb0: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
ddc0: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
ddd0: 65 0a 0a 20 20 20 20 23 20 53 65 72 76 65 72 20 e.. # Server
dde0: 2d 20 4f 6e 6c 79 20 61 63 63 65 70 74 20 54 4c - Only accept TL
ddf0: 53 20 31 2e 32 0a 20 20 20 20 73 65 74 20 73 20 S 1.2. set s
de00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 20 [tls::socket \.
de10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 63 -c
de20: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
de30: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
de40: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
de50: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 20 20 rverKey \.
de60: 20 20 20 20 20 20 20 20 20 2d 72 65 71 75 65 73 -reques
de70: 74 20 30 20 2d 72 65 71 75 69 72 65 20 30 20 2d t 0 -require 0 -
de80: 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 20 2d ssl2 0 -ssl3 0 -
de90: 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 31 20 30 tls1 0 -tls1.1 0
dea0: 20 2d 74 6c 73 31 2e 32 20 31 20 5c 0a 20 20 20 -tls1.2 1 \.
deb0: 20 20 20 20 20 20 20 20 20 20 20 20 2d 73 65 72 -ser
dec0: 76 65 72 20 41 63 63 65 70 74 20 38 38 33 31 5d ver Accept 8831]
ded0: 0a 20 20 20 20 23 20 43 6c 69 65 6e 74 20 2d 20 . # Client -
dee0: 4f 6e 6c 79 20 70 72 6f 70 6f 73 65 20 54 4c 53 Only propose TLS
def0: 31 2e 30 0a 20 20 20 20 73 65 74 20 63 20 5b 74 1.0. set c [t
df00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 61 73 79 6e ls::socket -asyn
df10: 63 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 c \.
df20: 20 20 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 -cafile $caCe
df30: 72 74 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 rt \.
df40: 20 20 20 20 2d 72 65 71 75 65 73 74 20 30 20 2d -request 0 -
df50: 72 65 71 75 69 72 65 20 30 20 2d 73 73 6c 32 20 require 0 -ssl2
df60: 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 31 20 0 -ssl3 0 -tls1
df70: 31 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 6c 73 1 -tls1.1 0 -tls
df80: 31 2e 32 20 30 20 5c 0a 20 20 20 20 20 20 20 20 1.2 0 \.
df90: 20 20 20 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 localhost
dfa0: 20 38 38 33 31 5d 0a 20 20 20 20 66 63 6f 6e 66 8831]. fconf
dfb0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
dfc0: 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 ng 0. puts $c
dfd0: 20 61 20 3b 20 66 6c 75 73 68 20 24 63 0a 20 20 a ; flush $c.
dfe0: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
dff0: 73 74 20 73 65 74 20 3a 3a 64 6f 6e 65 20 74 69 st set ::done ti
e000: 6d 65 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 meout]. vwait
e010: 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 73 77 69 74 ::done. swit
e020: 63 68 20 2d 65 78 61 63 74 20 2d 2d 20 24 3a 3a ch -exact -- $::
e030: 64 6f 6e 65 20 7b 0a 20 20 20 20 20 20 20 20 22 done {. "
e040: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
e050: 3a 20 77 72 6f 6e 67 20 73 73 6c 20 76 65 72 73 : wrong ssl vers
e060: 69 6f 6e 22 20 2d 0a 20 20 20 20 20 20 20 20 22 ion" -. "
e070: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
e080: 3a 20 75 6e 73 75 70 70 6f 72 74 65 64 20 70 72 : unsupported pr
e090: 6f 74 6f 63 6f 6c 22 20 7b 0a 20 20 20 20 20 20 otocol" {.
e0a0: 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 set ::done
e0b0: 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c "handshake fail
e0c0: 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f ed: wrong versio
e0d0: 6e 20 6e 75 6d 62 65 72 22 0a 20 20 20 20 20 20 n number".
e0e0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
e0f0: 74 20 3a 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e 64 t ::done.} {hand
e100: 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 shake failed: wr
e110: 6f 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 ong version numb
e120: 65 72 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 er}..# cleanup.i
e130: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
e140: 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 sock* $commandS
e150: 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 ocket] == 1} {.
e160: 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 puts $commandS
e170: 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c ocket exit. fl
e180: 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ush $commandSock
e190: 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 et.}.catch {clos
e1a0: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
e1b0: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
e1c0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a remoteProcChan}.
e1d0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e ::tcltest::clean
e1e0: 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 upTests.flush st
e1f0: 64 6f 75 74 0a 72 65 74 75 72 6e 0a dout.return.