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 20 0a 23 ba Solutions. .#
0180: 0a 23 20 53 65 65 20 74 68 65 20 66 69 6c 65 20 .# See the file
0190: 22 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 22 20 "license.terms"
01a0: 66 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 for information
01b0: 6f 6e 20 75 73 61 67 65 20 61 6e 64 20 72 65 64 on usage and red
01c0: 69 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66 istribution.# of
01d0: 20 74 68 69 73 20 66 69 6c 65 2c 20 61 6e 64 20 this file, and
01e0: 66 6f 72 20 61 20 44 49 53 43 4c 41 49 4d 45 52 for a DISCLAIMER
01f0: 20 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e 54 49 OF ALL WARRANTI
0200: 45 53 2e 0a 23 0a 23 20 52 43 53 3a 20 40 28 23 ES..#.# RCS: @(#
0210: 29 20 24 49 64 3a 20 74 6c 73 49 4f 2e 74 65 73 ) $Id: tlsIO.tes
0220: 74 2c 76 20 31 2e 32 32 20 32 30 30 34 2f 31 32 t,v 1.22 2004/12
0230: 2f 32 33 20 32 33 3a 35 31 3a 34 30 20 70 61 74 /23 23:51:40 pat
0240: 74 68 6f 79 74 73 20 45 78 70 20 24 0a 0a 23 20 thoyts 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 20 0a 23 20 53 6f 6d -------.# .# Som
02b0: 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 e tests in socke
02c0: 74 2e 74 65 73 74 20 64 65 70 65 6e 64 20 6f 6e t.test depend on
02d0: 20 74 68 65 20 65 78 69 73 74 65 6e 63 65 20 6f the existence o
02e0: 66 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 f a remote serve
02f0: 72 20 74 6f 0a 23 20 77 68 69 63 68 20 74 68 65 r to.# which the
0300: 79 20 63 6f 6e 6e 65 63 74 2e 20 54 68 65 20 72 y connect. The r
0310: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75 73 emote server mus
0320: 74 20 62 65 20 61 6e 20 69 6e 73 74 61 6e 63 65 t be an instance
0330: 20 6f 66 20 74 63 6c 74 65 73 74 20 61 6e 64 20 of tcltest and
0340: 69 74 0a 23 20 6d 75 73 74 20 72 75 6e 20 74 68 it.# must run th
0350: 65 20 73 63 72 69 70 74 20 66 6f 75 6e 64 20 69 e script found i
0360: 6e 20 74 68 65 20 66 69 6c 65 20 22 72 65 6d 6f n the file "remo
0370: 74 65 2e 74 63 6c 22 20 69 6e 20 74 68 69 73 20 te.tcl" in this
0380: 64 69 72 65 63 74 6f 72 79 2e 20 59 6f 75 0a 23 directory. You.#
0390: 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 72 can start the r
03a0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 emote server on
03b0: 61 6e 79 20 6d 61 63 68 69 6e 65 20 72 65 61 63 any machine reac
03c0: 68 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 6d hable from the m
03d0: 61 63 68 69 6e 65 20 6f 6e 0a 23 20 77 68 69 63 achine on.# whic
03e0: 68 20 79 6f 75 20 77 61 6e 74 20 74 6f 20 72 75 h you want to ru
03f0: 6e 20 74 68 65 20 73 6f 63 6b 65 74 20 74 65 73 n the socket tes
0400: 74 73 2c 20 62 79 20 69 73 73 75 69 6e 67 3a 0a ts, by issuing:.
0410: 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 # .# tcltest
0420: 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 70 6f 72 remote.tcl -por
0430: 74 20 38 30 34 38 09 23 20 4f 72 20 63 68 6f 6f t 8048.# Or choo
0440: 73 65 20 61 6e 6f 74 68 65 72 20 70 6f 72 74 20 se another port
0450: 6e 75 6d 62 65 72 2e 0a 23 20 0a 23 20 49 66 20 number..# .# If
0460: 74 68 65 20 6d 61 63 68 69 6e 65 20 79 6f 75 20 the machine you
0470: 61 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 are running the
0480: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e remote server on
0490: 20 68 61 73 20 73 65 76 65 72 61 6c 20 49 50 0a has several IP.
04a0: 23 20 69 6e 74 65 72 66 61 63 65 73 2c 20 79 6f # interfaces, yo
04b0: 75 20 63 61 6e 20 63 68 6f 6f 73 65 20 77 68 69 u can choose whi
04c0: 63 68 20 69 6e 74 65 72 66 61 63 65 20 74 68 65 ch interface the
04d0: 20 73 65 72 76 65 72 20 6c 69 73 74 65 6e 73 20 server listens
04e0: 6f 6e 20 66 6f 72 0a 23 20 63 6f 6e 6e 65 63 74 on for.# connect
04f0: 69 6f 6e 73 20 62 79 20 73 70 65 63 69 66 79 69 ions by specifyi
0500: 6e 67 20 74 68 65 20 2d 61 64 64 72 65 73 73 20 ng the -address
0510: 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 66 6c 61 command line fla
0520: 67 2c 20 73 6f 3a 0a 23 20 0a 23 20 20 20 20 20 g, so:.# .#
0530: 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 tcltest remote.t
0540: 63 6c 20 2d 61 64 64 72 65 73 73 20 79 6f 75 72 cl -address your
0550: 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a .machine.com.# .
0560: 23 20 54 68 65 73 65 20 6f 70 74 69 6f 6e 73 20 # These options
0570: 63 61 6e 20 61 6c 73 6f 20 62 65 20 73 65 74 20 can also be set
0580: 62 79 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 by environment v
0590: 61 72 69 61 62 6c 65 73 2e 20 4f 6e 20 55 6e 69 ariables. On Uni
05a0: 78 2c 20 79 6f 75 20 63 61 6e 0a 23 20 74 79 70 x, you can.# typ
05b0: 65 20 74 68 65 73 65 20 63 6f 6d 6d 61 6e 64 73 e these commands
05c0: 20 74 6f 20 74 68 65 20 73 68 65 6c 6c 20 66 72 to the shell fr
05d0: 6f 6d 20 77 68 69 63 68 20 74 68 65 20 72 65 6d om which the rem
05e0: 6f 74 65 20 73 65 72 76 65 72 20 69 73 20 73 74 ote server is st
05f0: 61 72 74 65 64 3a 0a 23 20 0a 23 20 20 20 20 20 arted:.# .#
0600: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 shell% setenv se
0610: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 20 rverPort 8048.#
0620: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e shell% seten
0630: 76 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 v serverAddress
0640: 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d your.machine.com
0650: 0a 23 20 0a 23 20 61 6e 64 20 73 75 62 73 65 71 .# .# and subseq
0660: 75 65 6e 74 6c 79 20 79 6f 75 20 63 61 6e 20 73 uently you can s
0670: 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 tart the remote
0680: 73 65 72 76 65 72 20 77 69 74 68 3a 0a 23 20 0a server with:.# .
0690: 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 # tcltest re
06a0: 6d 6f 74 65 2e 74 63 6c 0a 23 20 0a 23 20 74 6f mote.tcl.# .# to
06b0: 20 68 61 76 65 20 69 74 20 6c 69 73 74 65 6e 20 have it listen
06c0: 6f 6e 20 70 6f 72 74 20 38 30 34 38 20 6f 6e 20 on port 8048 on
06d0: 74 68 65 20 69 6e 74 65 72 66 61 63 65 20 79 6f the interface yo
06e0: 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a ur.machine.com..
06f0: 23 20 20 20 20 20 0a 23 20 57 68 65 6e 20 74 68 # .# When th
0700: 65 20 73 65 72 76 65 72 20 73 74 61 72 74 73 2c e server starts,
0710: 20 69 74 20 70 72 69 6e 74 73 20 6f 75 74 20 61 it prints out a
0720: 20 64 65 74 61 69 6c 65 64 20 6d 65 73 73 61 67 detailed messag
0730: 65 20 63 6f 6e 74 61 69 6e 69 6e 67 20 69 74 73 e containing its
0740: 0a 23 20 63 6f 6e 66 69 67 75 72 61 74 69 6f 6e .# configuration
0750: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 61 6e information, an
0760: 64 20 69 74 20 77 69 6c 6c 20 62 6c 6f 63 6b 20 d it will block
0770: 75 6e 74 69 6c 20 6b 69 6c 6c 65 64 20 77 69 74 until killed wit
0780: 68 20 61 20 43 74 72 6c 2d 43 2e 0a 23 20 4f 6e h a Ctrl-C..# On
0790: 63 65 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 ce the remote se
07a0: 72 76 65 72 20 65 78 69 73 74 73 2c 20 79 6f 75 rver exists, you
07b0: 20 63 61 6e 20 72 75 6e 20 74 68 65 20 74 65 73 can run the tes
07c0: 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 ts in socket.tes
07d0: 74 20 77 69 74 68 0a 23 20 74 68 65 20 73 65 72 t with.# the ser
07e0: 76 65 72 20 62 79 20 73 65 74 74 69 6e 67 20 74 ver by setting t
07f0: 77 6f 20 54 63 6c 20 76 61 72 69 61 62 6c 65 73 wo Tcl variables
0800: 3a 0a 23 20 0a 23 20 20 20 20 20 25 20 73 65 74 :.# .# % set
0810: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0820: 3c 6e 61 6d 65 20 6f 72 20 61 64 64 72 65 73 73 <name or address
0830: 20 6f 66 20 6d 61 63 68 69 6e 65 20 6f 6e 20 77 of machine on w
0840: 68 69 63 68 20 73 65 72 76 65 72 20 72 75 6e 73 hich server runs
0850: 3e 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 65 >.# % set re
0860: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 38 moteServerPort 8
0870: 30 34 38 0a 23 20 0a 23 20 54 68 65 73 65 20 76 048.# .# These v
0880: 61 72 69 61 62 6c 65 73 20 61 72 65 20 61 6c 73 ariables are als
0890: 6f 20 73 65 74 74 61 62 6c 65 20 66 72 6f 6d 20 o settable from
08a0: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e the environment.
08b0: 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 On Unix, you ca
08c0: 6e 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c n:.# .# shel
08d0: 6c 25 20 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 l% setenv remote
08e0: 53 65 72 76 65 72 49 50 20 6d 61 63 68 69 6e 65 ServerIP machine
08f0: 2e 77 68 65 72 65 2e 73 65 72 76 65 72 2e 72 75 .where.server.ru
0900: 6e 73 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 ns.# shell%
0910: 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 setenv remoteSer
0920: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 20 0a verPort 8048.# .
0930: 23 20 54 68 65 20 70 72 65 61 6d 62 6c 65 20 6f # The preamble o
0940: 66 20 74 68 65 20 73 6f 63 6b 65 74 2e 74 65 73 f the socket.tes
0950: 74 20 66 69 6c 65 20 63 68 65 63 6b 73 20 74 6f t file checks to
0960: 20 73 65 65 20 69 66 20 74 68 65 20 76 61 72 69 see if the vari
0970: 61 62 6c 65 73 20 61 72 65 20 73 65 74 0a 23 20 ables are set.#
0980: 65 69 74 68 65 72 20 69 6e 20 54 63 6c 20 6f 72 either in Tcl or
0990: 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d in the environm
09a0: 65 6e 74 3b 20 69 66 20 74 68 65 79 20 61 72 65 ent; if they are
09b0: 2c 20 69 74 20 61 74 74 65 6d 70 74 73 20 74 6f , it attempts to
09c0: 20 63 6f 6e 6e 65 63 74 20 74 6f 0a 23 20 74 68 connect to.# th
09d0: 65 20 73 65 72 76 65 72 2e 20 49 66 20 74 68 65 e server. If the
09e0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 73 20 73 connection is s
09f0: 75 63 63 65 73 73 66 75 6c 2c 20 74 68 65 20 74 uccessful, the t
0a00: 65 73 74 73 20 75 73 69 6e 67 20 74 68 65 20 72 ests using the r
0a10: 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 77 emote.# server w
0a20: 69 6c 6c 20 62 65 20 70 65 72 66 6f 72 6d 65 64 ill be performed
0a30: 3b 20 6f 74 68 65 72 77 69 73 65 2c 20 69 74 20 ; otherwise, it
0a40: 77 69 6c 6c 20 61 74 74 65 6d 70 74 20 74 6f 20 will attempt to
0a50: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0a60: 0a 23 20 73 65 72 76 65 72 20 28 76 69 61 20 65 .# server (via e
0a70: 78 65 63 29 20 6f 6e 20 70 6c 61 74 66 6f 72 6d xec) on platform
0a80: 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 74 s that support t
0a90: 68 69 73 2c 20 6f 6e 20 74 68 65 20 6c 6f 63 61 his, on the loca
0aa0: 6c 20 68 6f 73 74 2c 0a 23 20 6c 69 73 74 65 6e l host,.# listen
0ab0: 69 6e 67 20 61 74 20 70 6f 72 74 20 38 30 34 38 ing at port 8048
0ac0: 2e 20 49 66 20 61 6c 6c 20 66 61 69 6c 73 2c 20 . If all fails,
0ad0: 61 20 6d 65 73 73 61 67 65 20 69 73 20 70 72 69 a message is pri
0ae0: 6e 74 65 64 20 61 6e 64 20 74 68 65 20 74 65 73 nted and the tes
0af0: 74 73 0a 23 20 75 73 69 6e 67 20 74 68 65 20 72 ts.# using the r
0b00: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 61 72 65 emote server are
0b10: 20 6e 6f 74 20 70 65 72 66 6f 72 6d 65 64 2e 0a not performed..
0b20: 0a 70 72 6f 63 20 64 70 75 74 73 20 7b 6d 73 67 .proc dputs {msg
0b30: 7d 20 7b 20 72 65 74 75 72 6e 20 3b 20 70 75 74 } { return ; put
0b40: 73 20 73 74 64 65 72 72 20 24 6d 73 67 20 3b 20 s stderr $msg ;
0b50: 66 6c 75 73 68 20 73 74 64 65 72 72 20 7d 0a 0a flush stderr }..
0b60: 69 66 20 7b 5b 6c 73 65 61 72 63 68 20 5b 6e 61 if {[lsearch [na
0b70: 6d 65 73 70 61 63 65 20 63 68 69 6c 64 72 65 6e mespace children
0b80: 5d 20 3a 3a 74 63 6c 74 65 73 74 5d 20 3d 3d 20 ] ::tcltest] ==
0b90: 2d 31 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 -1} {. packag
0ba0: 65 20 72 65 71 75 69 72 65 20 74 63 6c 74 65 73 e require tcltes
0bb0: 74 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 t. namespace
0bc0: 69 6d 70 6f 72 74 20 2d 66 6f 72 63 65 20 3a 3a import -force ::
0bd0: 74 63 6c 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 tcltest::*.}..#
0be0: 54 68 65 20 62 75 69 6c 64 20 64 69 72 20 69 73 The build dir is
0bf0: 20 61 64 64 65 64 20 61 73 20 74 68 65 20 66 69 added as the fi
0c00: 72 73 74 20 65 6c 65 6d 65 6e 74 20 6f 66 20 24 rst element of $
0c10: 50 41 54 48 0a 73 65 74 20 61 75 74 6f 5f 70 61 PATH.set auto_pa
0c20: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
0c30: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
0c40: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
0c50: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 23 20 4c H) ";:"] 0]].# L
0c60: 6f 61 64 20 74 68 65 20 74 6c 73 20 70 61 63 6b oad the tls pack
0c70: 61 67 65 0a 70 61 63 6b 61 67 65 20 72 65 71 75 age.package requ
0c80: 69 72 65 20 74 6c 73 20 31 2e 35 0a 0a 73 65 74 ire tls 1.5..set
0c90: 20 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 38 tlsServerPort 8
0ca0: 30 34 38 0a 0a 23 20 53 70 65 63 69 66 79 20 77 048..# Specify w
0cb0: 68 65 72 65 20 74 68 65 20 63 65 72 74 69 66 69 here the certifi
0cc0: 63 61 74 65 73 20 61 72 65 0a 0a 73 65 74 20 63 cates are..set c
0cd0: 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f ertsDir.[file jo
0ce0: 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 in [file dirname
0cf0: 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 [info script]]
0d00: 63 65 72 74 73 5d 0a 73 65 74 20 73 65 72 76 65 certs].set serve
0d10: 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e rCert.[file join
0d20: 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 65 $certsDir serve
0d30: 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e r.pem].set clien
0d40: 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e tCert.[file join
0d50: 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e $certsDir clien
0d60: 74 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 t.pem].set caCer
0d70: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
0d80: 72 74 73 44 69 72 20 63 61 2e 70 65 6d 5d 0a 73 rtsDir ca.pem].s
0d90: 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 et serverKey.[fi
0da0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
0db0: 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a 73 65 r server.key].se
0dc0: 74 20 63 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c t clientKey.[fil
0dd0: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0de0: 20 63 6c 69 65 6e 74 2e 6b 65 79 5d 0a 0a 23 20 client.key]..#
0df0: 53 6f 6d 65 20 74 65 73 74 73 20 72 65 71 75 69 Some tests requi
0e00: 72 65 20 74 68 65 20 74 65 73 74 74 68 72 65 61 re the testthrea
0e10: 64 20 61 6e 64 20 65 78 65 63 20 63 6f 6d 6d 61 d and exec comma
0e20: 6e 64 73 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 nds..set ::tclte
0e30: 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 st::testConstrai
0e40: 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 29 20 nts(testthread)
0e50: 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 \..[expr {[info
0e60: 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 commands testthr
0e70: 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 73 65 74 ead] != {}}].set
0e80: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
0e90: 43 6f 6e 73 74 72 61 69 6e 74 73 28 65 78 65 63 Constraints(exec
0ea0: 29 20 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 ) [expr {[info c
0eb0: 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 21 3d ommands exec] !=
0ec0: 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 72 65 {}}]..#.# If re
0ed0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6f 72 20 moteServerIP or
0ee0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0ef0: 20 61 72 65 20 6e 6f 74 20 73 65 74 2c 20 63 68 are not set, ch
0f00: 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 65 6e 76 eck in the.# env
0f10: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
0f20: 65 73 20 66 6f 72 20 65 78 74 65 72 6e 61 6c 6c es for externall
0f30: 79 20 73 65 74 20 76 61 6c 75 65 73 2e 0a 23 0a y set values..#.
0f40: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0f50: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ts remoteServerI
0f60: 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 P]} {. if {[i
0f70: 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 nfo exists env(r
0f80: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d emoteServerIP)]}
0f90: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0fa0: 72 76 65 72 49 50 20 24 65 6e 76 28 72 65 6d 6f rverIP $env(remo
0fb0: 74 65 53 65 72 76 65 72 49 50 29 0a 20 20 20 20 teServerIP).
0fc0: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
0fd0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0fe0: 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 erPort]} {. i
0ff0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
1000: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
1010: 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 74 20 72 Port)]} {..set r
1020: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
1030: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
1040: 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 65 6c 73 rPort). } els
1050: 65 20 7b 0a 20 20 20 20 20 20 20 20 69 66 20 7b e {. if {
1060: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
1070: 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a oteServerIP]} {.
1080: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
1090: 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 erverPort $tlsSe
10a0: 72 76 65 72 50 6f 72 74 0a 20 20 20 20 20 20 20 rverPort.
10b0: 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 }. }.}..proc
10c0: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 7b 73 do_handshake {s
10d0: 20 7b 74 79 70 65 20 72 65 61 64 61 62 6c 65 7d {type readable}
10e0: 20 7b 63 6d 64 20 7b 7d 7d 20 61 72 67 73 7d 20 {cmd {}} args}
10f0: 7b 0a 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 {. if {[eof $
1100: 73 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a s]} {..close $s.
1110: 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b .dputs "handshak
1120: 65 3a 20 65 6f 66 22 0a 09 73 65 74 20 3a 3a 64 e: eof"..set ::d
1130: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 22 65 6f 66 o_handshake "eof
1140: 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b ". } elseif {
1150: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e [catch {tls::han
1160: 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c dshake $s} resul
1170: 74 5d 7d 20 7b 0a 09 23 20 53 6f 6d 65 20 65 72 t]} {..# Some er
1180: 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e rors are normal.
1190: 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 ..dputs "handsha
11a0: 6b 65 3a 20 24 72 65 73 75 6c 74 22 0a 20 20 20 ke: $result".
11b0: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
11c0: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 23 20 48 61 lt == 1} {..# Ha
11d0: 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 ndshake complete
11e0: 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 ..if {[llength $
11f0: 61 72 67 73 5d 7d 20 7b 20 65 76 61 6c 20 5b 6c args]} { eval [l
1200: 69 73 74 20 66 63 6f 6e 66 69 67 75 72 65 20 24 ist fconfigure $
1210: 73 5d 20 24 61 72 67 73 20 7d 0a 09 69 66 20 7b s] $args }..if {
1220: 24 63 6d 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 $cmd == ""} {..
1230: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
1240: 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c 73 65 $type ""..} else
1250: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e {.. fileeven
1260: 74 20 24 73 20 24 74 79 70 65 20 22 24 63 6d 64 t $s $type "$cmd
1270: 20 5b 6c 69 73 74 20 24 73 5d 22 0a 09 7d 0a 09 [list $s]"..}..
1280: 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 dputs "handshake
1290: 3a 20 63 6f 6d 70 6c 65 74 65 22 0a 09 73 65 74 : complete"..set
12a0: 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 ::do_handshake
12b0: 22 63 6f 6d 70 6c 65 74 65 22 0a 20 20 20 20 7d "complete". }
12c0: 20 65 6c 73 65 20 7b 0a 09 64 70 75 74 73 20 22 else {..dputs "
12d0: 68 61 6e 64 73 68 61 6b 65 3a 20 69 6e 20 70 72 handshake: in pr
12e0: 6f 67 72 65 73 73 22 0a 20 20 20 20 7d 0a 7d 0a ogress". }.}.
12f0: 0a 23 0a 23 20 43 68 65 63 6b 20 69 66 20 77 65 .#.# Check if we
1300: 27 72 65 20 73 75 70 70 6f 73 65 64 20 74 6f 20 're supposed to
1310: 64 6f 20 74 65 73 74 73 20 61 67 61 69 6e 73 74 do tests against
1320: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
1330: 65 72 0a 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 er.#..set doTest
1340: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1350: 72 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 r 1.if {![info e
1360: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
1370: 65 72 49 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 erIP] && ($tcl_p
1380: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
1390: 29 20 21 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 ) != "macintosh"
13a0: 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d )} {. set rem
13b0: 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 37 2e oteServerIP 127.
13c0: 30 2e 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 0.0.1.}.if {($do
13d0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
13e0: 65 72 76 65 72 20 3d 3d 20 31 29 20 26 26 20 28 erver == 1) && (
13f0: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 ![info exists re
1400: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 29 moteServerPort])
1410: 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f } {. set remo
1420: 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c teServerPort $tl
1430: 73 53 65 72 76 65 72 50 6f 72 74 0a 7d 0a 0a 23 sServerPort.}..#
1440: 20 41 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e Attempt to conn
1450: 65 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 ect to a remote
1460: 73 65 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 server if one is
1470: 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 already running
1480: 2e 20 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 . If it.# is not
1490: 20 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 running or for
14a0: 73 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f some other reaso
14b0: 6e 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 n the connect fa
14c0: 69 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a ils, attempt to.
14d0: 23 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f # start the remo
14e0: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 te server on the
14f0: 20 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 local host list
1500: 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 38 30 ening on port 80
1510: 34 38 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 48. This.# is on
1520: 6c 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 ly done on platf
1530: 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 orms that suppor
1540: 74 20 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 t exec (i.e. not
1550: 20 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e on the Mac). On
1560: 0a 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 .# platforms tha
1570: 74 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 t do not support
1580: 20 65 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 exec, the remot
1590: 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 e server must be
15a0: 20 73 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 started.# by th
15b0: 65 20 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 e user before ru
15c0: 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e nning the tests.
15d0: 0a 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 ..set remoteProc
15e0: 43 68 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d Chan "".set comm
15f0: 61 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 andSocket "".if
1600: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
1610: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
1620: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 catch {close $c
1630: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 ommandSocket}.
1640: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
1650: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
1660: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
1670: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
1680: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
1690: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
16a0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
16b0: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
16c0: 65 72 49 50 20 24 72 65 6d 6f 74 65 53 65 72 76 erIP $remoteServ
16d0: 65 72 50 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d 20 erPort]}] != 0}
16e0: 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d {..if {[info com
16f0: 6d 61 6e 64 73 20 65 78 65 63 5d 20 3d 3d 20 22 mands exec] == "
1700: 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6e 6f "} {.. set no
1710: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
1720: 20 22 63 61 6e 27 74 20 65 78 65 63 22 0a 09 20 "can't exec"..
1730: 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 set doTestsWi
1740: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
1750: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
1760: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
1770: 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 09 20 20 IP 127.0.0.1..
1780: 20 20 73 65 74 20 72 65 6d 6f 74 65 46 69 6c 65 set remoteFile
1790: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
17a0: 5d 20 72 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 20 ] remote.tcl]..
17b0: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 if {[catch {s
17c0: 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 et remoteProcCha
17d0: 6e 20 5c 0a 09 09 20 20 20 20 5b 6f 70 65 6e 20 n \... [open
17e0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
17f0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 65 6d st::tcltest $rem
1800: 6f 74 65 46 69 6c 65 20 5c 0a 09 09 20 20 20 20 oteFile \...
1810: 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 -serverIsSilent
1820: 2d 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 -port $remoteSer
1830: 76 65 72 50 6f 72 74 20 5c 0a 09 09 20 20 20 20 verPort \...
1840: 2d 61 64 64 72 65 73 73 20 24 72 65 6d 6f 74 65 -address $remote
1850: 53 65 72 76 65 72 49 50 5d 22 20 77 2b 5d 7d 20 ServerIP]" w+]}
1860: 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 msg] == 0} {...a
1870: 66 74 65 72 20 31 30 30 30 0a 09 09 69 66 20 7b fter 1000...if {
1880: 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d [catch {set comm
1890: 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a andSocket [tls::
18a0: 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 socket -cafile $
18b0: 63 61 43 65 72 74 20 5c 0a 09 09 09 2d 63 65 72 caCert \....-cer
18c0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
18d0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
18e0: 6e 74 4b 65 79 20 5c 0a 09 09 09 24 72 65 6d 6f ntKey \....$remo
18f0: 74 65 53 65 72 76 65 72 49 50 20 24 72 65 6d 6f teServerIP $remo
1900: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d teServerPort]} m
1910: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 sg] == 0} {...
1920: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f fconfigure $co
1930: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
1940: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
1950: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 uffering line...
1960: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
1970: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1980: 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 eason $msg...
1990: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
19a0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
19b0: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
19c0: 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 ...set noRemoteT
19d0: 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 estReason "$msg
19e0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
19f0: 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 est"...set doTes
1a00: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1a10: 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 er 0.. }..}.
1a20: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f } else {..fco
1a30: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
1a40: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
1a50: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
1a60: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d ing line. }.}
1a70: 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 ..# Some tests a
1a80: 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 re run only if w
1a90: 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 e are doing test
1aa0: 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 ing against a re
1ab0: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 mote server..set
1ac0: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
1ad0: 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 Constraints(doTe
1ae0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1af0: 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 ver) $doTestsWit
1b00: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 hRemoteServer.if
1b10: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
1b20: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d moteServer == 0}
1b30: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 {. if {[stri
1b40: 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 ng first s $::tc
1b50: 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 ltest::verbose]
1b60: 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 != -1} {. .pu
1b70: 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 ts "Skipping tes
1b80: 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 ts with remote s
1b90: 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 erver. See tests
1ba0: 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 /socket.test for
1bb0: 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 "..puts "informa
1bc0: 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 tion on how to r
1bd0: 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 un remote server
1be0: 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e ."..puts "Reason
1bf0: 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 for not doing r
1c00: 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f emote tests: $no
1c10: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
1c20: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 ". }.}..#.# I
1c30: 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 f we do the test
1c40: 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d s, define a comm
1c50: 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f and to send a co
1c60: 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 mmand to the.# r
1c70: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a emote server..#.
1c80: 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 .if {$doTestsWit
1c90: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
1ca0: 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 1} {. proc s
1cb0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b endCommand {c} {
1cc0: 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 ..global command
1cd0: 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f Socket...if {[eo
1ce0: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
1cf0: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1d00: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1d10: 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a isappeared"..}..
1d20: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 .if {[catch {put
1d30: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
1d40: 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 $c} msg]} {..
1d50: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
1d60: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1d70: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 ed: $msg"..}..if
1d80: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1d90: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d commandSocket "-
1da0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1db0: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d -Marker--"} msg]
1dc0: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1dd0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1de0: 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 sappeared: $msg"
1df0: 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 ..}...set resp "
1e00: 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 "..while {1} {..
1e10: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 set line [ge
1e20: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1e30: 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 t].. if {[eof
1e40: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1e50: 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d } {...error "rem
1e60: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1e70: 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 peared".. }..
1e80: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1e90: 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d compare $line "-
1ea0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1eb0: 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 -Marker--"] == 0
1ec0: 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e } {...if {[strin
1ed0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
1ee0: 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 x $resp 0] error
1ef0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1f00: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1f10: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1f20: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1f30: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1f40: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1f50: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1f60: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1f70: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 }..}. }..
1f80: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c 69 73 sendCommand [lis
1f90: 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b 69 6e t proc dputs [in
1fa0: 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d 20 5b fo args dputs] [
1fb0: 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74 73 5d info body dputs]
1fc0: 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 ].. proc send
1fd0: 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20 7b 0a CertValues {} {.
1fe0: 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20 62 65 .# We need to be
1ff0: 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20 63 65 able to send ce
2000: 72 74 69 66 69 63 61 74 65 20 76 61 6c 75 65 73 rtificate values
2010: 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a 65 0a that normalize.
2020: 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61 63 72 .# filenames acr
2030: 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a 09 73 oss platforms..s
2040: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
2050: 20 20 73 65 74 20 63 65 72 74 73 44 69 72 09 5b set certsDir.[
2060: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
2070: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 dirname [info sc
2080: 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a 09 20 ript]] certs]..
2090: 20 20 20 73 65 74 20 73 65 72 76 65 72 43 65 72 set serverCer
20a0: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
20b0: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 rtsDir server.pe
20c0: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 m].. set clie
20d0: 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 ntCert.[file joi
20e0: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 n $certsDir clie
20f0: 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 nt.pem].. set
2100: 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65 20 6a caCert..[file j
2110: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 oin $certsDir ca
2120: 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 cert.pem].. s
2130: 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 et serverKey.[fi
2140: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
2150: 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a 09 20 r server.key]..
2160: 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 set clientKey
2170: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 .[file join $cer
2180: 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 tsDir client.key
2190: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 ]..}. }.}..te
21a0: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 st tlsIO-1.1 {ar
21b0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
21c0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
21d0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
21e0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
21f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
2200: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2210: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2220: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2230: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
2240: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
2250: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2260: 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 O-1.2 {arg parsi
2270: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2280: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2290: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
22a0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
22b0: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
22c0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
22d0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
22e0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
22f0: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2300: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
2310: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2320: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
2330: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2340: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
2350: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2360: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
2370: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
2380: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2390: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
23a0: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
23b0: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
23c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 ..test tlsIO-1.4
23d0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
23e0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
23f0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2400: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2410: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
2420: 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 r 127.0.0.1} msg
2430: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2440: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
2450: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
2460: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
2470: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2480: 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 lsIO-1.5 {arg pa
2490: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
24a0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
24b0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
24c0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
24d0: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
24e0: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
24f0: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
2500: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
2510: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
2520: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
2530: 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 IO-1.6 {arg pars
2540: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2550: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2560: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2570: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2580: 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 -myport xxxx} ms
2590: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
25a0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
25b0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
25c0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
25d0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
25e0: 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 tlsIO-1.7 {arg p
25f0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2600: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2610: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2620: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2630: 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d et -myport 2522}
2640: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2650: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2660: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2670: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
2680: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2690: 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 st tlsIO-1.8 {ar
26a0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
26b0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
26c0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
26d0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
26e0: 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d ocket -froboz} m
26f0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2700: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2710: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2720: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
2730: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
2740: 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 72 67 20 tlsIO-1.9 {arg
2750: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2760: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2770: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2780: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2790: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 ket -server foo
27a0: 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 -myport 2521 333
27b0: 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 3} msg] $msg.} {
27c0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
27d0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
27e0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
27f0: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2800: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2810: 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 tlsIO-1.10 {arg
2820: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2830: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2840: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2850: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2860: 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a ket host 2528 -j
2870: 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d unk} msg] $msg.}
2880: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2890: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
28a0: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
28b0: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
28c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
28d0: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
28e0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
28f0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2900: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2910: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2920: 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 er callback 2520
2930: 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d --} msg] $msg.}
2940: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2950: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2960: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2970: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
2980: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2990: 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 t tlsIO-1.12 {ar
29a0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
29b0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
29c0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
29d0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
29e0: 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 ocket foo badpor
29f0: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
2a00: 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 1 {expected inte
2a10: 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 ger but got "bad
2a20: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2a30: 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e sIO-2.1 {tcp con
2a40: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
2a50: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
2a60: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
2a70: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2a80: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2a90: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
2aa0: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
2ab0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
2ac0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
2ad0: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
2ae0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2af0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2b00: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2b10: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
2b20: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2b30: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2b40: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2b50: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2b60: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2b70: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2b80: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2b90: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
2ba0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2bb0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
2bc0: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
2bd0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
2be0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
2bf0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
2c00: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2c10: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2c20: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2c30: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
2c40: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2c50: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2c60: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
2c70: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
2c80: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
2c90: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
2ca0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2cb0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
2cc0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2cd0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2ce0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2cf0: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
2d00: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
2d10: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
2d20: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
2d30: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2d40: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2d50: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
2d60: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
2d70: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
2d80: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
2d90: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 ady done {}}..if
2da0: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f [info exists po
2db0: 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 rt] {. incr p
2dc0: 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 0a 20 20 ort.} else { .
2dd0: 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 set port [expr
2de0: 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 $tlsServerPort
2df0: 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a + [pid]%1024].}.
2e00: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 .test tlsIO-2.2
2e10: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
2e20: 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 with client port
2e30: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
2e40: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
2e50: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
2e60: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
2e70: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
2e80: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
2e90: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
2ea0: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
2eb0: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
2ec0: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
2ed0: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
2ee0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
2ef0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
2f00: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 "set x done"].
2f10: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
2f20: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
2f30: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
2f40: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
2f50: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
2f60: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
2f70: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
2f80: 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 29 \]". puts
2f90: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
2fa0: 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 t {sock addr por
2fb0: 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 t} {.
2fc0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
2fd0: 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 puts "[get
2fe0: 73 20 24 73 6f 63 6b 5d 20 24 70 6f 72 74 22 0a s $sock] $port".
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3000: 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 e $sock.
3010: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
3020: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
3030: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
3040: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
3050: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
3060: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3070: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3080: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3090: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
30a0: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
30b0: 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 global port.
30c0: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
30d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f ls::socket -mypo
30e0: 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 65 72 rt $port \..-cer
30f0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3100: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3110: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3120: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3130: 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d 7d 20 .1 8829} sock]}
3140: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3150: 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 6c $sock..catch {cl
3160: 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ose [tls::socket
3170: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 127.0.0.1 8829]
3180: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 }. } else {.
3190: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 puts $soc
31a0: 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 k hello..flush $
31b0: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 sock. lap
31c0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
31d0: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
31e0: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
31f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3200: 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 20 x.} [list ready
3210: 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a "hello $port"]..
3220: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 7b test tlsIO-2.3 {
3230: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
3240: 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 72 ith client inter
3250: 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 face specified}
3260: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
3270: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
3280: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
3290: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
32a0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
32b0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c set auto_path [l
32c0: 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 insert $auto_pat
32d0: 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c h 0 [lindex [spl
32e0: 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b it $env(PATH) ";
32f0: 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 :"] 0]]..package
3300: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3310: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3320: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
3330: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
3340: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
3350: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3360: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
3370: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
3380: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3390: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
33a0: 79 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 y 8830 \]". p
33b0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
33c0: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
33d0: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
33e0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
33f0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3400: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 [gets $sock] $ad
3410: 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 dr".
3420: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3430: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3440: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
3450: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
3460: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
3470: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
3480: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3490: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
34a0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
34b0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
34c0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
34d0: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
34e0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
34f0: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
3500: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
3510: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3520: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3530: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3540: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 127.0.0.1 8830}
3550: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
3560: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 set x $sock.
3570: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
3580: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
3590: 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 llo..catch {flus
35a0: 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 h $sock}.
35b0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
35c0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
35d0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
35e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
35f0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b set x.} {ready {
3600: 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d hello 127.0.0.1}
3610: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3620: 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 4 {tcp connectio
3630: 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e n with server in
3640: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
3650: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
3660: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3670: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3680: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3690: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
36a0: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
36b0: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
36c0: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
36d0: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
36e0: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
36f0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3700: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3710: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3720: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3730: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3740: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3750: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3760: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3770: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3780: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3790: 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 6e rKey -myaddr [in
37a0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
37b0: 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 1 \]". puts $
37c0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
37d0: 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 {sock addr port
37e0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
37f0: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3800: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
3810: 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 $sock]".
3820: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
3840: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
3850: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3860: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3870: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3880: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3890: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
38a0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
38b0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
38c0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
38d0: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
38e0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
38f0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3900: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3910: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3920: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3930: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
3940: 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8831} sock]} {.
3950: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
3960: 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ock. } else {
3970: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
3980: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
3990: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
39a0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
39b0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
39c0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
39d0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
39e0: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c t x.} {ready hel
39f0: 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d lo}..test tlsIO-
3a00: 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.5 {tcp connect
3a10: 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 ion with redunda
3a20: 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 nt server port}
3a30: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
3a40: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
3a50: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
3a60: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
3a70: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3a80: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c set auto_path [l
3a90: 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 insert $auto_pat
3aa0: 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c h 0 [lindex [spl
3ab0: 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b it $env(PATH) ";
3ac0: 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 :"] 0]]..package
3ad0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3ae0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3af0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
3b00: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
3b10: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
3b20: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3b30: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
3b40: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
3b50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3b60: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3b70: 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 y 8832 \]". p
3b80: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3b90: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3ba0: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3bb0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3bc0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3bd0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 [gets $sock]".
3be0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3bf0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 $sock.
3c00: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
3c10: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3c20: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3c30: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3c40: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
3c50: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3c60: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3c70: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3c80: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3c90: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
3ca0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
3cb0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
3cc0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
3cd0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
3ce0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
3cf0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
3d00: 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 8832} sock]} {.
3d10: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
3d20: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
3d30: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
3d40: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
3d50: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
3d60: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
3d70: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
3d80: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3d90: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3da0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c x.} {ready hell
3db0: 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e o}.test tlsIO-2.
3dc0: 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6 {tcp connectio
3dd0: 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 n} {socket} {.
3de0: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
3df0: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
3e00: 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a {set sock [tls::
3e10: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
3e20: 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 8833]}]} {..if
3e30: 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 {![catch {gets $
3e40: 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 sock}]} {.. s
3e50: 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e et status broken
3e60: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b ..}..close $sock
3e70: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
3e80: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
3e90: 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f tlsIO-2.7 {echo
3ea0: 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e server, one lin
3eb0: 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f e} {socket stdio
3ec0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3ed0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3ee0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3ef0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3f00: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
3f10: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
3f20: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
3f30: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
3f40: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
3f50: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3f60: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3f70: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3f80: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3f90: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3fa0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3fb0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3fc0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3fd0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3fe0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3ff0: 72 4b 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 rKey 8834 \]".
4000: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
4010: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
4020: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
4030: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
4040: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
4050: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
4060: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 ure $s -translat
4070: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ion lf -bufferin
4080: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
4090: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
40a0: 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 {.. set l [g
40b0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
40c0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
40d0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
40e0: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4100: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
4110: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
4120: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
4130: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
4140: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
4150: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 $s $l.
4160: 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 }..}..puts r
4170: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
4180: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
4190: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
41a0: 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 ts done. }.
41b0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
41c0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
41d0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
41e0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
41f0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
4200: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
4210: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
4220: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4230: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4240: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4250: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 ey 127.0.0.1 883
4260: 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 4]. fconfigur
4270: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
4280: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
4290: 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 n lf. puts $s
42a0: 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 "hello abcdefgh
42b0: 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 ijklmnop". af
42c0: 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 ter 1000. set
42d0: 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 x [gets $s].
42e0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
42f0: 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t y [gets $f].
4300: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c close $f. l
4310: 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 ist $x $y.} {{he
4320: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
4330: 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 mnop} done}..tes
4340: 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 t tlsIO-2.8 {ech
4350: 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 o server, loop 5
4360: 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 0 times, single
4370: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
4380: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
4390: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
43a0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
43b0: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
43c0: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
43d0: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
43e0: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
43f0: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 20 20 TH) ";:"] 0]].
4400: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
4410: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
4420: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
4430: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
4440: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
4450: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4460: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4470: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
4480: 76 65 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a verKey 8835 \]".
4490: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
44a0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
44b0: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
44c0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
44d0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
44e0: 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 o $s].
44f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
4500: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4510: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 }..proc
4520: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
4530: 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 global i.
4540: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
4550: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
4560: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
4570: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
4580: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
4590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
45a0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
45b0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
45c0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
45d0: 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 } else { ..
45e0: 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 incr i.
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
4600: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
4610: 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 }..}..set i
4620: 20 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 0..puts ready..
4630: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
4640: 20 32 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 20000 "set x do
4650: 6e 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 ne"]..vwait x..a
4660: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
4670: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
4680: 74 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 ts "done $i".
4690: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
46a0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
46b0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
46c0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
46d0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
46e0: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
46f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
4700: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4710: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4720: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
4730: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
4740: 31 20 38 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 1 8835]. fcon
4750: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4760: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 ring line. ca
4770: 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 tch {..for {set
4780: 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b x 0} {$x < 50} {
4790: 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 incr x} {.. p
47a0: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 uts $s "hello ab
47b0: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a cdefghijklmnop".
47c0: 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a . gets $s..}.
47d0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
47e0: 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 $s. catch {se
47f0: 74 20 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 t x [gets $f]}.
4800: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4810: 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 set x.} {done 50
4820: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
4830: 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 9 {socket confli
4840: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
4850: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b o} {. set s [
4860: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4870: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
4880: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4890: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
48a0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
48b0: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
48c0: 6c 69 6e 65 20 24 66 20 7b 0a 09 73 65 74 20 61 line $f {..set a
48d0: 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 uto_path [linser
48e0: 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b t $auto_path 0 [
48f0: 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 lindex [split $e
4900: 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 nv(PATH) ";:"] 0
4910: 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 ]]..package requ
4920: 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f ire tls..tls::so
4930: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4940: 65 70 74 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 ept 8828. }.
4950: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4960: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4970: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4980: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4990: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
49a0: 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 after 100.
49b0: 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 set x [list [c
49c0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 atch {close $f}
49d0: 6d 73 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e msg] [string ran
49e0: 67 65 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 ge $msg 0 43]].
49f0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
4a00: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
4a10: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
4a20: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
4a30: 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 y in use}}..test
4a40: 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f tlsIO-2.10 {clo
4a50: 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 se on accept, ac
4a60: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 cepted socket li
4a70: 76 65 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ves} {socket} {.
4a80: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
4a90: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
4aa0: 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 64 ter 20000 "set d
4ab0: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
4ac0: 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a set ss [tls:
4ad0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4ae0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
4af0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
4b00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4b10: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
4b20: 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 20 70 72 Key 8830]. pr
4b30: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
4b40: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 } {..global ss..
4b50: 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 close $ss..filee
4b60: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
4b70: 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 "readit $s"..fc
4b80: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
4b90: 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 ns lf. }.
4ba0: 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 proc readit {s}
4bb0: 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 {..global done..
4bc0: 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 gets $s..close $
4bd0: 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 s..set done 1.
4be0: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b }. set cs [
4bf0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
4c00: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
4c10: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4c20: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
4c30: 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 lientKey [info h
4c40: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 ostname] 8830].
4c50: 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 close $cs..
4c60: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
4c70: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
4c80: 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e imer. set don
4c90: 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 e.} 1..test tlsI
4ca0: 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e O-2.11 {detectin
4cb0: 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 g new data} {soc
4cc0: 6b 65 74 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 ket} {. proc
4cd0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4ce0: 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 ..global sock..#
4cf0: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
4d00: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
4d10: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
4d20: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 th sides need..#
4d30: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
4d40: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
4d50: 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f handshake. Also
4d60: 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f make sure..# to
4d70: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
4d80: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
4d90: 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f ering mode...fco
4da0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
4db0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
4dc0: 67 20 6c 69 6e 65 0a 09 73 65 74 20 73 6f 63 6b g line..set sock
4dd0: 20 24 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $s..fileevent $
4de0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
4df0: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
4e00: 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 ]. }.. set
4e10: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
4e20: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
4e30: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
4e40: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
4e50: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
4e60: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
4e70: 38 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 8400]. set so
4e80: 63 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 ck "". set s2
4e90: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4ea0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4eb0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4ec0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4ed0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
4ee0: 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 23 .0.1 8400]. #
4ef0: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
4f00: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
4f10: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
4f20: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 th sides need.
4f30: 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c # to be non-bl
4f40: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
4f50: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c LS handshake Al
4f60: 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a so make sure to.
4f70: 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 # return the
4f80: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 channel to line
4f90: 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 buffering mode
4fa0: 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 (TLS sets it to
4fb0: 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 'none').. fco
4fc0: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 6c 6f nfigure $s2 -blo
4fd0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
4fe0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 ng line. vwai
4ff0: 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 t sock. puts
5000: 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 $s2 one. flus
5010: 68 20 24 73 32 0a 20 20 20 20 23 20 6e 65 65 64 h $s2. # need
5020: 20 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c update to compl
5030: 65 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b ete TLS handshak
5040: 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 e in-process.
5050: 20 75 70 64 61 74 65 0a 20 20 20 20 61 66 74 65 update. afte
5060: 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 r 500. fconfi
5070: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
5080: 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 king 0. set r
5090: 65 73 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 73 esult a:[gets $s
50a0: 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 ock]. lappend
50b0: 20 72 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 20 result b:[gets
50c0: 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 $sock]. fconf
50d0: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
50e0: 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 cking 1. puts
50f0: 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 $s2 two. flu
5100: 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 sh $s2. fconf
5110: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
5120: 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 cking 0. lapp
5130: 65 6e 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 65 end result c:[ge
5140: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
5150: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
5160: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 blocking 1. c
5170: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
5180: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
5190: 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 $sock. set re
51a0: 73 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a sult.} {a:one b:
51b0: 20 63 3a 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c c:two}..test tl
51c0: 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f sIO-2.12 {tcp co
51d0: 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 nnection; no cer
51e0: 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 66 tificates specif
51f0: 69 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ied} \..{socket
5200: 73 74 64 69 6f 20 75 6e 69 78 4f 6e 6c 79 7d 20 stdio unixOnly}
5210: 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 69 73 {. # There is
5220: 20 61 20 64 65 62 75 67 20 61 73 73 65 72 74 69 a debug asserti
5230: 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 on on Windows/SS
5240: 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 61 20 L that causes a
5250: 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20 crash when the.
5260: 20 20 20 23 20 63 65 72 74 69 66 69 63 61 74 65 # certificate
5270: 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 65 64 isn't specified
5280: 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 .. removeFile
5290: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
52a0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
52b0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
52c0: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
52d0: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
52e0: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
52f0: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
5300: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
5310: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
5320: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
5330: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
5340: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b d_out"]..set f [
5350: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5360: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
5370: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 ..proc accept {f
5380: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ile addr port} {
5390: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
53a0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
53b0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
53c0: 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 $file..}..puts
53d0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
53e0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
53f0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
5400: 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 uts $x. }.
5410: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5420: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
5430: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5440: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5450: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
5460: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
5470: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
5480: 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 0.0.1 8828} msg]
5490: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
54a0: 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 x $msg. } els
54b0: 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 e {. lapp
54c0: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
54d0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d close $m
54e0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
54f0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
5500: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5510: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
5520: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 done {}}..test
5530: 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 tlsIO-3.1 {socke
5540: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
5550: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
5560: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5570: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5580: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5590: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
55a0: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
55b0: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
55c0: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
55d0: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
55e0: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
55f0: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
5600: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
5610: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
5620: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
5630: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
5640: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5650: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
5660: 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d erverKey 8828 \]
5670: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
5680: 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 .puts ready..get
5690: 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 s stdin..close $
56a0: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
56b0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
56c0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
56d0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
56e0: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
56f0: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
5700: 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 t x [list [catch
5710: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a {tls::socket \.
5720: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5730: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5740: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5750: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5760: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
5770: 63 65 70 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 cept 8828} msg]
5780: 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 \...$msg]. pu
5790: 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c ts $f bye. cl
57a0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
57b0: 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 .} {1 {couldn't
57c0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
57d0: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
57e0: 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 use}}..test tlsI
57f0: 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 O-3.2 {server wi
5800: 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e th several clien
5810: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ts} {socket stdi
5820: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
5830: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5840: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5850: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5860: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
5870: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
5880: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
5890: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
58a0: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 ) ";:"] 0]]..pac
58b0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
58c0: 0a 09 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 ..set t1 [after
58d0: 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 30000 "set x tim
58e0: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 ed_out"]..set t2
58f0: 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 [after 31000 "s
5900: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
5910: 0a 09 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 ..set t3 [after
5920: 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 32000 "set x tim
5930: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f ed_out"]..set co
5940: 75 6e 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 unter 0. }.
5950: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 73 puts $f "set s
5960: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
5970: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
5980: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
5990: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
59a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
59b0: 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 rverKey 8828 \]"
59c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
59d0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
59e0: 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 p} {.. filee
59f0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
5a00: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
5a10: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5a20: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
5a30: 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f ne..}..proc echo
5a40: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
5a50: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
5a60: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
5a70: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
5a80: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5aa0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 close $s.
5ab0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
5ac0: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
5ad0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
5ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
5af0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
5b00: 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 }..}..puts
5b10: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
5b20: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
5b30: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
5b40: 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 cancel $t2..vwa
5b50: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
5b60: 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 el $t3..close $s
5b70: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
5b80: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5b90: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
5ba0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5bb0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5bc0: 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 " r+]. set x
5bd0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 [gets $f]. se
5be0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
5bf0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
5c00: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
5c10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5c20: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
5c30: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
5c40: 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 0.1 8828]. fc
5c50: 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 onfigure $s1 -bu
5c60: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5c70: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
5c80: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5c90: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5ca0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5cb0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5cc0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
5cd0: 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 .0.0.1 8828].
5ce0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
5cf0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5d00: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
5d10: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
5d20: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
5d30: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5d40: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
5d50: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
5d60: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 127.0.0.1 8828].
5d70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5d80: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
5d90: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
5da0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
5db0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
5dc0: 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 $s1 hello,s1..g
5dd0: 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 ets $s1..puts $s
5de0: 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 2 hello,s2..gets
5df0: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
5e00: 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 ello,s3..gets $s
5e10: 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 3. }. clos
5e20: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
5e30: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
5e40: 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 3. lappend x
5e50: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c [gets $f]. cl
5e60: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
5e70: 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a .} {ready done}.
5e80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 .test tlsIO-4.1
5e90: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
5ea0: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
5eb0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
5ec0: 20 20 20 23 20 68 61 76 65 20 73 65 65 6e 20 69 # have seen i
5ed0: 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 ntermittent hang
5ee0: 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 s on Windows.
5ef0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5f00: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5f10: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5f20: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
5f30: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
5f40: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
5f50: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
5f60: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
5f70: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
5f80: 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 uire tls..gets s
5f90: 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 tdin. }. p
5fa0: 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b uts $f "set s \[
5fb0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
5fc0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5fd0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5fe0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5ff0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
6000: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
6010: 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 s $f {..fconfigu
6020: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
6030: 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 line..for {set
6040: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
6050: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 {incr i} {..
6060: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 puts $s hello..
6070: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 gets $s..}..c
6080: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 lose $s..puts by
6090: 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 e..gets stdin.
60a0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
60b0: 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 . set p1 [ope
60c0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
60d0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
60e0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
60f0: 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 configure $p1 -b
6100: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
6110: 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 set p2 [open "
6120: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6130: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6140: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e t]" r+]. fcon
6150: 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 figure $p2 -buff
6160: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
6170: 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c et p3 [open "|[l
6180: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6190: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
61a0: 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 r+]. fconfig
61b0: 75 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 ure $p3 -bufferi
61c0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 ng line. proc
61d0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
61e0: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
61f0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
6200: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
6210: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
6220: 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 ho $s]. }.
6230: 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b proc echo {s} {
6240: 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 ..global x.
6250: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
6260: 73 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b s]. if {[
6270: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
6280: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
6290: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
62a0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d x done. }
62b0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
62c0: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
62d0: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 }. }.
62e0: 20 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 set t1 [after
62f0: 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 30000 "set x ti
6300: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
6310: 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 t t2 [after 3100
6320: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6330: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 ut"]. set t3
6340: 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 [after 32000 "se
6350: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
6360: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6370: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
6380: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6390: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
63a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
63b0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
63c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
63d0: 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 28]. puts $p1
63e0: 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 open. puts $
63f0: 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 p2 open. puts
6400: 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 $p3 open. vw
6410: 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 ait x. vwait
6420: 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 x. vwait x.
6430: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6440: 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e t1. after can
6450: 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 74 65 cel $t2. afte
6460: 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 r cancel $t3.
6470: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
6480: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6490: 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 nd l [list p1 [g
64a0: 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 ets $p1] $x].
64b0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 lappend l [list
64c0: 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d 20 24 p2 [gets $p2] $
64d0: 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c x]. lappend l
64e0: 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 73 20 [list p3 [gets
64f0: 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 $p3] $x]. put
6500: 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 70 75 s $p1 bye. pu
6510: 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 20 70 ts $p2 bye. p
6520: 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 20 20 uts $p3 bye.
6530: 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 63 6c close $p1. cl
6540: 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 ose $p2. clos
6550: 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 6c 0a e $p3. set l.
6560: 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d } {{p1 bye done}
6570: 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b {p2 bye done} {
6580: 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 p3 bye done}}..t
6590: 65 73 74 20 74 6c 73 49 4f 2d 34 2e 32 20 7b 62 est tlsIO-4.2 {b
65a0: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
65b0: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
65c0: 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b rs, htons} {sock
65d0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 et} {. set x
65e0: 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 ok. if {[catc
65f0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
6600: 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 server dodo 0x30
6610: 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 00} msg]} {..set
6620: 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c x $msg. } el
6630: 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 se {..close $msg
6640: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
6650: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
6660: 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 O-5.1 {byte orde
6670: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
6680: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
6690: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e s} \..{socket un
66a0: 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 ixOnly notRoot}
66b0: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 {. set x {cou
66c0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
66d0: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 t: not owner}.
66e0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 if {![catch {t
66f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6700: 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 er dodo 0x1} msg
6710: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
6720: 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 x {htons proble
6730: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6740: 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 allowed, are you
6750: 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d running as SU?}
6760: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
6770: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
6780: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
6790: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
67a0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 .test tlsIO-5.2
67b0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
67c0: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
67d0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f bers, htons} {so
67e0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
67f0: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
6800: 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 socket: port nu
6810: 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 mber too high}.
6820: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
6830: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6840: 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 30 30 ver dodo 0x10000
6850: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
6860: 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f {port resolutio
6870: 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c n problem, shoul
6880: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d d be disallowed}
6890: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
68a0: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
68b0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
68c0: 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 cket: port numbe
68d0: 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 r too high}.test
68e0: 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 65 tlsIO-5.3 {byte
68f0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
6900: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
6910: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
6920: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
6930: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
6940: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
6950: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
6960: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
6970: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
6980: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 32 31 7d -server dodo 21}
6990: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 msg]} {..set x
69a0: 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 {htons problem,
69b0: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
69c0: 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 owed, are you ru
69d0: 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 nning as SU?}..c
69e0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
69f0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
6a00: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
6a10: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 t: not owner}..t
6a20: 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 est tlsIO-6.1 {a
6a30: 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 ccept callback e
6a40: 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 73 74 rror} {socket st
6a50: 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 dio} {. # The
6a60: 72 65 20 69 73 20 61 20 64 65 62 75 67 20 61 73 re is a debug as
6a70: 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f sertion on Windo
6a80: 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 ws/SSL that caus
6a90: 65 73 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 es a crash when
6aa0: 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 the. # certif
6ab0: 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 icate isn't spec
6ac0: 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 ified.. remov
6ad0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
6ae0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
6af0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
6b00: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
6b10: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
6b20: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
6b30: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
6b40: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 20 20 TH) ";:"] 0]].
6b50: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
6b60: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
6b70: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
6b80: 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a s $f [list tls::
6b90: 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 socket -cafile $
6ba0: 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 caCert 127.0.0.1
6bb0: 20 38 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 8848]. close
6bc0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
6bd0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6be0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6bf0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6c00: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
6c10: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
6c20: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
6c30: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
6c40: 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 t {s a p} {expr
6c50: 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 10 / 0}. set
6c60: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
6c70: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
6c80: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6c90: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6ca0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6cb0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
6cc0: 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 848]. puts $f
6cd0: 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 hello. close
6ce0: 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $f. set time
6cf0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
6d00: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6d10: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
6d20: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6d30: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6d40: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
6d50: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
6d60: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
6d70: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c zero}}..test tl
6d80: 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 sIO-7.1 {testing
6d90: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6da0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6db0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
6dc0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
6dd0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6de0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
6df0: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
6e00: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
6e10: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
6e20: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
6e30: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
6e40: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
6e50: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
6e60: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 puts $f [list t
6e70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6e80: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 er accept \..
6e90: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
6ea0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6eb0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6ec0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 30 5d $serverKey 8820]
6ed0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6ee0: 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 proc accept args
6ef0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
6f00: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
6f10: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
6f20: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
6f30: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
6f40: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 imed_out"]..vwai
6f50: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
6f60: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
6f70: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6f80: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6f90: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6fa0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6fb0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
6fc0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6fd0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
6fe0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
6ff0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7000: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
7010: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
7020: 32 37 2e 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 27.0.0.1 8820].
7030: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
7040: 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d gure $s -peernam
7050: 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e]. close $s.
7060: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
7070: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
7080: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
7090: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
70a0: 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d $p 0] 127.0.0.1]
70b0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
70c0: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
70d0: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 lindex $p 2] 882
70e0: 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 0]. lappend l
70f0: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 [llength $p].}
7100: 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 20 74 6c {0 0 3}..test tl
7110: 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 sIO-7.2 {testing
7120: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
7130: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
7140: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
7150: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
7160: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
7170: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
7180: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
7190: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
71a0: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
71b0: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
71c0: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
71d0: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
71e0: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
71f0: 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 puts $f "tls::s
7200: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
7210: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
7220: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7230: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7240: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
7250: 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 821". puts $f
7260: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
7270: 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 args {.. glob
7280: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
7290: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
72a0: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
72b0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
72c0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
72d0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
72e0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
72f0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
7300: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
7310: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
7320: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
7330: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
7340: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
7350: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
7360: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
7370: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
7380: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7390: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
73a0: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
73b0: 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 1]. set p [fc
73c0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 onfigure $s -soc
73d0: 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 kname]. close
73e0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $s. close $f
73f0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
7400: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 lappend l [lle
7410: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 ngth $p]. lap
7420: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
7430: 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 p 0]. lappend
7440: 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c l [string equal
7450: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 [lindex $p 2] 8
7460: 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 821].} {3 127.0.
7470: 30 2e 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 0.1 0}..test tls
7480: 49 4f 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 IO-7.3 {testing
7490: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
74a0: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
74b0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
74c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
74d0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
74e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
74f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7500: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
7510: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
7520: 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 22]. set l [l
7530: 6c 65 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 length [fconfigu
7540: 72 65 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 re $s]]. clos
7550: 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a e $s. update.
7560: 20 20 20 20 23 20 41 20 62 75 67 20 66 69 78 65 # A bug fixe
7570: 64 20 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 d in fconfigure
7580: 66 6f 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 for 8.3.4+ make
7590: 74 68 69 73 20 72 65 74 75 72 6e 20 31 34 20 6e this return 14 n
75a0: 6f 72 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 ormally,. # b
75b0: 75 74 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 ut 12 in older v
75c0: 65 72 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 ersions.. exp
75d0: 72 20 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 r {$l >= 12 && (
75e0: 28 24 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a ($l % 2) == 0)}.
75f0: 7d 20 31 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 } 1..# bug repor
7600: 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 t #5812 fconfigu
7610: 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 re doesn't retur
7620: 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f n value for '-so
7630: 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c ckname'..test tl
7640: 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 sIO-7.4 {testing
7650: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
7660: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
7670: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
7680: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
7690: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
76a0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
76b0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
76c0: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
76d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
76e0: 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 823]. proc ac
76f0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7700: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
7710: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
7720: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
7730: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
7740: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
7750: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
7760: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7770: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7780: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7790: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
77a0: 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 name] 8823].
77b0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
77c0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
77d0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
77e0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
77f0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
7800: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7810: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7820: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
7830: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 d l [lindex $x 2
7840: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
7850: 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 {8823 3}..# bug
7860: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
7870: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
7880: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
7890: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
78a0: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 est tlsIO-7.5 {t
78b0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
78c0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
78d0: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 {socket unixOrPc
78e0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
78f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
7900: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
7910: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7920: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7930: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
7940: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
7950: 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 t 8829]. proc
7960: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7970: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
7980: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
7990: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
79a0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
79b0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
79c0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
79d0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
79e0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
79f0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7a00: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
7a10: 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 .0.0.1 8829].
7a20: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
7a30: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
7a40: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
7a50: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
7a60: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
7a70: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
7a80: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
7a90: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
7aa0: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 nd l [lindex $x
7ab0: 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 0] [lindex $x 2]
7ac0: 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 [llength $x].}
7ad0: 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 {127.0.0.1 8829
7ae0: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 3}..test tlsIO-8
7af0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 .1 {testing -asy
7b00: 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 nc flag on socke
7b10: 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ts} {socket} {.
7b20: 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 # NOTE: This
7b30: 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e test may fail on
7b40: 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e some Solaris 2.
7b50: 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 20 20 23 4 systems.. #
7b60: 20 53 65 65 20 6e 6f 74 65 73 20 69 6e 20 54 63 See notes in Tc
7b70: 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 73 74 2e l's socket.test.
7b80: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7b90: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7ba0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7bb0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7bc0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7bd0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
7be0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
7bf0: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
7c00: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7c10: 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 6e global x..# when
7c20: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
7c30: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
7c40: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
7c50: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
7c60: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
7c70: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
7c80: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
7c90: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
7ca0: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
7cb0: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
7cc0: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
7cd0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
7ce0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
7cf0: 65 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 e..puts $s bye..
7d00: 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 30 # Only OpenSSL 0
7d10: 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 73 .9.5a on Windows
7d20: 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 74 seems to need t
7d30: 68 65 20 61 66 74 65 72 20 28 64 65 6c 61 79 65 he after (delaye
7d40: 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 74 d)..# close, but
7d50: 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 74 it works just t
7d60: 68 65 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c 20 he same for all
7d70: 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a 09 others. -hobbs..
7d80: 61 66 74 65 72 20 35 30 30 20 63 6c 6f 73 65 20 after 500 close
7d90: 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 $s..set x done.
7da0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
7db0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7dc0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
7dd0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7de0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7df0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7e00: 09 20 20 20 20 2d 61 73 79 6e 63 20 5b 69 6e 66 . -async [inf
7e10: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 o hostname] 8830
7e20: 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 ]. # when doi
7e30: 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 ng an in-process
7e40: 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 client/server t
7e50: 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 est, both sides
7e60: 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 need. # to be
7e70: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f non-blocking fo
7e80: 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 r the TLS handsh
7e90: 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 ake Also make s
7ea0: 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 ure to. # ret
7eb0: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
7ec0: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
7ed0: 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 g mode (TLS sets
7ee0: 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a it to 'none')..
7ef0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7f00: 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d s1 -blocking 0 -
7f10: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
7f20: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 23 vwait x. #
7f30: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 TLS handshaking
7f40: 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 74 65 20 needs one byte
7f50: 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 6e 74 2e from the client.
7f60: 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 73 31 20 ... puts $s1
7f70: 61 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 a. # need upd
7f80: 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 ate to complete
7f90: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e TLS handshake in
7fa0: 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 -process. upd
7fb0: 61 74 65 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 ate. set z [g
7fc0: 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f ets $s1]. clo
7fd0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
7fe0: 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 $s1. set z.}
7ff0: 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d bye..test tlsIO-
8000: 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 9.1 {testing spu
8010: 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 rious events} {s
8020: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
8030: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 len 0. set s
8040: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 purious 0. se
8050: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
8060: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d c readlittle {s}
8070: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 {..global spuri
8080: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 ous done len..se
8090: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a t l [read $s 1].
80a0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e .if {[string len
80b0: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a gth $l] == 0} {.
80c0: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 . if {![eof $
80d0: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 s]} {...incr spu
80e0: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 rious.. } els
80f0: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 e {...close $s..
8100: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 .set done 1..
8110: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
8120: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 incr len [stri
8130: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d ng length $l]..}
8140: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
8150: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8160: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
8170: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c -blocking 0..fil
8180: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
8190: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
81a0: 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c shake $s readabl
81b0: 65 20 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 e readlittle \..
81c0: 09 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 .-buffering none
81d0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 ]. }. set
81e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
81f0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8200: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8210: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8220: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8230: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
8240: 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 ccept 8831].
8250: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
8260: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8270: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
8280: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8290: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
82a0: 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f Key \.. [info
82b0: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d hostname] 8831]
82c0: 0a 20 20 20 20 23 20 54 68 69 73 20 64 69 66 66 . # This diff
82d0: 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b 65 74 2d ers from socket-
82e0: 39 2e 31 20 69 6e 20 74 68 61 74 20 62 6f 74 68 9.1 in that both
82f0: 20 73 69 64 65 73 20 6e 65 65 64 20 74 6f 20 62 sides need to b
8300: 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 6c 6f 63 e. # non-bloc
8310: 6b 69 6e 67 20 62 65 63 61 75 73 65 20 6f 66 20 king because of
8320: 54 4c 53 27 20 72 65 71 75 69 72 65 64 20 68 61 TLS' required ha
8330: 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 63 6f 6e ndshake. fcon
8340: 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b figure $c -block
8350: 69 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 2d ing 0. puts -
8360: 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 nonewline $c 012
8370: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
8380: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
8390: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 567890123456789.
83a0: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
83b0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
83c0: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
83d0: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
83e0: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
83f0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
8400: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
8410: 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 s. list $spur
8420: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 ious $len.} {0 5
8430: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 0}..test tlsIO-9
8440: 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e .2 {testing asyn
8450: 63 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 65 c write, fileeve
8460: 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c nts, flush on cl
8470: 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ose} {socket} {.
8480: 20 20 20 20 73 65 74 20 66 69 72 73 74 62 6c 6f set firstblo
8490: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 ck [string repea
84a0: 74 20 61 20 33 31 5d 0a 20 20 20 20 73 65 74 20 t a 31]. set
84b0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 secondblock [str
84c0: 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 35 ing repeat b 655
84d0: 33 35 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 35]. proc acc
84e0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
84f0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
8500: 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 ocking 0..fileev
8510: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
8520: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
8530: 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 ke $s readable r
8540: 65 61 64 61 62 6c 65 20 5c 0a 09 09 2d 74 72 61 eadable \...-tra
8550: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
8560: 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 2d 62 fersize 16384 -b
8570: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 20 uffering line].
8580: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
8590: 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 adable {s} {..se
85a0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 64 t l [gets $s]..d
85b0: 70 75 74 73 20 22 67 6f 74 20 5c 22 5b 73 74 72 puts "got \"[str
85c0: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 6c 20 31 ing replace $l 1
85d0: 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0 end-3 ...]\" \
85e0: 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 ...([string leng
85f0: 74 68 20 24 6c 5d 29 20 66 72 6f 6d 20 24 73 22 th $l]) from $s"
8600: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
8610: 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 eadable {}..afte
8620: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 r 1000 respond $
8630: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
8640: 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 respond {s} {..
8650: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
8660: 6b 0a 09 64 70 75 74 73 20 22 73 65 6e 64 20 5c k..dputs "send \
8670: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8680: 20 24 66 69 72 73 74 62 6c 6f 63 6b 20 31 30 20 $firstblock 10
8690: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
86a0: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
86b0: 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d 29 20 64 $firstblock]) d
86c0: 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e own $s"..puts -n
86d0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 onewline $s $fir
86e0: 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 72 20 31 stblock..after 1
86f0: 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73 000 writedata $s
8700: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
8710: 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a writedata {s} {.
8720: 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c .global secondbl
8730: 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e 64 ock..dputs "send
8740: 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 \"[string repla
8750: 63 65 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 ce $secondblock
8760: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8770: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8780: 67 74 68 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b gth $secondblock
8790: 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 ]) down $s"..put
87a0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
87b0: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c $secondblock..cl
87c0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
87d0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
87e0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
87f0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
8800: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8810: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
8820: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
8830: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 32 5d ver accept 8832]
8840: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8850: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
8860: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
8870: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8880: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
8890: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
88a0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
88b0: 38 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8832]. fconfi
88c0: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
88d0: 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 g 0 -trans lf -b
88e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
88f0: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
8900: 20 20 70 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a puts $c hello.
8910: 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 proc readit
8920: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
8930: 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 unt done..set da
8940: 74 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 ta [read $s]..dp
8950: 75 74 73 20 22 72 65 61 64 20 5c 22 5b 73 74 72 uts "read \"[str
8960: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 64 61 74 ing replace $dat
8970: 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c a 10 end-3 ...]\
8980: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
8990: 65 6e 67 74 68 20 24 64 61 74 61 5d 29 20 66 72 ength $data]) fr
89a0: 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 om $s"..incr cou
89b0: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 nt [string lengt
89c0: 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 h $data]..if {[e
89d0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 of $s]} {.. c
89e0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 lose $s.. set
89f0: 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d done 1..}. }
8a00: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
8a10: 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 c readable "read
8a20: 69 74 20 24 63 22 0a 20 20 20 20 73 65 74 20 64 it $c". set d
8a30: 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 one 0. set ti
8a40: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
8a50: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
8a60: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
8a70: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
8a80: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
8a90: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c close $s. l
8aa0: 69 73 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 ist $count $done
8ab0: 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 .} {65566 1}..te
8ac0: 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 st tlsIO-9.3 {te
8ad0: 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 sting EOF sticky
8ae0: 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e ness} {unexplain
8af0: 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 edFailure socket
8b00: 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a } {. # HOBBS:
8b10: 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 6f never worked co
8b20: 72 72 65 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 rrectly. proc
8b30: 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 count_to_eof {s
8b40: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
8b50: 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 t done timer..se
8b60: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 t l [gets $s]..i
8b70: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
8b80: 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 incr count..
8b90: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e if {$count >
8ba0: 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 9} {...close $s
8bb0: 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 ...set done true
8bc0: 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f ...set count {eo
8bd0: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 f is sticky}...a
8be0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
8bf0: 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 er.. }..}.
8c00: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
8c10: 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 rproc {} {..glob
8c20: 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a al done count c.
8c30: 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 .set done true..
8c40: 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 set count {timer
8c50: 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 went off, eof i
8c60: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
8c70: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 lose $c. }..
8c80: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
8c90: 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 set done fals
8ca0: 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 e. proc write
8cb0: 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 _then_close {s}
8cc0: 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 {..puts $s bye..
8cd0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
8ce0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8cf0: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
8d00: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
8d10: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
8d20: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8d30: 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 lf..fileevent $
8d40: 73 20 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 s writable [list
8d50: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
8d60: 20 77 72 69 74 61 62 6c 65 20 77 72 69 74 65 5f writable write_
8d70: 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d then_close \...-
8d80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
8d90: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a translation lf].
8da0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
8db0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8dc0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
8dd0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8de0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8df0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8e00: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
8e10: 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 ept 8833]. se
8e20: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8e30: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8e40: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8e50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8e60: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8e70: 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 y \.. [info h
8e80: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 33 5d 0a 20 ostname] 8833].
8e90: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
8ea0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
8eb0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8ec0: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
8ed0: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
8ee0: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f adable "count_to
8ef0: 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 _eof $c". set
8f00: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
8f10: 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 00 timerproc].
8f20: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8f30: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
8f40: 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 t count.} {eof i
8f50: 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 s sticky}..remov
8f60: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 eFile script..te
8f70: 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 st tlsIO-10.1 {t
8f80: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 esting socket ac
8f90: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
8fa0: 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 ror handling} {s
8fb0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
8fc0: 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 goterror 0.
8fd0: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
8fe0: 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 s {global goterr
8ff0: 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 or; set goterror
9000: 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 1}. set s [t
9010: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 ls::socket -cafi
9020: 6c 65 20 24 63 61 43 65 72 74 20 2d 73 65 72 76 le $caCert -serv
9030: 65 72 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a er accept 8898].
9040: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
9050: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
9060: 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 s; error}. se
9070: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
9080: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9090: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 127.0.0.1 8898]
90a0: 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 . vwait goter
90b0: 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 ror. close $s
90c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 . close $c.
90d0: 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d set goterror.}
90e0: 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 1..test tlsIO-1
90f0: 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 1.1 {tcp connect
9100: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ion} {socket doT
9110: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9120: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
9130: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
9140: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9150: 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 t socket9_1_test
9160: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
9170: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9180: 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ept \...-certfil
9190: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
91a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
91b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
91c0: 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 y 8834]..proc ac
91d0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
91e0: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
91f0: 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 ke $s.. puts
9200: 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f $s done.. clo
9210: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
9220: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
9230: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9240: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9250: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9260: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9270: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9280: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9290: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
92a0: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
92b0: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
92c0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
92d0: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
92e0: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
92f0: 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f done..test tlsIO
9300: 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 -11.2 {client sp
9310: 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 ecifies its port
9320: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9330: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9340: 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e r} {. if {[in
9350: 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d fo exists port]}
9360: 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 {..incr port.
9370: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
9380: 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 port [expr {$tls
9390: 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 ServerPort + [pi
93a0: 64 5d 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a d]%1024}]. }.
93b0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
93c0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
93d0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
93e0: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
93f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
9400: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
9410: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9420: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9430: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9440: 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 5d 0a serverKey 8835].
9450: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9460: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
9470: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
9480: 20 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 puts $s $p..
9490: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
94a0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
94b0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
94c0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
94d0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
94e0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
94f0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9500: 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 -myport $por
9510: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
9520: 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 P 8835]. set
9530: 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 r [gets $s].
9540: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
9550: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9560: 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f $socket9_2_test_
9570: 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b server}. if {
9580: 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 $r == $port} {..
9590: 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 set result ok.
95a0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
95b0: 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 result broken.
95c0: 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 }. set resu
95d0: 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c lt.} ok..test tl
95e0: 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 sIO-11.3 {trying
95f0: 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 to connect, no
9600: 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 server} {socket
9610: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
9620: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
9630: 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 et status ok.
9640: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 if {![catch {se
9650: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
9660: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9670: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9680: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9690: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
96a0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
96b0: 53 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d ServerIp 8836]}]
96c0: 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 } {..if {![catch
96d0: 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 {gets $s}]} {..
96e0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 set status b
96f0: 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 roken..}..close
9700: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
9710: 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 status.} ok..te
9720: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 st tlsIO-11.4 {r
9730: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 emote echo, one
9740: 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f line} {socket do
9750: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9760: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9770: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9780: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9790: 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 et socket10_6_te
97a0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
97b0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
97c0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
97d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
97e0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
97f0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
9800: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
9810: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9820: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
9830: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
9840: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
9850: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
9860: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
9870: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
9880: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
9890: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
98a0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
98b0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
98c0: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
98d0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
98e0: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
98f0: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
9900: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
9910: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
9920: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9930: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9940: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9950: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9960: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9970: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9980: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9990: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
99a0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
99b0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
99c0: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
99d0: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
99e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
99f0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9a00: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
9a10: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9a20: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
9a30: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
9a40: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
9a50: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
9a60: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9a70: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9a80: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9a90: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9aa0: 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 et socket10_7_te
9ab0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9ac0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9ad0: 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 ccept \...-certf
9ae0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
9af0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9b00: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
9b10: 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 Key 8836]..proc
9b20: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
9b30: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
9b40: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c hake $s.. fil
9b50: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9b60: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
9b70: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
9b80: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
9b90: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
9ba0: 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 n crlf..}..proc
9bb0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
9bc0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
9bd0: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
9be0: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
9bf0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
9c00: 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 puts $s $l..
9c10: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 }..}. }. s
9c20: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
9c30: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9c40: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9c50: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9c60: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9c70: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9c80: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
9c90: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9ca0: 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 f -translation c
9cb0: 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c rlf -buffering l
9cc0: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
9cd0: 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 cnt 0} {$cnt <
9ce0: 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 50} {incr cnt} {
9cf0: 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f ..puts $f "hello
9d00: 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 , $cnt"..if {[st
9d10: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 ring compare [ge
9d20: 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 ts $f] "hello, $
9d30: 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 cnt"] != 0} {..
9d40: 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 break..}.
9d50: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
9d60: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9d70: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
9d80: 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 7_test_server}.
9d90: 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a set cnt.} 50.
9da0: 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 .# Macintosh soc
9db0: 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f kets can have mo
9dc0: 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 re than one serv
9dd0: 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b er per port.if {
9de0: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c $tcl_platform(pl
9df0: 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 atform) == "maci
9e00: 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 ntosh"} {. se
9e10: 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 t conflictResult
9e20: 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 {0 8836}.} else
9e30: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
9e40: 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f ictResult {1 {co
9e50: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
9e60: 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 et: address alre
9e70: 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a ady in use}}.}..
9e80: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 test tlsIO-11.6
9e90: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
9ea0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9eb0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9ec0: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 r} {. set s1
9ed0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9ee0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
9ef0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9f00: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9f10: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9f20: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
9f30: 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 ept 8836]. if
9f40: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 {[catch {set s2
9f50: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9f60: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9f70: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9f80: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9f90: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
9fa0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
9fb0: 63 65 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d cept 8836]} msg]
9fc0: 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 } {..set result
9fd0: 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 [list 1 $msg].
9fe0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
9ff0: 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b result [list 0 [
a000: 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 lindex [fconfigu
a010: 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 re $s2 -sockname
a020: 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 ] 2]]..close $s2
a030: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
a040: 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 $s1. set res
a050: 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 ult.} $conflictR
a060: 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 esult..test tlsI
a070: 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 O-11.7 {server w
a080: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
a090: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nts} {socket doT
a0a0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
a0b0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
a0c0: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
a0d0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
a0e0: 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 t socket10_9_tes
a0f0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
a100: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
a110: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
a120: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a130: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a140: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
a150: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
a160: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a170: 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 } {.. fconfig
a180: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
a190: 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 g line.. file
a1a0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
a1b0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
a1c0: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
a1d0: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
a1e0: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
a1f0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
a200: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
a210: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
a220: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
a230: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
a240: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a250: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a260: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a270: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a280: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a290: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a2a0: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
a2b0: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
a2c0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
a2d0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
a2e0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
a2f0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a300: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a310: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a320: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a330: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
a340: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
a350: 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e re $s2 -bufferin
a360: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
a370: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
a380: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a390: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a3a0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a3b0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
a3c0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
a3d0: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
a3e0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 fconfigure $s3
a3f0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
a400: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
a410: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
a420: 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 cr i} {..puts $s
a430: 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 1 hello,s1..gets
a440: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 $s1..puts $s2 h
a450: 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 ello,s2..gets $s
a460: 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 2..puts $s3 hell
a470: 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 o,s3..gets $s3.
a480: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a490: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
a4a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
a4b0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a4c0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
a4d0: 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 9_test_server}.
a4e0: 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 set i.} 100
a4f0: 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ..test tlsIO-1
a500: 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 1.8 {client with
a510: 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 several servers
a520: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
a530: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
a540: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
a550: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
a560: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a Command {..tls::
a570: 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 init -certfile $
a580: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a590: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a5a0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 ile $serverKey..
a5b0: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a5c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a5d0: 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a ept 4003" 4003].
a5e0: 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f .set s2 [tls::so
a5f0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
a600: 63 65 70 74 20 34 30 30 34 22 20 34 30 30 34 5d cept 4004" 4004]
a610: 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 ..set s3 [tls::s
a620: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
a630: 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 ccept 4005" 4005
a640: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
a650: 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 e {s mp} {..
a660: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a670: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a680: 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 } elseif {[catch
a690: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
a6a0: 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a $s} result]} {.
a6b0: 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 ..# Some errors
a6c0: 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 are normal...
a6d0: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
a6e0: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 lt == 1} {...# H
a6f0: 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 andshake complet
a700: 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 e...fileevent $s
a710: 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 readable ""...p
a720: 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f uts $s $mp...clo
a730: 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a se $s.. }..}.
a740: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 .proc accept {mp
a750: 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 s a p} {.. #
a760: 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 These have to a
a770: 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 ccept non-blocki
a780: 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 ng, because the
a790: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 handshaking..
a7a0: 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 # order isn't d
a7b0: 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 eterministic..
a7c0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
a7d0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
a7e0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
a7f0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
a800: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e adable [list han
a810: 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 dshake $s $mp]..
a820: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a }. }. tls:
a830: 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 :init -certfile
a840: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a850: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a860: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a file $clientKey.
a870: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
a880: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
a890: 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 erverIP 4003].
a8a0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
a8b0: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a8c0: 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 verIP 4004].
a8d0: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a8e0: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
a8f0: 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 rIP 4005]. se
a900: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
a910: 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 nd l [gets $s1]
a920: 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 [gets $s1] [eof
a930: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s1] [gets $s2]
a940: 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 [gets $s2] [eof
a950: 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 $s2] \..[gets $s
a960: 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 3] [gets $s3] [e
a970: 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 of $s3]. clos
a980: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a990: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a9a0: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a9b0: 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 d {..close $s1..
a9c0: 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 close $s2..close
a9d0: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s3. }. s
a9e0: 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 et l.} {4003 {}
a9f0: 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 1 4004 {} 1 4005
aa00: 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 {} 1}..test tls
aa10: 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 IO-11.9 {accept
aa20: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 callback error}
aa30: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
aa40: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
aa50: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
aa60: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
aa70: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
aa80: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
aa90: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
aaa0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
aab0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
aac0: 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 8836]. proc
aad0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
aae0: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
aaf0: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
ab00: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
ab10: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
ab20: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
ab30: 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 lues. if {[ca
ab40: 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 tch {sendCommand
ab50: 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 {.. set peer
ab60: 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 name [fconfigure
ab70: 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d $callerSocket -
ab80: 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 peername].. s
ab90: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
aba0: 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 t \... -certf
abb0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
abc0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
abd0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
abe0: 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e Key \... [lin
abf0: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
ac00: 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 8836].. clos
ac10: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
ac20: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
ac30: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
ac40: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
ac50: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
ac60: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
ac70: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
ac80: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
ac90: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
aca0: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
acb0: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
acc0: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
acd0: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ero}}..test tlsI
ace0: 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 O-11.10 {testing
acf0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
ad00: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
ad10: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
ad20: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
ad30: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
ad40: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
ad50: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
ad60: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 12_test_server [
ad70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
ad80: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
ad90: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
ada0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
adb0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
adc0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
add0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
ade0: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
adf0: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
ae00: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
ae10: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ae20: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
ae30: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ae40: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
ae50: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
ae60: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
ae70: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
ae80: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
ae90: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
aea0: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
aeb0: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
aec0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
aed0: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
aee0: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
aef0: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
af00: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
af10: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
af20: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
af30: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
af40: 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 .} {8836 3 3}..t
af50: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 est tlsIO-11.11
af60: 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 {testing spuriou
af70: 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 s events} {socke
af80: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
af90: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
afa0: 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 # remote equiva
afb0: 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 lent of 9.1.
afc0: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
afd0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
afe0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 ..set socket_tes
aff0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
b000: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
b010: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
b020: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
b030: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b040: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
b050: 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 ey 8836]..proc h
b060: 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 andshake {s} {..
b070: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
b080: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
b090: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 } elseif {[c
b0a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
b0b0: 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d hake $s} result]
b0c0: 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 } {...# Some err
b0d0: 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a ors are normal..
b0e0: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
b0f0: 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 result == 1} {..
b100: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
b110: 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e plete...fileeven
b120: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 t $s writable ""
b130: 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 72 69 ...after 100 wri
b140: 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d tesome $s.. }
b150: 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ..}..proc accept
b160: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b170: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
b180: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
b190: 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 lf".. fileev
b1a0: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
b1b0: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
b1c0: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s]..}..proc wri
b1d0: 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 tesome {s} {..
b1e0: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
b1f0: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
b200: 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 i} {...puts $s
b210: 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 "line $i from re
b220: 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 mote server"..
b230: 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 }.. close $
b240: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b250: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
b260: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
b270: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
b280: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
b290: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
b2a0: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
b2b0: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
b2c0: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
b2d0: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
b2e0: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
b2f0: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
b300: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
b310: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
b320: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
b330: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
b340: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
b350: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
b360: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b370: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
b380: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b390: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b3a0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b3b0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b3c0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
b3d0: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
b3e0: 20 20 23 20 47 65 74 20 74 68 65 20 62 75 66 66 # Get the buff
b3f0: 65 72 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a ering corrected.
b400: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
b410: 63 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e c -buffering lin
b420: 65 0a 20 20 20 20 23 20 50 75 74 20 61 20 62 79 e. # Put a by
b430: 74 65 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 te into the clie
b440: 6e 74 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 nt pipe to trigg
b450: 65 72 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 er TLS handshaki
b460: 6e 67 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 ng. puts $c a
b470: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b480: 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 c readable [list
b490: 20 72 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a readlittle $c].
b4a0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
b4b0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
b4c0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
b4d0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b4e0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
b4f0: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
b500: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
b510: 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 socket_test_serv
b520: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
b530: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
b540: 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 2690}..test tls
b550: 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e IO-11.12 {testin
b560: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
b570: 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 } {unexplainedFa
b580: 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 ilure socket doT
b590: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b5a0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 rver} {. # re
b5b0: 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 mote equivalent
b5c0: 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 of 9.3. # HOB
b5d0: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 BS: never worked
b5e0: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 correctly. s
b5f0: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
b600: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
b610: 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 proc count_up {s
b620: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
b630: 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 ter done after_i
b640: 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 d..set l [gets $
b650: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
b660: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
b670: 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 unter.. if {$
b680: 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 counter > 9} {..
b690: 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 .set done {EOF i
b6a0: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
b6b0: 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f r cancel $after_
b6c0: 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 id...close $s..
b6d0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
b6e0: 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 proc timed_out
b6f0: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 {} {..global c
b700: 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b done..set done {
b710: 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 timed_out, EOF i
b720: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
b730: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 lose $c. }.
b740: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
b750: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b760: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
b770: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _14_test_server
b780: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b790: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
b7a0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
b7b0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b7c0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
b7d0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
b7e0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
b7f0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b800: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
b810: 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 s.. after 100
b820: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
b830: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
b840: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b850: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b860: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b870: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b880: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b890: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b8a0: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 8836]. file
b8b0: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
b8c0: 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a e "count_up $c".
b8d0: 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 set after_id
b8e0: 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d [after 1000 tim
b8f0: 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 ed_out]. vwai
b900: 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 t done. sendC
b910: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
b920: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
b930: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
b940: 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 done.} {EOF is s
b950: 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 ticky}..test tls
b960: 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e IO-11.13 {testin
b970: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 g async write, a
b980: 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e sync flush, asyn
b990: 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 c close} \..{soc
b9a0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b9b0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b9c0: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
b9d0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
b9e0: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
b9f0: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
ba00: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
ba10: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
ba20: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
ba30: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
ba40: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
ba50: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
ba60: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
ba70: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
ba80: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
ba90: 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 eat a 31]..set s
baa0: 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 econdblock [stri
bab0: 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 35 33 ng repeat b 6553
bac0: 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 5]..set l [tls::
bad0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
bae0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
baf0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
bb00: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
bb10: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
bb20: 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 accept 8845]..p
bb30: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
bb40: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
bb50: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
bb60: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
bb70: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
bb80: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
bb90: 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 ersize 16384 \..
bba0: 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 . -buffering
bbb0: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
bbc0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
bbd0: 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d "readable $s"..}
bbe0: 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 ..proc readable
bbf0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
bc00: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
bc10: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
bc20: 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 dable {}.. af
bc30: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
bc40: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 $s..}..proc res
bc50: 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 pond {s} {..
bc60: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
bc70: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
bc80: 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 ewline $s $first
bc90: 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 block.. after
bca0: 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 1000 writedata
bcb0: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
bcc0: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 edata {s} {..
bcd0: 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c global secondbl
bce0: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
bcf0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
bd00: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c ondblock.. cl
bd10: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
bd20: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
bd30: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
bd40: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
bd50: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
bd60: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
bd70: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
bd80: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
bd90: 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 845]. fconfig
bda0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
bdb0: 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 0 -translation
bdc0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
bdd0: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
bde0: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
bdf0: 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 ello. fileeve
be00: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
be10: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
be20: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
be30: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
be40: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
be50: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
be60: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
be70: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
be80: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
be90: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
bea0: 35 36 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 566..proc getdat
beb0: 61 20 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a a {type file} {.
bec0: 20 20 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c # Read handl
bed0: 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 er on the accept
bee0: 65 64 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 ed socket.. g
bef0: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 lobal x. glob
bf00: 61 6c 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 al failed. se
bf10: 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 t status [catch
bf20: 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 {read $file} dat
bf30: 61 5d 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 a]. if {$stat
bf40: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 us != 0} {..set
bf50: 78 20 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 x "read failed,
bf60: 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 error was $data"
bf70: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
bf80: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
bf90: 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f seif {[string co
bfa0: 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d mpare {} $data]}
bfb0: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 {. } elseif
bfc0: 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 {[fblocked $file
bfd0: 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 ]} {. } elsei
bfe0: 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 f {[eof $file]}
bff0: 7b 0a 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 {..if {$failed}
c000: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74 {.. set x "$t
c010: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ype socket was i
c020: 6e 68 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 nherited"..} els
c030: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 e {.. set x "
c040: 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 $type socket was
c050: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a not inherited".
c060: 09 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 .}..catch { clos
c070: 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 e $file }. }
c080: 65 6c 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 else {..set x {i
c090: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
c0a0: 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 .catch { close $
c0b0: 66 69 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 file }. }.
c0c0: 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 return.}..test
c0d0: 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 tlsIO-12.1 {test
c0e0: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
c0f0: 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 of server socket
c100: 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d s} {socket exec}
c110: 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 {. makeFile
c120: 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d {} script1. m
c130: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
c140: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
c150: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
c160: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
c170: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
c180: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
c190: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
c1a0: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
c1b0: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
c1c0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c1d0: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
c1e0: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
c1f0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
c200: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
c210: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
c220: 53 63 72 69 70 74 32 20 63 72 65 61 74 65 73 20 Script2 creates
c230: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
c240: 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 t, launches scri
c250: 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 pt1,. # waits
c260: 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 a second, and e
c270: 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 xits. The serve
c280: 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f r socket will no
c290: 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 w. # be close
c2a0: 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 d unless script1
c2b0: 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a inherited it...
c2c0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c2d0: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c2e0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c2f0: 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 tclsh $::tcltes
c300: 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 t::tcltest].
c310: 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 puts $f {..set a
c320: 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 uto_path [linser
c330: 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b t $auto_path 0 [
c340: 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 lindex [split $e
c350: 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 nv(PATH) ";:"] 0
c360: 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 ]]..package requ
c370: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
c380: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
c390: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
c3a0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
c3b0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
c3c0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
c3d0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c3e0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
c3f0: 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 828\]". puts
c400: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
c410: 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f t { file addr po
c420: 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 rt } {.. clos
c430: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 e $file..}..exec
c440: 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 $tclsh script1
c450: 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 &..close $f..aft
c460: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 er 1000 exit..vw
c470: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c480: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 09 }. close $f..
c490: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 . # Launch sc
c4a0: 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 ript2 and wait 5
c4b0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 seconds.. ex
c4c0: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
c4d0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
c4e0: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
c4f0: 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 { set ok_to_proc
c500: 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 eed 1 }. vwai
c510: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a t ok_to_proceed.
c520: 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e . # If we can
c530: 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 still connect t
c540: 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 o the server, th
c550: 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 e socket got inh
c560: 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 erited... if
c570: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
c580: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
c590: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
c5a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c5b0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
c5c0: 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 y \. . 127.0.0
c5d0: 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b .1 8828} msg]} {
c5e0: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 ..set x {server
c5f0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c600: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 nherited}. }
c610: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
c620: 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 sg..set x {serve
c630: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 r socket was inh
c640: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 erited}. }..
c650: 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 set x.} {serv
c660: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
c670: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 t inherited}..te
c680: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 st tlsIO-12.2 {t
c690: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
c6a0: 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 ce of client soc
c6b0: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 kets} {socket ex
c6c0: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ec} {. makeFi
c6d0: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
c6e0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c6f0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
c700: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
c710: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
c720: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
c730: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
c740: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
c750: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
c760: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
c770: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c780: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
c790: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
c7a0: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
c7b0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c7c0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c7d0: 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 # Script2 opens
c7e0: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b the client sock
c7f0: 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f et and writes to
c800: 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 it. It then.
c810: 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 # launches scr
c820: 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 ipt1 and exits.
c830: 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 If the child pr
c840: 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 ocess inherited
c850: 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 the. # client
c860: 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 socket, the soc
c870: 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 ket will still b
c880: 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 e open... set
c890: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
c8a0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
c8b0: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 [list set tclsh
c8c0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
c8d0: 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 est]. puts $f
c8e0: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
c8f0: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
c900: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
c910: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
c920: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 ) ";:"] 0]]..pac
c930: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
c940: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
c950: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
c960: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
c970: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
c980: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
c990: 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 20 24 63 . -keyfile $c
c9a0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
c9b0: 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 20 20 70 .1 8829\]". p
c9c0: 75 74 73 20 24 66 20 7b 0a 09 65 78 65 63 20 24 uts $f {..exec $
c9d0: 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a tclsh script1 &.
c9e0: 09 70 75 74 73 20 24 66 20 74 65 73 74 69 6e 67 .puts $f testing
c9f0: 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 65 ..flush $f..afte
ca00: 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 r 1000 exit..vwa
ca10: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
ca20: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
ca30: 20 20 20 23 20 43 72 65 61 74 65 20 74 68 65 20 # Create the
ca40: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 server socket..
ca50: 20 20 20 73 65 74 20 73 65 72 76 65 72 20 5b 74 set server [t
ca60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
ca70: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
ca80: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
ca90: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
caa0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
cab0: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
cac0: 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 t 8829]. proc
cad0: 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 accept { file h
cae0: 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 23 20 ost port } {..#
caf0: 57 68 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 When the client
cb00: 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 6c connects, establ
cb10: 69 73 68 20 74 68 65 20 72 65 61 64 20 68 61 6e ish the read han
cb20: 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 dler..global ser
cb30: 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 ver..close $serv
cb40: 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 er..fconfigure $
cb50: 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 file -blocking 0
cb60: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c ..fileevent $fil
cb70: 65 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 e readable [list
cb80: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 66 do_handshake $f
cb90: 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 ile readable \..
cba0: 09 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 63 .[list getdata c
cbb0: 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65 72 69 6e lient] -bufferin
cbc0: 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a g line]..return.
cbd0: 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 }.. # If
cbe0: 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e the socket doesn
cbf0: 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 't hit end-of-fi
cc00: 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c le in 5 seconds,
cc10: 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 70 the. # scrip
cc20: 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 20 t1 process must
cc30: 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 have inherited t
cc40: 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 he client...
cc50: 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 set failed 0.
cc60: 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 after 5000 [lis
cc70: 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d 0a t set failed 1].
cc80: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
cc90: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
cca0: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
ccb0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
ccc0: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 script2 &.. v
ccd0: 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 wait x. if {!
cce0: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 $failed} {..vwai
ccf0: 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 t failed. }.
cd00: 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 set x.} {clie
cd10: 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f nt socket was no
cd20: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 t inherited}..te
cd30: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 st tlsIO-12.3 {t
cd40: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
cd50: 63 65 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 ce of accepted s
cd60: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
cd70: 65 74 20 65 78 65 63 20 75 6e 69 78 4f 6e 6c 79 et exec unixOnly
cd80: 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 } {. makeFile
cd90: 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 {} script1.
cda0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
cdb0: 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b pt2.. set f [
cdc0: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
cdd0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
cde0: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
cdf0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
ce00: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
ce10: 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 f.. set f [op
ce20: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
ce30: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
ce40: 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c set tclsh $::tcl
ce50: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
ce60: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
ce70: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
ce80: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
ce90: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
cea0: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
ceb0: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
cec0: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
ced0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
cee0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
cef0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
cf00: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
cf10: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
cf20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
cf30: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
cf40: 79 20 38 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 y 8930\]". pu
cf50: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
cf60: 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 cept { file host
cf70: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 port } {.. g
cf80: 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 lobal tclsh..
cf90: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c fconfigure $fil
cfa0: 65 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e e -buffering lin
cfb0: 65 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 6c e.. puts $fil
cfc0: 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 e {test data on
cfd0: 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 socket}.. exe
cfe0: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
cff0: 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 &.. after 10
d000: 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 00 exit..}..vwai
d010: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
d020: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
d030: 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 # Launch the s
d040: 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 cript2 process a
d050: 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 nd connect to it
d060: 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a . See how long.
d070: 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 # the socket
d080: 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 stays open..
d090: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
d0a0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
d0b0: 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 32 2 &.. after 2
d0c0: 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 000 set ok_to_pr
d0d0: 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 oceed 1. vwai
d0e0: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a t ok_to_proceed.
d0f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a . set f [tls:
d100: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
d110: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
d120: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
d130: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
d140: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
d150: 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 127.0.0.1 8930].
d160: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
d170: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c f -buffering ful
d180: 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 l -blocking 0.
d190: 20 20 23 20 57 65 20 6e 65 65 64 20 74 6f 20 70 # We need to p
d1a0: 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 ut a byte into t
d1b0: 68 65 20 72 65 61 64 20 71 75 65 75 65 2c 20 6f he read queue, o
d1c0: 74 68 65 72 77 69 73 65 20 74 68 65 0a 20 20 20 therwise the.
d1d0: 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 # TLS handshake
d1e0: 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 68 0a doesn't finish.
d1f0: 20 20 20 20 70 75 74 73 20 24 66 20 61 3b 20 66 puts $f a; f
d200: 6c 75 73 68 20 24 66 0a 20 20 20 20 66 69 6c 65 lush $f. file
d210: 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c event $f readabl
d220: 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 e [list getdata
d230: 61 63 63 65 70 74 65 64 20 24 66 5d 0a 0a 20 20 accepted $f]..
d240: 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 # If the socke
d250: 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 t is still open
d260: 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c after 5 seconds,
d270: 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 6f the script1 pro
d280: 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 cess. # must
d290: 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 have inherited t
d2a0: 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b he accepted sock
d2b0: 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 et... set fai
d2c0: 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 led 0. after
d2d0: 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 5000 set failed
d2e0: 31 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 1.. vwait x.
d2f0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 set x.} {acce
d300: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
d310: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
d320: 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 test tlsIO-13.1
d330: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
d340: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
d350: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
d360: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 s} \..{socket te
d370: 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 stthread} {.
d380: 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 # HOBBS: never t
d390: 65 73 74 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 ested. remove
d3a0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
d3b0: 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 threadReap..
d3c0: 6d 61 6b 65 46 69 6c 65 20 7b 0a 09 73 65 74 20 makeFile {..set
d3d0: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
d3e0: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
d3f0: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
d400: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
d410: 30 5d 5d 0a 20 20 20 20 09 70 61 63 6b 61 67 65 0]]. .package
d420: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
d430: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
d440: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
d450: 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 8828]..proc acce
d460: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 pt {s a p} {.
d470: 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 fileeve
d480: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
d490: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 list echo $s].
d4a0: 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 fconfi
d4b0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
d4c0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 ng line.
d4d0: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
d4e0: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
d4f0: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 i. s
d500: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
d510: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
d520: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
d530: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f glo
d540: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
d550: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
d560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d570: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
d580: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
d590: 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 { .. inc
d5a0: 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 r i.
d5b0: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
d5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
d5d0: 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 }..set i 0..vwai
d5e0: 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 t x..close $f...
d5f0: 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 # thread cleans
d600: 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 itself up...test
d610: 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 thread exit.
d620: 7d 20 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 } script. .
d630: 20 20 23 20 63 72 65 61 74 65 20 61 20 74 68 72 # create a thr
d640: 65 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 ead. set serv
d650: 65 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 erthread [testth
d660: 72 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f read create { so
d670: 75 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a urce script } ].
d680: 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a update. .
d690: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 after 1000.
d6a0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
d6b0: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
d6c0: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
d6d0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
d6e0: 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 ng line.. cat
d6f0: 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 ch {..puts $s "h
d700: 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 ello"..gets $s r
d710: 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 esult. }.
d720: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 close $s. upd
d730: 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 ate.. after 2
d740: 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 000. lappend
d750: 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 result [threadRe
d760: 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 ap]. . set
d770: 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c result..} {hell
d780: 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a o 1}..# cleanup.
d790: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 if {[string matc
d7a0: 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 h sock* $command
d7b0: 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a Socket] == 1} {.
d7c0: 20 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 puts $command
d7d0: 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 Socket exit. f
d7e0: 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lush $commandSoc
d7f0: 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f ket.}.catch {clo
d800: 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 se $commandSocke
d810: 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 t}.catch {close
d820: 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d $remoteProcChan}
d830: 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 .::tcltest::clea
d840: 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 nupTests.flush s
d850: 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a tdout.return.