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 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
7e90: 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 1 -blocking 1.
7ea0: 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 set z [gets $s
7eb0: 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 1]. close $s.
7ec0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
7ed0: 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 set z.} bye..t
7ee0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b 74 est tlsIO-9.1 {t
7ef0: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
7f00: 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 7d events} {socket}
7f10: 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 {. set len 0
7f20: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
7f30: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
7f40: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
7f50: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
7f60: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
7f70: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
7f80: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
7f90: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
7fa0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
7fb0: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
7fc0: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
7fd0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
7fe0: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
7ff0: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
8000: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
8010: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
8020: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
8030: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
8040: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
8050: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
8060: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
8070: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
8080: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
8090: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
80a0: 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 little \...-buff
80b0: 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 ering none].
80c0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
80d0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
80e0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
80f0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
8100: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8110: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
8120: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8130: 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 8831]. set c
8140: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8150: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8160: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8170: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8180: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8190: 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 . localhost 8
81a0: 38 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 20 831]. # This
81b0: 64 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 differs from soc
81c0: 6b 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 ket-9.1 in that
81d0: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 20 both sides need
81e0: 74 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d to be. # non-
81f0: 62 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 65 blocking because
8200: 20 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 65 of TLS' require
8210: 64 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 d handshake.
8220: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 fconfigure $c -b
8230: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 locking 0. pu
8240: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 ts -nonewline $c
8250: 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 012345678901234
8260: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
8270: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
8280: 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 789. close $c
8290: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
82a0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
82b0: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
82c0: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
82d0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
82e0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
82f0: 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 se $s. list $
8300: 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 spurious $len.}
8310: 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 {0 50}..test tls
8320: 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 IO-9.2 {testing
8330: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c async write, fil
8340: 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f eevents, flush o
8350: 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 n close} {socket
8360: 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 } {. set firs
8370: 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 tblock [string r
8380: 65 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 20 epeat a 31].
8390: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
83a0: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 [string repeat b
83b0: 20 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f 63 65535]. proc
83c0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
83d0: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
83e0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 -blocking 0..fi
83f0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
8400: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
8410: 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 dshake $s readab
8420: 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 le readable \...
8430: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
8440: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
8450: 34 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 4 -buffering lin
8460: 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f e]. }. pro
8470: 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b c readable {s} {
8480: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
8490: 5d 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c 22 ]..dputs "got \"
84a0: 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 [string replace
84b0: 24 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d $l 10 end-3 ...]
84c0: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
84d0: 6c 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f 6d length $l]) from
84e0: 20 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 20 $s"..fileevent
84f0: 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 $s readable {}..
8500: 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f after 1000 respo
8510: 6e 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 nd $s. }.
8520: 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d proc respond {s}
8530: 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 {..global first
8540: 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 block..dputs "se
8550: 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 nd \"[string rep
8560: 6c 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 6b lace $firstblock
8570: 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 10 end-3 ...]\"
8580: 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 \...([string le
8590: 6e 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 6b ngth $firstblock
85a0: 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 ]) down $s"..put
85b0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
85c0: 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 $firstblock..aft
85d0: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
85e0: 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 a $s. }. p
85f0: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
8600: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f } {..global seco
8610: 6e 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 ndblock..dputs "
8620: 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 send \"[string r
8630: 65 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 6c eplace $secondbl
8640: 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e ock 10 end-3 ...
8650: 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 ]\" \...([string
8660: 20 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 length $secondb
8670: 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a lock]) down $s".
8680: 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 .puts -nonewline
8690: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
86a0: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
86b0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
86c0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
86d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
86e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
86f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8700: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8710: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
8720: 38 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 832]. set c [
8730: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8740: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8750: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8760: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8770: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8780: 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 localhost 88
8790: 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 32]. fconfigu
87a0: 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $c -blocking
87b0: 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 0 -trans lf -buf
87c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
87d0: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
87e0: 70 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 puts $c hello.
87f0: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
8800: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
8810: 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 t done..set data
8820: 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 75 74 [read $s]..dput
8830: 73 20 22 72 65 61 64 20 5c 22 5b 73 74 72 69 6e s "read \"[strin
8840: 67 20 72 65 70 6c 61 63 65 20 24 64 61 74 61 20 g replace $data
8850: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8860: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8870: 67 74 68 20 24 64 61 74 61 5d 29 20 66 72 6f 6d gth $data]) from
8880: 20 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 $s"..incr count
8890: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
88a0: 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 $data]..if {[eof
88b0: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f $s]} {.. clo
88c0: 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 se $s.. set d
88d0: 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 one 1..}. }.
88e0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 fileevent $c
88f0: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
8900: 20 24 63 22 0a 20 20 20 20 73 65 74 20 64 6f 6e $c". set don
8910: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
8920: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
8930: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
8940: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
8950: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
8960: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
8970: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 close $s. lis
8980: 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d t $count $done.}
8990: 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 {65566 1}..test
89a0: 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 tlsIO-9.3 {test
89b0: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
89c0: 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ss} {unexplained
89d0: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 Failure socket}
89e0: 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e {. # HOBBS: n
89f0: 65 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 ever worked corr
8a00: 65 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 ectly. proc c
8a10: 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 ount_to_eof {s}
8a20: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
8a30: 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 done timer..set
8a40: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
8a50: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
8a60: 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 incr count..
8a70: 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 if {$count > 9
8a80: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
8a90: 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 .set done true..
8aa0: 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 .set count {eof
8ab0: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
8ac0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
8ad0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
8ae0: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 . proc timerp
8af0: 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c roc {} {..global
8b00: 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 done count c..s
8b10: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 et done true..se
8b20: 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 t count {timer w
8b30: 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 ent off, eof is
8b40: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f not sticky}..clo
8b50: 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 se $c. }.
8b60: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
8b70: 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 set done false.
8b80: 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 proc write_th
8b90: 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 en_close {s} {..
8ba0: 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f puts $s bye..clo
8bb0: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
8bc0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8bd0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
8be0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
8bf0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8c00: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
8c10: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 ..fileevent $s w
8c20: 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f ritable [list do
8c30: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 77 72 _handshake $s wr
8c40: 69 74 61 62 6c 65 20 77 72 69 74 65 5f 74 68 65 itable write_the
8c50: 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 66 n_close \...-buf
8c60: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
8c70: 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 nslation lf].
8c80: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
8c90: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
8ca0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
8cb0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8cc0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8cd0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
8ce0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
8cf0: 20 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 8833]. set c
8d00: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8d10: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8d20: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8d30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8d40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
8d50: 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 .. localhost
8d60: 38 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8833]. fconfi
8d70: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
8d80: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
8d90: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8da0: 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e lf. fileeven
8db0: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 t $c readable "c
8dc0: 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a ount_to_eof $c".
8dd0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
8de0: 66 74 65 72 20 32 30 30 30 20 74 69 6d 65 72 70 fter 2000 timerp
8df0: 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 roc]. vwait d
8e00: 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 one. close $s
8e10: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
8e20: 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d {eof is sticky}
8e30: 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 ..removeFile scr
8e40: 69 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ipt..test tlsIO-
8e50: 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 10.1 {testing so
8e60: 63 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c cket accept call
8e70: 62 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c back error handl
8e80: 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ing} {socket} {.
8e90: 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 set goterror
8ea0: 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 0. proc bger
8eb0: 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 6c ror args {global
8ec0: 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 67 goterror; set g
8ed0: 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 73 oterror 1}. s
8ee0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
8ef0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8f00: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
8f10: 20 38 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 8898]. proc
8f20: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8f30: 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d close $s; error}
8f40: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8f50: 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 :socket -cafile
8f60: 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e $caCert 127.0.0.
8f70: 31 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 8898]. vwai
8f80: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
8f90: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
8fa0: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
8fb0: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
8fc0: 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 tlsIO-11.1 {tcp
8fd0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
8fe0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8ff0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9000: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
9010: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9020: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 d {..set socket9
9030: 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _1_test_server [
9040: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
9050: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d ver accept \...-
9060: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9070: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9080: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9090: 65 72 76 65 72 4b 65 79 20 38 38 33 34 5d 0a 09 erverKey 8834]..
90a0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
90b0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
90c0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
90d0: 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 puts $s done..
90e0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
90f0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
9100: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9110: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9120: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9130: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9140: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9150: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
9160: 65 72 49 50 20 38 38 33 34 5d 0a 20 20 20 20 73 erIP 8834]. s
9170: 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 et r [gets $s].
9180: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
9190: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
91a0: 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 se $socket9_1_te
91b0: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
91c0: 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 et r.} done..tes
91d0: 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 6c t tlsIO-11.2 {cl
91e0: 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 ient specifies i
91f0: 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 ts port} {socket
9200: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9210: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9220: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
9230: 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 port]} {..incr
9240: 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 port. } else
9250: 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 {..set port [exp
9260: 72 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 r {$tlsServerPor
9270: 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d t + [pid]%1024}]
9280: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
9290: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
92a0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
92b0: 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f socket9_2_test_
92c0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
92d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
92e0: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
92f0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9300: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9310: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9320: 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 8835]..proc acc
9330: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9340: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9350: 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 e $s.. puts $
9360: 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 s $p.. close
9370: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
9380: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9390: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
93a0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
93b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
93c0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
93d0: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f Key \.. -mypo
93e0: 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 rt $port $remote
93f0: 53 65 72 76 65 72 49 50 20 38 38 33 35 5d 0a 20 ServerIP 8835].
9400: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
9410: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
9420: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9430: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f {close $socket9_
9440: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 2_test_server}.
9450: 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f if {$r == $po
9460: 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c rt} {..set resul
9470: 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 t ok. } else
9480: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 {..set result br
9490: 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 oken. }. s
94a0: 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 0a et result.} ok..
94b0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 33 20 test tlsIO-11.3
94c0: 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 {trying to conne
94d0: 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b ct, no server} {
94e0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
94f0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9500: 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 {. set status
9510: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 ok. if {![ca
9520: 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a tch {set s [tls:
9530: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9540: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9550: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9560: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9570: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9580: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 $remoteServerIp
9590: 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 8836]}]} {..if {
95a0: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
95b0: 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 }]} {.. set s
95c0: 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a tatus broken..}.
95d0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
95e0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
95f0: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
9600: 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 11.4 {remote ech
9610: 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f o, one line} {so
9620: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
9630: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
9640: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
9650: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
9660: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
9670: 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 10_6_test_server
9680: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9690: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
96a0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
96b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
96c0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
96d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
96e0: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
96f0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9700: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9710: 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e $s.. fileeven
9720: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9730: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
9740: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9750: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
9760: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
9770: 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 f..}..proc echo
9780: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
9790: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
97a0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
97b0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
97c0: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
97d0: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
97e0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 }. set f
97f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9800: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9810: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9820: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9830: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9840: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
9850: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
9860: 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 configure $f -tr
9870: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d anslation crlf -
9880: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9890: 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f puts $f hello
98a0: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
98b0: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
98c0: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
98d0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
98e0: 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 10_6_test_server
98f0: 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 }. set r.} he
9900: 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d llo..test tlsIO-
9910: 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 11.5 {remote ech
9920: 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f o, 50 lines} {so
9930: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
9940: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
9950: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
9960: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
9970: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
9980: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
9990: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
99a0: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
99b0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
99c0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
99d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
99e0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d $serverKey 8836]
99f0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
9a00: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
9a10: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
9a20: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
9a30: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
9a40: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
9a50: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
9a60: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
9a70: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
9a80: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
9a90: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
9aa0: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
9ab0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
9ac0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
9ad0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
9ae0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
9af0: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
9b00: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9b10: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9b20: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9b30: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9b40: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9b50: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9b60: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
9b70: 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c igure $f -transl
9b80: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
9b90: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
9ba0: 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b or {set cnt 0} {
9bb0: 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 $cnt < 50} {incr
9bc0: 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 cnt} {..puts $f
9bd0: 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 "hello, $cnt"..
9be0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
9bf0: 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 22 68 are [gets $f] "h
9c00: 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d 20 ello, $cnt"] !=
9c10: 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0a 0} {.. break.
9c20: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f .}. }. clo
9c30: 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f se $f. sendCo
9c40: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
9c50: 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 cket10_7_test_se
9c60: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 63 6e rver}. set cn
9c70: 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 6e 74 t.} 50..# Macint
9c80: 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 osh sockets can
9c90: 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f have more than o
9ca0: 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 70 6f ne server per po
9cb0: 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 rt.if {$tcl_plat
9cc0: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d form(platform) =
9cd0: 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b = "macintosh"} {
9ce0: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
9cf0: 74 52 65 73 75 6c 74 20 7b 30 20 38 38 33 36 7d tResult {0 8836}
9d00: 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 .} else {. se
9d10: 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 t conflictResult
9d20: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
9d30: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
9d40: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
9d50: 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 e}}.}..test tlsI
9d60: 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 O-11.6 {socket c
9d70: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
9d80: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9d90: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9da0: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
9db0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9dc0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9dd0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9de0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9df0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
9e00: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
9e10: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
9e20: 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f {set s2 [tls::so
9e30: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9e40: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
9e50: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9e60: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
9e70: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
9e80: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
9e90: 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 ]} msg]} {..set
9ea0: 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 result [list 1 $
9eb0: 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 msg]. } else
9ec0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
9ed0: 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 ist 0 [lindex [f
9ee0: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 configure $s2 -s
9ef0: 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c ockname] 2]]..cl
9f00: 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 ose $s2. }.
9f10: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9f20: 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f set result.} $co
9f30: 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a 74 65 nflictResult..te
9f40: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 st tlsIO-11.7 {s
9f50: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
9f60: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
9f70: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9f80: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9f90: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
9fa0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9fb0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
9fc0: 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_9_test_server
9fd0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9fe0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
9ff0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a000: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a010: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
a020: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
a030: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a040: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
a050: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
a060: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
a070: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
a080: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
a090: 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 cho $s]..}..proc
a0a0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
a0b0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
a0c0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
a0d0: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
a0e0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
a0f0: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
a100: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
a110: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a120: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
a130: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a140: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a150: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a160: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
a170: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
a180: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
a190: 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $s1 -buffering
a1a0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 line. set s2
a1b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a1c0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a1d0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a1e0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a1f0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a200: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a210: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
a220: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
a230: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
a240: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
a250: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
a260: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a270: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a280: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a290: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a2a0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
a2b0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
a2c0: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
a2d0: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
a2e0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
a2f0: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
a300: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 puts $s1 hello,t
a310: 6c 73 49 4f 2d 31 31 2e 37 2c 73 31 0a 09 67 65 lsIO-11.7,s1..ge
a320: 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 ts $s1..puts $s2
a330: 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e hello,tlsIO-11.
a340: 37 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 7,s2..gets $s2..
a350: 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 puts $s3 hello,t
a360: 6c 73 49 4f 2d 31 31 2e 37 2c 73 33 0a 09 67 65 lsIO-11.7,s3..ge
a370: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
a380: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
a390: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
a3a0: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
a3b0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
a3c0: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
a3d0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 69 erver}. set i
a3e0: 0a 7d 20 31 30 30 0a 0a 74 65 73 74 20 74 6c 73 .} 100..test tls
a3f0: 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 IO-11.8 {client
a400: 77 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 72 with several ser
a410: 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f vers} {socket do
a420: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
a430: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
a440: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
a450: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 sendCommand {..t
a460: 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 ls::init -certfi
a470: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
a480: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a490: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a4a0: 65 79 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a ey..set s1 [tls:
a4b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
a4c0: 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 "accept 4003" 40
a4d0: 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 03]..set s2 [tls
a4e0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
a4f0: 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 34 "accept 4004" 4
a500: 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 004]..set s3 [tl
a510: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
a520: 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 20 r "accept 4005"
a530: 34 30 30 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 4005]..proc hand
a540: 73 68 61 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 shake {s mp} {..
a550: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
a560: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
a570: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 } elseif {[c
a580: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
a590: 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d hake $s} result]
a5a0: 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 } {...# Some err
a5b0: 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a ors are normal..
a5c0: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
a5d0: 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 result == 1} {..
a5e0: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
a5f0: 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e plete...fileeven
a600: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 22 t $s readable ""
a610: 0a 09 09 70 75 74 73 20 24 73 20 24 6d 70 0a 09 ...puts $s $mp..
a620: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
a630: 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ..}..proc accept
a640: 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 {mp s a p} {..
a650: 20 20 20 23 20 54 68 65 73 65 20 68 61 76 65 20 # These have
a660: 74 6f 20 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c to accept non-bl
a670: 6f 63 6b 69 6e 67 2c 20 62 65 63 61 75 73 65 20 ocking, because
a680: 74 68 65 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a the handshaking.
a690: 09 20 20 20 20 23 20 6f 72 64 65 72 20 69 73 6e . # order isn
a6a0: 27 74 20 64 65 74 65 72 6d 69 6e 69 73 74 69 63 't deterministic
a6b0: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
a6c0: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
a6d0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
a6e0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
a6f0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
a700: 20 68 61 6e 64 73 68 61 6b 65 20 24 73 20 24 6d handshake $s $m
a710: 70 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 p]..}. }.
a720: 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 tls::init -certf
a730: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a740: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a750: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a760: 4b 65 79 0a 20 20 20 20 73 65 74 20 73 31 20 5b Key. set s1 [
a770: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
a780: 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 33 oteServerIP 4003
a790: 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c ]. set s2 [tl
a7a0: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
a7b0: 65 53 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a eServerIP 4004].
a7c0: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
a7d0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
a7e0: 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 erverIP 4005].
a7f0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
a800: 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 append l [gets $
a810: 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b s1] [gets $s1] [
a820: 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 eof $s1] [gets $
a830: 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b s2] [gets $s2] [
a840: 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 eof $s2] \..[get
a850: 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 s $s3] [gets $s3
a860: 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 ] [eof $s3].
a870: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c close $s1. cl
a880: 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 ose $s2. clos
a890: 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f e $s3. sendCo
a8a0: 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 mmand {..close $
a8b0: 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 s1..close $s2..c
a8c0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 lose $s3. }.
a8d0: 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 set l.} {4003
a8e0: 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 {} 1 4004 {} 1
a8f0: 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 4005 {} 1}..test
a900: 20 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 tlsIO-11.9 {acc
a910: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
a920: 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 or} {socket doTe
a930: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
a940: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ver} {. set s
a950: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a960: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a970: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a980: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a990: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
a9a0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
a9b0: 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 70 cept 8836]. p
a9c0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
a9d0: 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d p} {expr 10 / 0}
a9e0: 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f . proc bgerro
a9f0: 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c r args {..global
aa00: 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a x..set x $args.
aa10: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 }. sendCe
aa20: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 69 66 20 rtValues. if
aa30: 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d {[catch {sendCom
aa40: 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 mand {.. set
aa50: 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 peername [fconfi
aa60: 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b gure $callerSock
aa70: 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 et -peername]..
aa80: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
aa90: 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d 63 ocket \... -c
aaa0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
aab0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
aac0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
aad0: 69 65 6e 74 4b 65 79 20 5c 0a 09 09 20 20 20 20 ientKey \...
aae0: 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 6d [lindex $peernam
aaf0: 65 20 30 5d 20 38 38 33 36 5d 0a 09 20 20 20 20 e 0] 8836]..
ab00: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 7d close $s. . }
ab10: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 } msg]} {..close
ab20: 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a $s..error $msg.
ab30: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 69 }. set ti
ab40: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
ab50: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
ab60: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
ab70: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
ab80: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
ab90: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
aba0: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
abb0: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
abc0: 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 by zero}}..test
abd0: 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 73 tlsIO-11.10 {tes
abe0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
abf0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
ac00: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
ac10: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
ac20: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
ac30: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
ac40: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
ac50: 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 t10_12_test_serv
ac60: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
ac70: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
ac80: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
ac90: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
aca0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
acb0: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
acc0: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
acd0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f ept {s a p} {clo
ace0: 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 se $s}. }.
acf0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
ad00: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
ad10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
ad20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
ad30: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
ad40: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
ad50: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
ad60: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
ad70: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
ad80: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 name]. set n
ad90: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
ada0: 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 sockname]. se
adb0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
adc0: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
add0: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 2] [llength $p]
ade0: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 [llength $p].
adf0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
ae00: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
ae10: 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 $socket10_12_te
ae20: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
ae30: 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 et l.} {8836 3 3
ae40: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
ae50: 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 .11 {testing spu
ae60: 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 rious events} {s
ae70: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
ae80: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
ae90: 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 . # remote eq
aea0: 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 0a uivalent of 9.1.
aeb0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
aec0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
aed0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
aee0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
aef0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
af00: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
af10: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
af20: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
af30: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
af40: 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 verKey 8836]..pr
af50: 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 7d oc handshake {s}
af60: 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 {.. if {[eof
af70: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
af80: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 $s.. } elseif
af90: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 {[catch {tls::h
afa0: 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 andshake $s} res
afb0: 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 ult]} {...# Some
afc0: 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d errors are norm
afd0: 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 al... } elsei
afe0: 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d f {$result == 1}
aff0: 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 {...# Handshake
b000: 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 complete...file
b010: 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c event $s writabl
b020: 65 20 22 22 0a 09 09 61 66 74 65 72 20 31 30 30 e ""...after 100
b030: 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 20 writesome $s..
b040: 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 }..}..proc ac
b050: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b060: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
b070: 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 s -translation "
b080: 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 69 auto lf".. fi
b090: 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 leevent $s writa
b0a0: 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 ble [list handsh
b0b0: 61 6b 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 ake $s]..}..proc
b0c0: 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b writesome {s} {
b0d0: 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 .. for {set i
b0e0: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
b0f0: 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 incr i} {...puts
b100: 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f $s "line $i fro
b110: 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 m remote server"
b120: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f .. }.. clo
b130: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
b140: 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 set len 0.
b150: 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a set spurious 0.
b160: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
b170: 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 proc readlitt
b180: 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c le {s} {..global
b190: 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c spurious done l
b1a0: 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 en..set l [read
b1b0: 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 $s 1]..if {[stri
b1c0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d ng length $l] ==
b1d0: 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 0} {.. if {!
b1e0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e [eof $s]} {...in
b1f0: 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 cr spurious..
b200: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 } else {...clos
b210: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
b220: 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 1.. }..} else
b230: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e {.. incr len
b240: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
b250: 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $l]..}. }.
b260: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
b270: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
b280: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
b290: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b2a0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
b2b0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
b2c0: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
b2d0: 5d 0a 20 20 20 20 23 20 47 65 74 20 74 68 65 20 ]. # Get the
b2e0: 62 75 66 66 65 72 69 6e 67 20 63 6f 72 72 65 63 buffering correc
b2f0: 74 65 64 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ted. fconfigu
b300: 72 65 20 24 63 20 2d 62 75 66 66 65 72 69 6e 67 re $c -buffering
b310: 20 6c 69 6e 65 0a 20 20 20 20 23 20 50 75 74 20 line. # Put
b320: 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 a byte into the
b330: 63 6c 69 65 6e 74 20 70 69 70 65 20 74 6f 20 74 client pipe to t
b340: 72 69 67 67 65 72 20 54 4c 53 20 68 61 6e 64 73 rigger TLS hands
b350: 68 61 6b 69 6e 67 0a 20 20 20 20 70 75 74 73 20 haking. puts
b360: 24 63 20 61 0a 20 20 20 20 66 69 6c 65 65 76 65 $c a. fileeve
b370: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 5b nt $c readable [
b380: 6c 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 20 list readlittle
b390: 24 63 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c]. set time
b3a0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
b3b0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
b3c0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
b3d0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
b3e0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
b3f0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
b400: 73 65 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 5f se $socket_test_
b410: 73 65 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 server}. list
b420: 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a $spurious $len.
b430: 7d 20 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 } {0 2690}..test
b440: 20 74 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 tlsIO-11.12 {te
b450: 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 sting EOF sticky
b460: 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e ness} {unexplain
b470: 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 edFailure socket
b480: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
b490: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
b4a0: 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c # remote equival
b4b0: 65 6e 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 23 ent of 9.3. #
b4c0: 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f HOBBS: never wo
b4d0: 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 rked correctly.
b4e0: 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 set counter 0
b4f0: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
b500: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 proc count_u
b510: 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 p {s} {..global
b520: 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 counter done aft
b530: 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 er_id..set l [ge
b540: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
b550: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
b560: 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 r counter.. i
b570: 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d f {$counter > 9}
b580: 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 {...set done {E
b590: 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 OF is sticky}...
b5a0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 after cancel $af
b5b0: 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 ter_id...close $
b5c0: 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 s.. }..}.
b5d0: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 }. proc timed
b5e0: 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 _out {} {..globa
b5f0: 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f l c done..set do
b600: 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 ne {timed_out, E
b610: 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 OF is not sticky
b620: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
b630: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
b640: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
b650: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
b660: 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 et10_14_test_ser
b670: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
b680: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
b690: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
b6a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b6b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
b6c0: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
b6d0: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
b6e0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b6f0: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
b700: 6b 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 ke $s.. after
b710: 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 100 close $s..}
b720: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
b730: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b740: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
b750: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
b760: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b770: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
b780: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
b790: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
b7a0: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
b7b0: 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 dable "count_up
b7c0: 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 $c". set afte
b7d0: 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 r_id [after 1000
b7e0: 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 timed_out].
b7f0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 vwait done. s
b800: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
b810: 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 e $socket10_14_t
b820: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
b830: 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 set done.} {EOF
b840: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 is sticky}..test
b850: 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 tlsIO-11.13 {te
b860: 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 sting async writ
b870: 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 e, async flush,
b880: 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 async close} \..
b890: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
b8a0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
b8b0: 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 {. proc read
b8c0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
b8d0: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 count done..set
b8e0: 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e l [read $s]..in
b8f0: 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 cr count [string
b900: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 length $l]..if
b910: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
b920: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 close $s..
b930: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 set done 1..}.
b940: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 }. sendCert
b950: 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 Values. sendC
b960: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 ommand {..set fi
b970: 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 rstblock [string
b980: 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a 09 73 repeat a 31]..s
b990: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b et secondblock [
b9a0: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 string repeat b
b9b0: 36 35 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 74 65535]..set l [t
b9c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
b9d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
b9e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b9f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
ba00: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
ba10: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 34 35 rver accept 8845
ba20: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
ba30: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
ba40: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
ba50: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
ba60: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
ba70: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
ba80: 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 buffersize 16384
ba90: 20 5c 0a 09 09 20 20 20 20 2d 62 75 66 66 65 72 \... -buffer
baa0: 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 ing line.. fi
bab0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
bac0: 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 ble "readable $s
bad0: 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 "..}..proc reada
bae0: 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 ble {s} {.. s
baf0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
bb00: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
bb10: 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 readable {}..
bb20: 20 20 61 66 74 65 72 20 31 30 30 30 20 72 65 73 after 1000 res
bb30: 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 pond $s..}..proc
bb40: 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 respond {s} {..
bb50: 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 global first
bb60: 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 block.. puts
bb70: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 -nonewline $s $f
bb80: 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 irstblock.. a
bb90: 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 fter 1000 writed
bba0: 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 ata $s..}..proc
bbb0: 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a writedata {s} {.
bbc0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f . global seco
bbd0: 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 ndblock.. put
bbe0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
bbf0: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 $secondblock..
bc00: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
bc10: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
bc20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
bc30: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
bc40: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
bc50: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
bc60: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
bc70: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
bc80: 49 50 20 38 38 34 35 5d 0a 20 20 20 20 66 63 6f IP 8845]. fco
bc90: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
bca0: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
bcb0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ion lf -bufferin
bcc0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
bcd0: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
bce0: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c $s hello. fil
bcf0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
bd00: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
bd10: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
bd20: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
bd30: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
bd40: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
bd50: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
bd60: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 $timer. sendC
bd70: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c ommand {close $l
bd80: 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a }. set count.
bd90: 7d 20 36 35 35 36 36 0a 0a 70 72 6f 63 20 67 65 } 65566..proc ge
bda0: 74 64 61 74 61 20 7b 74 79 70 65 20 66 69 6c 65 tdata {type file
bdb0: 7d 20 7b 0a 20 20 20 20 23 20 52 65 61 64 20 68 } {. # Read h
bdc0: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
bdd0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 20 cepted socket..
bde0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
bdf0: 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 20 20 global failed.
be00: 20 20 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 set status [ca
be10: 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d tch {read $file}
be20: 20 64 61 74 61 5d 0a 20 20 20 20 69 66 20 7b 24 data]. if {$
be30: 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 status != 0} {..
be40: 73 65 74 20 78 20 22 72 65 61 64 20 66 61 69 6c set x "read fail
be50: 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 ed, error was $d
be60: 61 74 61 22 0a 09 63 61 74 63 68 20 7b 20 63 6c ata"..catch { cl
be70: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 ose $file }.
be80: 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e } elseif {[strin
be90: 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 g compare {} $da
bea0: 74 61 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 ta]} {. } els
beb0: 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 eif {[fblocked $
bec0: 66 69 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 file]} {. } e
bed0: 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c lseif {[eof $fil
bee0: 65 5d 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 6c e]} {..if {$fail
bef0: 65 64 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 ed} {.. set x
bf00: 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 "$type socket w
bf10: 61 73 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d as inherited"..}
bf20: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
bf30: 20 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 x "$type socket
bf40: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
bf50: 65 64 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b 20 ed"..}..catch {
bf60: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 close $file }.
bf70: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
bf80: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
bf90: 73 65 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f se}..catch { clo
bfa0: 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d se $file }. }
bfb0: 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 . return.}..t
bfc0: 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b est tlsIO-12.1 {
bfd0: 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 testing inherita
bfe0: 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f nce of server so
bff0: 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 ckets} {socket e
c000: 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 xec} {. makeF
c010: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 ile {} script1.
c020: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
c030: 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 cript2.. # Sc
c040: 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 ript1 is just a
c050: 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 10 second delay.
c060: 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 If the server
c070: 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 socket. # is
c080: 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 inherited, it wi
c090: 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 ll be held open
c0a0: 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a for 10 seconds..
c0b0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c0c0: 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 script1 w]. p
c0d0: 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 uts $f {..after
c0e0: 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 10000 exit..vwai
c0f0: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c100: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c110: 20 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 # Script2 crea
c120: 74 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 tes the server s
c130: 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 ocket, launches
c140: 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 script1,. # w
c150: 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 aits a second, a
c160: 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 nd exits. The s
c170: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c erver socket wil
c180: 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 l now. # be c
c190: 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 losed unless scr
c1a0: 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 ipt1 inherited i
c1b0: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f t... set f [o
c1c0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
c1d0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
c1e0: 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 set tclsh $::tc
c1f0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a ltest::tcltest].
c200: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c210: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
c220: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
c230: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
c240: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
c250: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
c260: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
c270: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
c280: 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cept \.. -cer
c290: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
c2a0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c2b0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
c2c0: 65 72 4b 65 79 20 38 38 32 38 5c 5d 22 0a 20 20 erKey 8828\]".
c2d0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
c2e0: 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 c accept { file
c2f0: 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 addr port } {..
c300: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
c310: 7d 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 }..exec $tclsh s
c320: 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 cript1 &..close
c330: 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 $f..after 1000 e
c340: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
c350: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
c360: 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 se $f.. # Lau
c370: 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 nch script2 and
c380: 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a wait 5 seconds..
c390: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
c3a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
c3b0: 69 70 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 ipt2 &. after
c3c0: 20 35 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 5000 { set ok_t
c3d0: 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 o_proceed 1 }.
c3e0: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 vwait ok_to_pr
c3f0: 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 oceed.. # If
c400: 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e we can still con
c410: 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 nect to the serv
c420: 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 er, the socket g
c430: 6f 74 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 ot inherited...
c440: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
c450: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
c460: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
c470: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c480: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
c490: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 ientKey \. . 1
c4a0: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
c4b0: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 sg]} {..set x {s
c4c0: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
c4d0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
c4e0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
c4f0: 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 ose $msg..set x
c500: 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 {server socket w
c510: 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 as inherited}.
c520: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d }.. set x.}
c530: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c540: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c550: 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 d}..test tlsIO-1
c560: 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.2 {testing inh
c570: 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 eritance of clie
c580: 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 nt sockets} {soc
c590: 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 ket exec} {.
c5a0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
c5b0: 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 pt1. makeFile
c5c0: 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 {} script2..
c5d0: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
c5e0: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
c5f0: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
c600: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
c610: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
c620: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
c630: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
c640: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
c650: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
c660: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
c670: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
c680: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c690: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c6a0: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
c6b0: 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e opens the clien
c6c0: 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 t socket and wri
c6d0: 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 tes to it. It t
c6e0: 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 hen. # launch
c6f0: 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 es script1 and e
c700: 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 xits. If the ch
c710: 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 ild process inhe
c720: 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 rited the. #
c730: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 client socket, t
c740: 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 he socket will s
c750: 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 till be open...
c760: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c770: 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 cript2 w]. pu
c780: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
c790: 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 tclsh $::tcltest
c7a0: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
c7b0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c7c0: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
c7d0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
c7e0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
c7f0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
c800: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
c810: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
c820: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
c830: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
c840: 63 61 43 65 72 74 20 5c 0a 09 20 20 20 20 2d 6b caCert \.. -k
c850: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
c860: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
c870: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
c880: 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 {..exec $tclsh s
c890: 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 cript1 &..puts $
c8a0: 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 f testing..flush
c8b0: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
c8c0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c8d0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c8e0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 ose $f.. # Cr
c8f0: 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 20 eate the server
c900: 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 socket.. set
c910: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
c920: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
c930: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
c940: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c950: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
c960: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
c970: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 39 5d ver accept 8829]
c980: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
c990: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
c9a0: 74 20 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 68 t } {..# When th
c9b0: 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 e client connect
c9c0: 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 s, establish the
c9d0: 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 read handler..g
c9e0: 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c lobal server..cl
c9f0: 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 63 6f ose $server..fco
ca00: 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 nfigure $file -b
ca10: 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 locking 0..filee
ca20: 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 vent $file reada
ca30: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
ca40: 64 73 68 61 6b 65 20 24 66 69 6c 65 20 72 65 61 dshake $file rea
ca50: 64 61 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 20 dable \...[list
ca60: 67 65 74 64 61 74 61 20 63 6c 69 65 6e 74 5d 20 getdata client]
ca70: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d -buffering line]
ca80: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a ..return. }..
ca90: 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 # If the soc
caa0: 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 ket doesn't hit
cab0: 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 end-of-file in 5
cac0: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 seconds, the.
cad0: 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 # script1 proc
cae0: 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e ess must have in
caf0: 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 herited the clie
cb00: 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 nt... set fai
cb10: 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 led 0. after
cb20: 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 5000 [list set f
cb30: 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 ailed 1].. #
cb40: 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 Launch the scrip
cb50: 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 t2 process..
cb60: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
cb70: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
cb80: 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a &.. vwait x.
cb90: 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 if {!$failed
cba0: 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 } {..vwait faile
cbb0: 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 d. }. set
cbc0: 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b x.} {client sock
cbd0: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
cbe0: 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ited}..test tlsI
cbf0: 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 O-12.3 {testing
cc00: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 inheritance of a
cc10: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d ccepted sockets}
cc20: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 63 \..{socket exec
cc30: 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 unixOnly} {.
cc40: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
cc50: 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c ipt1. makeFil
cc60: 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 e {} script2..
cc70: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
cc80: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
cc90: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
cca0: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
ccb0: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
ccc0: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
ccd0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
cce0: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
ccf0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
cd00: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
cd10: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
cd20: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
cd30: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
cd40: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
cd50: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
cd60: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
cd70: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
cd80: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
cd90: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
cda0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
cdb0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
cdc0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
cdd0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 39 le $serverKey 89
cde0: 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 30\]". puts $
cdf0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
ce00: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
ce10: 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 t } {.. globa
ce20: 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 66 63 6f l tclsh.. fco
ce30: 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 nfigure $file -b
ce40: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
ce50: 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 puts $file {t
ce60: 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b est data on sock
ce70: 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 et}.. exec $t
ce80: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
ce90: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 65 after 1000 e
cea0: 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f xit..}..vwait fo
ceb0: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
cec0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
ced0: 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 Launch the scrip
cee0: 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 t2 process and c
cef0: 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 onnect to it. S
cf00: 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 ee how long.
cf10: 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 # the socket sta
cf20: 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 ys open.. exe
cf30: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
cf40: 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a ltest script2 &.
cf50: 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 20 . after 2000
cf60: 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 set ok_to_procee
cf70: 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b d 1. vwait ok
cf80: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
cf90: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
cfa0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
cfb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
cfc0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
cfd0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
cfe0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
cff0: 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 0.0.1 8930].
d000: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 fconfigure $f -b
d010: 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 uffering full -b
d020: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 20 locking 0. #
d030: 57 65 20 6e 65 65 64 20 74 6f 20 70 75 74 20 61 We need to put a
d040: 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 72 byte into the r
d050: 65 61 64 20 71 75 65 75 65 2c 20 6f 74 68 65 72 ead queue, other
d060: 77 69 73 65 20 74 68 65 0a 20 20 20 20 23 20 54 wise the. # T
d070: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 64 6f 65 LS handshake doe
d080: 73 6e 27 74 20 66 69 6e 69 73 68 0a 20 20 20 20 sn't finish.
d090: 70 75 74 73 20 24 66 20 61 3b 20 66 6c 75 73 68 puts $f a; flush
d0a0: 20 24 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e $f. fileeven
d0b0: 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c t $f readable [l
d0c0: 69 73 74 20 67 65 74 64 61 74 61 20 61 63 63 65 ist getdata acce
d0d0: 70 74 65 64 20 24 66 5d 0a 0a 20 20 20 20 23 20 pted $f].. #
d0e0: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 If the socket is
d0f0: 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 still open afte
d100: 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 r 5 seconds, the
d110: 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 script1 process
d120: 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 . # must have
d130: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 inherited the a
d140: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
d150: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
d160: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
d170: 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 set failed 1..
d180: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 73 vwait x. s
d190: 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 et x.} {accepted
d1a0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
d1b0: 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 inherited}..test
d1c0: 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 73 tlsIO-13.1 {Tes
d1d0: 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 ting use of shar
d1e0: 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 ed socket betwee
d1f0: 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c n two threads} \
d200: 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 ..{socket testth
d210: 72 65 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 4f read} {. # HO
d220: 42 42 53 3a 20 6e 65 76 65 72 20 74 65 73 74 65 BBS: never teste
d230: 64 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 d. removeFile
d240: 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 script. thre
d250: 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 adReap.. make
d260: 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b File {. .pack
d270: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
d280: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
d290: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
d2a0: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
d2b0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
d2c0: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
d2d0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
d2e0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
d2f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
d300: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d310: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
d320: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
d330: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
d340: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
d350: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
d360: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
d370: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
d380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d390: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
d3a0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
d3b0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d3c0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
d3d0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
d3e0: 73 65 20 7b 0a 09 20 20 20 20 20 20 20 20 20 69 se {.. i
d3f0: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
d400: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
d410: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
d420: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 ..}..set i 0..vw
d430: 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a ait x..close $f.
d440: 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e ..# thread clean
d450: 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 s itself up...te
d460: 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 stthread exit.
d470: 20 20 7d 20 73 63 72 69 70 74 0a 0a 20 20 20 20 } script..
d480: 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 # create a threa
d490: 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 d. set server
d4a0: 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 thread [testthre
d4b0: 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 ad create { sour
d4c0: 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 ce script } ].
d4d0: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 update.. af
d4e0: 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 ter 1000. set
d4f0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
d500: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 127.0.0.1 8828].
d510: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
d520: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
d530: 65 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 e.. catch {..
d540: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a puts $s "hello".
d550: 09 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a .gets $s result.
d560: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
d570: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 $s. update..
d580: 20 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 after 2000.
d590: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
d5a0: 20 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 0a 20 [threadReap]..
d5b0: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d set result..}
d5c0: 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 74 65 73 74 {hello 1}..test
d5d0: 20 74 6c 73 49 4f 2d 31 34 2e 31 20 7b 74 65 73 tlsIO-14.1 {tes
d5e0: 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d t tls::unimport}
d5f0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
d600: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
d610: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 6d 73 67 5d ::unimport} msg]
d620: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
d630: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
d640: 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f be "tls::unimpo
d650: 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 rt channel"}}.te
d660: 73 74 20 74 6c 73 49 4f 2d 31 34 2e 32 20 7b 74 st tlsIO-14.2 {t
d670: 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 est tls::unimpor
d680: 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 t} {socket} {.
d690: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
d6a0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 66 6f 6f ls::unimport foo
d6b0: 20 62 61 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a bar} msg] $msg.
d6c0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
d6d0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
d6e0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 ls::unimport cha
d6f0: 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 nnel"}}.test tls
d700: 49 4f 2d 31 34 2e 33 20 7b 74 65 73 74 20 74 6c IO-14.3 {test tl
d710: 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f s::unimport} {so
d720: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
d730: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e [catch {tls::un
d740: 69 6d 70 6f 72 74 20 62 6f 67 75 73 7d 20 6d 73 import bogus} ms
d750: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 63 61 g] $msg.} {1 {ca
d760: 6e 20 6e 6f 74 20 66 69 6e 64 20 63 68 61 6e 6e n not find chann
d770: 65 6c 20 6e 61 6d 65 64 20 22 62 6f 67 75 73 22 el named "bogus"
d780: 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }}.test tlsIO-14
d790: 2e 34 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .4 {test tls::un
d7a0: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d7b0: 20 7b 0a 20 20 20 20 23 20 73 74 64 69 6e 20 63 {. # stdin c
d7c0: 61 6e 20 74 61 6b 65 20 64 69 66 66 65 72 65 6e an take differen
d7d0: 74 20 6e 61 6d 65 73 20 61 73 20 74 68 65 20 22 t names as the "
d7e0: 74 6f 70 22 20 63 68 61 6e 6e 65 6c 0a 20 20 20 top" channel.
d7f0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
d800: 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 73 74 64 69 s::unimport stdi
d810: 6e 7d 20 6d 73 67 5d 20 5c 0a 09 5b 73 74 72 69 n} msg] \..[stri
d820: 6e 67 20 6d 61 74 63 68 20 7b 62 61 64 20 63 68 ng match {bad ch
d830: 61 6e 6e 65 6c 20 22 2a 22 3a 20 6e 6f 74 20 61 annel "*": not a
d840: 20 54 4c 53 20 63 68 61 6e 6e 65 6c 7d 20 24 6d TLS channel} $m
d850: 73 67 5d 0a 7d 20 7b 31 20 31 7d 0a 74 65 73 74 sg].} {1 1}.test
d860: 20 74 6c 73 49 4f 2d 31 34 2e 35 20 7b 74 65 73 tlsIO-14.5 {tes
d870: 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d t tls::unimport}
d880: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
d890: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
d8a0: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
d8b0: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
d8c0: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
d8d0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
d8e0: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
d8f0: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
d900: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
d910: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
d920: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
d930: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
d940: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
d950: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
d960: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
d970: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
d980: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
d990: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
d9a0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
d9b0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
d9c0: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
d9d0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 $s -blocking 0..
d9e0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
d9f0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
da00: 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 andshake $s read
da10: 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 able readlittle
da20: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e \...-buffering n
da30: 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 one]. }. s
da40: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
da50: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
da60: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
da70: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
da80: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
da90: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
daa0: 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 t 8831]. set
dab0: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d c [tls::socket -
dac0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
dad0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
dae0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
daf0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
db00: 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 5d 0a localhost 8831].
db10: 20 20 20 20 23 20 6f 6e 6c 79 20 74 68 65 20 63 # only the c
db20: 6c 69 65 6e 74 20 67 65 74 73 20 74 6c 73 3a 3a lient gets tls::
db30: 69 6d 70 6f 72 74 0a 20 20 20 20 73 65 74 20 72 import. set r
db40: 65 73 20 5b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 es [tls::unimpor
db50: 74 20 24 63 5d 0a 20 20 20 20 6c 69 73 74 20 24 t $c]. list $
db60: 72 65 73 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 res [catch {clos
db70: 65 20 24 63 7d 20 65 72 72 5d 20 24 65 72 72 20 e $c} err] $err
db80: 5c 0a 09 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 \..[catch {close
db90: 20 24 73 7d 20 65 72 72 5d 20 24 65 72 72 0a 7d $s} err] $err.}
dba0: 20 7b 7b 7d 20 30 20 7b 7d 20 30 20 7b 7d 7d 0a {{} 0 {} 0 {}}.
dbb0: 0a 74 65 73 74 20 74 6c 73 2d 62 75 67 35 38 2d .test tls-bug58-
dbc0: 31 2e 30 20 7b 74 65 73 74 20 70 72 6f 74 6f 63 1.0 {test protoc
dbd0: 6f 6c 20 6e 65 67 6f 74 69 61 74 69 6f 6e 20 66 ol negotiation f
dbe0: 61 69 6c 75 72 65 7d 20 7b 73 6f 63 6b 65 74 7d ailure} {socket}
dbf0: 20 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f 77 69 {. # Followi
dc00: 6e 67 20 63 6f 64 65 20 69 73 20 62 61 73 65 64 ng code is based
dc10: 20 6f 6e 20 77 68 61 74 20 77 61 73 20 72 65 70 on what was rep
dc20: 6f 72 74 65 64 20 69 6e 20 62 75 67 20 23 35 38 orted in bug #58
dc30: 2e 20 50 72 69 6f 72 0a 20 20 20 20 23 20 74 6f . Prior. # to
dc40: 20 66 69 78 20 74 68 65 20 70 72 6f 67 72 61 6d fix the program
dc50: 20 77 6f 75 6c 64 20 63 72 61 73 68 20 77 69 74 would crash wit
dc60: 68 20 61 20 73 65 67 66 61 75 6c 74 2e 0a 20 20 h a segfault..
dc70: 20 20 70 72 6f 63 20 41 63 63 65 70 74 20 7b 73 proc Accept {s
dc80: 6f 63 6b 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 ock args} {.
dc90: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
dca0: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
dcb0: 3b 0a 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 ;. fileev
dcc0: 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 62 ent $sock readab
dcd0: 6c 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 68 61 le [list Handsha
dce0: 6b 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 7d 0a ke $sock]. }.
dcf0: 20 20 20 20 70 72 6f 63 20 48 61 6e 64 73 68 61 proc Handsha
dd00: 6b 65 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 ke {sock} {.
dd10: 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 48 set ::done H
dd20: 41 4e 44 0a 20 20 20 20 20 20 20 20 63 61 74 63 AND. catc
dd30: 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b h {tls::handshak
dd40: 65 20 24 73 6f 63 6b 7d 20 6d 73 67 0a 20 20 20 e $sock} msg.
dd50: 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 set ::done
dd60: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 23 $msg. }. #
dd70: 20 4e 4f 54 45 3a 20 77 68 65 6e 20 64 6f 69 6e NOTE: when doin
dd80: 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 g an in-process
dd90: 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 client/server te
dda0: 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e st, both sides n
ddb0: 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 eed. # to be
ddc0: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 non-blocking for
ddd0: 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 the TLS handsha
dde0: 6b 65 0a 0a 20 20 20 20 23 20 53 65 72 76 65 72 ke.. # Server
ddf0: 20 2d 20 4f 6e 6c 79 20 61 63 63 65 70 74 20 54 - Only accept T
de00: 4c 53 20 31 2e 32 0a 20 20 20 20 73 65 74 20 73 LS 1.2. set s
de10: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
de20: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
de30: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
de40: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
de50: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d ile $serverKey -
de60: 72 65 71 75 65 73 74 20 30 20 5c 0a 09 20 20 20 request 0 \..
de70: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 73 73 6c -require 0 -ssl
de80: 32 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 2 0 -ssl3 0 -tls
de90: 31 20 30 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 1 0 -tls1.1 0 -t
dea0: 6c 73 31 2e 32 20 31 20 5c 0a 09 20 20 20 20 2d ls1.2 1 \.. -
deb0: 73 65 72 76 65 72 20 41 63 63 65 70 74 20 38 38 server Accept 88
dec0: 33 31 5d 0a 20 20 20 20 23 20 43 6c 69 65 6e 74 31]. # Client
ded0: 20 2d 20 4f 6e 6c 79 20 70 72 6f 70 6f 73 65 20 - Only propose
dee0: 54 4c 53 31 2e 30 0a 20 20 20 20 73 65 74 20 63 TLS1.0. set c
def0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 61 [tls::socket -a
df00: 73 79 6e 63 20 2d 63 61 66 69 6c 65 20 24 63 61 sync -cafile $ca
df10: 43 65 72 74 20 2d 72 65 71 75 65 73 74 20 30 20 Cert -request 0
df20: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
df30: 20 20 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 -ssl2 0 -ssl3
df40: 30 20 2d 74 6c 73 31 20 31 20 2d 74 6c 73 31 2e 0 -tls1 1 -tls1.
df50: 31 20 30 20 2d 74 6c 73 31 2e 32 20 30 20 6c 6f 1 0 -tls1.2 0 lo
df60: 63 61 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 calhost 8831].
df70: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
df80: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
df90: 70 75 74 73 20 24 63 20 61 20 3b 20 66 6c 75 73 puts $c a ; flus
dfa0: 68 20 24 63 0a 20 20 20 20 61 66 74 65 72 20 35 h $c. after 5
dfb0: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 3a 3a 000 [list set ::
dfc0: 64 6f 6e 65 20 74 69 6d 65 6f 75 74 5d 0a 20 20 done timeout].
dfd0: 20 20 76 77 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 vwait ::done.
dfe0: 20 20 20 73 77 69 74 63 68 20 2d 65 78 61 63 74 switch -exact
dff0: 20 2d 2d 20 24 3a 3a 64 6f 6e 65 20 7b 0a 20 20 -- $::done {.
e000: 20 20 20 20 20 20 22 68 61 6e 64 73 68 61 6b 65 "handshake
e010: 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 73 failed: wrong s
e020: 73 6c 20 76 65 72 73 69 6f 6e 22 20 2d 0a 20 20 sl version" -.
e030: 20 20 20 20 20 20 22 68 61 6e 64 73 68 61 6b 65 "handshake
e040: 20 66 61 69 6c 65 64 3a 20 75 6e 73 75 70 70 6f failed: unsuppo
e050: 72 74 65 64 20 70 72 6f 74 6f 63 6f 6c 22 20 7b rted protocol" {
e060: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
e070: 20 3a 3a 64 6f 6e 65 20 22 68 61 6e 64 73 68 61 ::done "handsha
e080: 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 ke failed: wrong
e090: 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 22 version number"
e0a0: 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d . }. }
e0b0: 0a 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 0a . set ::done.
e0c0: 7d 20 7b 68 61 6e 64 73 68 61 6b 65 20 66 61 69 } {handshake fai
e0d0: 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 led: wrong versi
e0e0: 6f 6e 20 6e 75 6d 62 65 72 7d 0a 0a 23 20 63 6c on number}..# cl
e0f0: 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e eanup.if {[strin
e100: 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 g match sock* $c
e110: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d ommandSocket] ==
e120: 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 1} {. puts $c
e130: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 ommandSocket exi
e140: 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d t. flush $comm
e150: 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 andSocket.}.catc
e160: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
e170: 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b dSocket}.catch {
e180: 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f close $remotePro
e190: 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 cChan}.::tcltest
e1a0: 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 ::cleanupTests.f
e1b0: 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 lush stdout.retu
e1c0: 72 6e 0a rn.