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 33 20 32 30 30 38 2f 30 33 t,v 1.23 2008/03
0230: 2f 31 39 20 32 32 3a 30 36 3a 31 33 20 68 6f 62 /19 22:06:13 hob
0240: 62 73 32 20 45 78 70 20 24 0a 0a 23 20 52 75 6e bs2 Exp $..# Run
0250: 6e 69 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 ning socket test
0260: 73 20 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 s with a remote
0270: 73 65 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 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 0a 23 20 0a 23 20 53 6f 6d 65 20 74 ----.# .# Some t
02b0: 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 ests in socket.t
02c0: 65 73 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 est depend on th
02d0: 65 20 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 e existence of a
02e0: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 remote server t
02f0: 6f 0a 23 20 77 68 69 63 68 20 74 68 65 79 20 63 o.# which they c
0300: 6f 6e 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f onnect. The remo
0310: 74 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 te server must b
0320: 65 20 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 e an instance of
0330: 20 74 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a tcltest and it.
0340: 23 20 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 # must run the s
0350: 63 72 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 cript found in t
0360: 68 65 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e he file "remote.
0370: 74 63 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 tcl" in this dir
0380: 65 63 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 ectory. You.# ca
0390: 6e 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f n start the remo
03a0: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 te server on any
03b0: 20 6d 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 machine reachab
03c0: 6c 65 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 le from the mach
03d0: 69 6e 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 ine on.# which y
03e0: 6f 75 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 ou want to run t
03f0: 68 65 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c he socket tests,
0400: 20 62 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a by issuing:.# .
0410: 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 # tcltest re
0420: 6d 6f 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 38 mote.tcl -port 8
0430: 30 34 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 048.# Or choose
0440: 61 6e 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d another port num
0450: 62 65 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 ber..# .# If the
0460: 20 6d 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 machine you are
0470: 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d running the rem
0480: 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 ote server on ha
0490: 73 20 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 s several IP.# i
04a0: 6e 74 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 nterfaces, you c
04b0: 61 6e 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 an choose which
04c0: 69 6e 74 65 72 66 61 63 65 20 74 68 65 20 73 65 interface the se
04d0: 72 76 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 rver listens on
04e0: 66 6f 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e for.# connection
04f0: 73 20 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 s by specifying
0500: 74 68 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d the -address com
0510: 6d 61 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 mand line flag,
0520: 73 6f 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c so:.# .# tcl
0530: 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 test remote.tcl
0540: 2d 61 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 -address your.ma
0550: 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 chine.com.# .# T
0560: 68 65 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e hese options can
0570: 20 61 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 also be set by
0580: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
0590: 61 62 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 ables. On Unix,
05a0: 79 6f 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 you can.# type t
05b0: 68 65 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f hese commands to
05c0: 20 74 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 the shell from
05d0: 77 68 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 which the remote
05e0: 20 73 65 72 76 65 72 20 69 73 20 73 74 61 72 74 server is start
05f0: 65 64 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 ed:.# .# she
0600: 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 ll% setenv serve
0610: 72 50 6f 72 74 20 38 30 34 38 0a 23 20 20 20 20 rPort 8048.#
0620: 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 shell% setenv s
0630: 65 72 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 erverAddress you
0640: 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 r.machine.com.#
0650: 0a 23 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e .# and subsequen
0660: 74 6c 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 tly you can star
0670: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
0680: 76 65 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 ver with:.# .#
0690: 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 tcltest remot
06a0: 65 2e 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 e.tcl.# .# to ha
06b0: 76 65 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 ve it listen on
06c0: 70 6f 72 74 20 38 30 34 38 20 6f 6e 20 74 68 65 port 8048 on the
06d0: 20 69 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e interface your.
06e0: 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 machine.com..#
06f0: 20 20 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 .# When the s
0700: 65 72 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 erver starts, it
0710: 20 70 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 prints out a de
0720: 74 61 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 tailed message c
0730: 6f 6e 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 ontaining its.#
0740: 63 6f 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e configuration in
0750: 66 6f 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 formation, and i
0760: 74 20 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 t will block unt
0770: 69 6c 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 il killed with a
0780: 20 43 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 Ctrl-C..# Once
0790: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
07a0: 72 20 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 r exists, you ca
07b0: 6e 20 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 n run the tests
07c0: 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 in socket.test w
07d0: 69 74 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 ith.# the server
07e0: 20 62 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 by setting two
07f0: 54 63 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 Tcl variables:.#
0800: 20 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 65 .# % set re
0810: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 moteServerIP <na
0820: 6d 65 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 me or address of
0830: 20 6d 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 machine on whic
0840: 68 20 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 h server runs>.#
0850: 20 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 % set remot
0860: 65 53 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 eServerPort 8048
0870: 0a 23 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 .# .# These vari
0880: 61 62 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 ables are also s
0890: 65 74 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 ettable from the
08a0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e environment. On
08b0: 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a Unix, you can:.
08c0: 23 20 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 # .# shell%
08d0: 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 setenv remoteSer
08e0: 76 65 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 verIP machine.wh
08f0: 65 72 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a ere.server.runs.
0900: 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 # shell% set
0910: 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 env remoteServer
0920: 50 6f 72 74 20 38 30 34 38 0a 23 20 0a 23 20 54 Port 8048.# .# T
0930: 68 65 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 he preamble of t
0940: 68 65 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 he socket.test f
0950: 69 6c 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 ile checks to se
0960: 65 20 69 66 20 74 68 65 20 76 61 72 69 61 62 6c e if the variabl
0970: 65 73 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 es are set.# eit
0980: 68 65 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e her in Tcl or in
0990: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 the environment
09a0: 3b 20 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 ; if they are, i
09b0: 74 20 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f t attempts to co
09c0: 6e 6e 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 nnect to.# the s
09d0: 65 72 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f erver. If the co
09e0: 6e 6e 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 nnection is succ
09f0: 65 73 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 essful, the test
0a00: 73 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f s using the remo
0a10: 74 65 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c te.# server will
0a20: 20 62 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f be performed; o
0a30: 74 68 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c therwise, it wil
0a40: 6c 20 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 l attempt to sta
0a50: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 rt the remote.#
0a60: 73 65 72 76 65 72 20 28 76 69 61 20 65 78 65 63 server (via exec
0a70: 29 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 ) on platforms t
0a80: 68 61 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 hat support this
0a90: 2c 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 , on the local h
0aa0: 6f 73 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 ost,.# listening
0ab0: 20 61 74 20 70 6f 72 74 20 38 30 34 38 2e 20 49 at port 8048. I
0ac0: 66 20 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d f all fails, a m
0ad0: 65 73 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 essage is printe
0ae0: 64 20 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a d and the tests.
0af0: 23 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f # using the remo
0b00: 74 65 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f te server are no
0b10: 74 20 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 70 72 t performed...pr
0b20: 6f 63 20 64 70 75 74 73 20 7b 6d 73 67 7d 20 7b oc dputs {msg} {
0b30: 20 72 65 74 75 72 6e 20 3b 20 70 75 74 73 20 73 return ; puts s
0b40: 74 64 65 72 72 20 24 6d 73 67 20 3b 20 66 6c 75 tderr $msg ; flu
0b50: 73 68 20 73 74 64 65 72 72 20 7d 0a 0a 69 66 20 sh stderr }..if
0b60: 7b 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 {[lsearch [names
0b70: 70 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a pace children] :
0b80: 3a 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d :tcltest] == -1}
0b90: 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 {. package r
0ba0: 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 equire tcltest.
0bb0: 20 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 namespace imp
0bc0: 6f 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c ort -force ::tcl
0bd0: 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 54 68 65 test::*.}..# The
0be0: 20 62 75 69 6c 64 20 64 69 72 20 69 73 20 61 64 build dir is ad
0bf0: 64 65 64 20 61 73 20 74 68 65 20 66 69 72 73 74 ded as the first
0c00: 20 65 6c 65 6d 65 6e 74 20 6f 66 20 24 50 41 54 element of $PAT
0c10: 48 0a 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 H.set auto_path
0c20: 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 [linsert $auto_p
0c30: 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 ath 0 [lindex [s
0c40: 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 plit $env(PATH)
0c50: 22 3b 3a 22 5d 20 30 5d 5d 0a 23 20 4c 6f 61 64 ";:"] 0]].# Load
0c60: 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 65 the tls package
0c70: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
0c80: 20 74 6c 73 20 31 2e 36 0a 0a 73 65 74 20 74 6c tls 1.6..set tl
0c90: 73 53 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 sServerPort 8048
0ca0: 0a 0a 23 20 53 70 65 63 69 66 79 20 77 68 65 72 ..# Specify wher
0cb0: 65 20 74 68 65 20 63 65 72 74 69 66 69 63 61 74 e the certificat
0cc0: 65 73 20 61 72 65 0a 0a 73 65 74 20 63 65 72 74 es are..set cert
0cd0: 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 sDir.[file join
0ce0: 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69 [file dirname [i
0cf0: 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 72 nfo script]] cer
0d00: 74 73 5d 0a 73 65 74 20 73 65 72 76 65 72 43 65 ts].set serverCe
0d10: 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 rt.[file join $c
0d20: 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 70 ertsDir server.p
0d30: 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 43 65 em].set clientCe
0d40: 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 rt.[file join $c
0d50: 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 ertsDir client.p
0d60: 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 74 09 5b em].set caCert.[
0d70: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0d80: 44 69 72 20 63 61 2e 70 65 6d 5d 0a 73 65 74 20 Dir ca.pem].set
0d90: 73 65 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 serverKey.[file
0da0: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 join $certsDir s
0db0: 65 72 76 65 72 2e 6b 65 79 5d 0a 73 65 74 20 63 erver.key].set c
0dc0: 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a lientKey.[file j
0dd0: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c oin $certsDir cl
0de0: 69 65 6e 74 2e 6b 65 79 5d 0a 0a 23 20 53 6f 6d ient.key]..# Som
0df0: 65 20 74 65 73 74 73 20 72 65 71 75 69 72 65 20 e tests require
0e00: 74 68 65 20 74 65 73 74 74 68 72 65 61 64 20 61 the testthread a
0e10: 6e 64 20 65 78 65 63 20 63 6f 6d 6d 61 6e 64 73 nd exec commands
0e20: 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a ..set ::tcltest:
0e30: 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 :testConstraints
0e40: 28 74 65 73 74 74 68 72 65 61 64 29 20 5c 0a 09 (testthread) \..
0e50: 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d [expr {[info com
0e60: 6d 61 6e 64 73 20 74 65 73 74 74 68 72 65 61 64 mands testthread
0e70: 5d 20 21 3d 20 7b 7d 7d 5d 0a 73 65 74 20 3a 3a ] != {}}].set ::
0e80: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e tcltest::testCon
0e90: 73 74 72 61 69 6e 74 73 28 65 78 65 63 29 20 5b straints(exec) [
0ea0: 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d expr {[info comm
0eb0: 61 6e 64 73 20 65 78 65 63 5d 20 21 3d 20 7b 7d ands exec] != {}
0ec0: 7d 5d 0a 0a 23 0a 23 20 49 66 20 72 65 6d 6f 74 }]..#.# If remot
0ed0: 65 53 65 72 76 65 72 49 50 20 6f 72 20 72 65 6d eServerIP or rem
0ee0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 61 72 oteServerPort ar
0ef0: 65 20 6e 6f 74 20 73 65 74 2c 20 63 68 65 63 6b e not set, check
0f00: 20 69 6e 20 74 68 65 0a 23 20 65 6e 76 69 72 6f in the.# enviro
0f10: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 nment variables
0f20: 66 6f 72 20 65 78 74 65 72 6e 61 6c 6c 79 20 73 for externally s
0f30: 65 74 20 76 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 et values..#..if
0f40: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
0f50: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d remoteServerIP]}
0f60: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f {. if {[info
0f70: 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f exists env(remo
0f80: 74 65 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a teServerIP)]} {.
0f90: 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 .set remoteServe
0fa0: 72 49 50 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 rIP $env(remoteS
0fb0: 65 72 76 65 72 49 50 29 0a 20 20 20 20 7d 0a 7d erverIP). }.}
0fc0: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0fd0: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 ts remoteServerP
0fe0: 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b ort]} {. if {
0ff0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 [info exists env
1000: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 (remoteServerPor
1010: 74 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f t)]} {..set remo
1020: 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 65 6e teServerPort $en
1030: 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f v(remoteServerPo
1040: 72 74 29 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b rt). } else {
1050: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 69 6e . if {[in
1060: 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 fo exists remote
1070: 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 09 20 20 ServerIP]} {..
1080: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1090: 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 65 erPort $tlsServe
10a0: 72 50 6f 72 74 0a 20 20 20 20 20 20 20 20 7d 0a rPort. }.
10b0: 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f }.}..proc do
10c0: 5f 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 7b 74 _handshake {s {t
10d0: 79 70 65 20 72 65 61 64 61 62 6c 65 7d 20 7b 63 ype readable} {c
10e0: 6d 64 20 7b 7d 7d 20 61 72 67 73 7d 20 7b 0a 20 md {}} args} {.
10f0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
1100: 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 64 70 {..close $s..dp
1110: 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 uts "handshake:
1120: 65 6f 66 22 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 eof"..set ::do_h
1130: 61 6e 64 73 68 61 6b 65 20 22 65 6f 66 22 0a 20 andshake "eof".
1140: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 } elseif {[ca
1150: 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 tch {tls::handsh
1160: 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d ake $s} result]}
1170: 20 7b 0a 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 {..# Some error
1180: 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 64 s are normal...d
1190: 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 3a puts "handshake:
11a0: 20 24 72 65 73 75 6c 74 22 0a 20 20 20 20 7d 20 $result". }
11b0: 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 elseif {$result
11c0: 3d 3d 20 31 7d 20 7b 0a 09 23 20 48 61 6e 64 73 == 1} {..# Hands
11d0: 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 69 hake complete..i
11e0: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 f {[llength $arg
11f0: 73 5d 7d 20 7b 20 65 76 61 6c 20 5b 6c 69 73 74 s]} { eval [list
1200: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 20 fconfigure $s]
1210: 24 61 72 67 73 20 7d 0a 09 69 66 20 7b 24 63 6d $args }..if {$cm
1220: 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 d == ""} {..
1230: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 24 74 79 fileevent $s $ty
1240: 70 65 20 22 22 0a 09 7d 20 65 6c 73 65 20 7b 0a pe ""..} else {.
1250: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
1260: 73 20 24 74 79 70 65 20 22 24 63 6d 64 20 5b 6c s $type "$cmd [l
1270: 69 73 74 20 24 73 5d 22 0a 09 7d 0a 09 64 70 75 ist $s]"..}..dpu
1280: 74 73 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 63 ts "handshake: c
1290: 6f 6d 70 6c 65 74 65 22 0a 09 73 65 74 20 3a 3a omplete"..set ::
12a0: 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 22 63 6f do_handshake "co
12b0: 6d 70 6c 65 74 65 22 0a 20 20 20 20 7d 20 65 6c mplete". } el
12c0: 73 65 20 7b 0a 09 64 70 75 74 73 20 22 68 61 6e se {..dputs "han
12d0: 64 73 68 61 6b 65 3a 20 69 6e 20 70 72 6f 67 72 dshake: in progr
12e0: 65 73 73 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a ess". }.}..#.
12f0: 23 20 43 68 65 63 6b 20 69 66 20 77 65 27 72 65 # Check if we're
1300: 20 73 75 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 supposed to do
1310: 74 65 73 74 73 20 61 67 61 69 6e 73 74 20 74 68 tests against th
1320: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 0a e remote server.
1330: 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 73 57 69 #..set doTestsWi
1340: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 31 thRemoteServer 1
1350: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
1360: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ts remoteServerI
1370: 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 P] && ($tcl_plat
1380: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 21 form(platform) !
1390: 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 = "macintosh")}
13a0: 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 {. set remote
13b0: 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 ServerIP 127.0.0
13c0: 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 .1.}.if {($doTes
13d0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
13e0: 65 72 20 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 er == 1) && (![i
13f0: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
1400: 65 53 65 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b eServerPort])} {
1410: 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
1420: 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 erverPort $tlsSe
1430: 72 76 65 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 rverPort.}..# At
1440: 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 tempt to connect
1450: 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 to a remote ser
1460: 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c ver if one is al
1470: 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 ready running. I
1480: 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 f it.# is not ru
1490: 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d nning or for som
14a0: 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 e other reason t
14b0: 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 he connect fails
14c0: 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 , attempt to.# s
14d0: 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 tart the remote
14e0: 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f server on the lo
14f0: 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 cal host listeni
1500: 6e 67 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 2e ng on port 8048.
1510: 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 This.# is only
1520: 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d done on platform
1530: 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 s that support e
1540: 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e xec (i.e. not on
1550: 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 the Mac). On.#
1560: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 platforms that d
1570: 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 o not support ex
1580: 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ec, the remote s
1590: 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 erver must be st
15a0: 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 arted.# by the u
15b0: 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 ser before runni
15c0: 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 ng the tests...s
15d0: 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 et remoteProcCha
15e0: 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 n "".set command
15f0: 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 Socket "".if {$d
1600: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1610: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 Server} {. ca
1620: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d tch {close $comm
1630: 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 andSocket}. i
1640: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 f {[catch {set c
1650: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c ommandSocket [tl
1660: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
1670: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
1680: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
1690: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
16a0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
16b0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
16c0: 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 P $remoteServerP
16d0: 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 ort]}] != 0} {..
16e0: 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e if {[info comman
16f0: 64 73 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 ds exec] == ""}
1700: 7b 0a 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d {.. set noRem
1710: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 oteTestReason "c
1720: 61 6e 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 an't exec"..
1730: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
1740: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d emoteServer 0..}
1750: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
1760: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
1770: 31 32 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 127.0.0.1.. s
1780: 65 74 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 et remoteFile [f
1790: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 ile join [pwd] r
17a0: 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 emote.tcl]..
17b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
17c0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c remoteProcChan \
17d0: 0a 09 09 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b ... [open "|[
17e0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
17f0: 3a 74 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 :tcltest $remote
1800: 46 69 6c 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 File \... -se
1810: 72 76 65 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f rverIsSilent -po
1820: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
1830: 50 6f 72 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 Port \... -ad
1840: 64 72 65 73 73 20 24 72 65 6d 6f 74 65 53 65 72 dress $remoteSer
1850: 76 65 72 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 verIP]" w+]} msg
1860: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 ] == 0} {...afte
1870: 72 20 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 r 1000...if {[ca
1880: 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 tch {set command
1890: 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 Socket [tls::soc
18a0: 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ket -cafile $caC
18b0: 65 72 74 20 5c 0a 09 09 09 2d 63 65 72 74 66 69 ert \....-certfi
18c0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
18d0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
18e0: 65 79 20 5c 0a 09 09 09 24 72 65 6d 6f 74 65 53 ey \....$remoteS
18f0: 65 72 76 65 72 49 50 20 24 72 65 6d 6f 74 65 53 erverIP $remoteS
1900: 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d erverPort]} msg]
1910: 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 == 0} {... f
1920: 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 configure $comma
1930: 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c ndSocket -transl
1940: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
1950: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 ering line...} e
1960: 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 lse {... set
1970: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
1980: 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 65 on $msg... se
1990: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
19a0: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d 0a oteServer 0...}.
19b0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
19c0: 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 set noRemoteTest
19d0: 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a Reason "$msg $::
19e0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
19f0: 22 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 57 "...set doTestsW
1a00: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1a10: 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 0.. }..}.
1a20: 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 } else {..fconfi
1a30: 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gure $commandSoc
1a40: 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ket -translation
1a50: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
1a60: 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 line. }.}..#
1a70: 20 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 Some tests are
1a80: 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 run only if we a
1a90: 72 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 re doing testing
1aa0: 20 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 against a remot
1ab0: 65 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a e server..set ::
1ac0: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e tcltest::testCon
1ad0: 73 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 straints(doTests
1ae0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1af0: 29 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 ) $doTestsWithRe
1b00: 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 moteServer.if {$
1b10: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1b20: 65 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a eServer == 0} {.
1b30: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1b40: 66 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 first s $::tclte
1b50: 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 st::verbose] !=
1b60: 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 -1} {. .puts
1b70: 22 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 "Skipping tests
1b80: 77 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 with remote serv
1b90: 65 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f er. See tests/so
1ba0: 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 cket.test for"..
1bb0: 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f puts "informatio
1bc0: 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 n on how to run
1bd0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a remote server.".
1be0: 09 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f .puts "Reason fo
1bf0: 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f r not doing remo
1c00: 74 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d te tests: $noRem
1c10: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 oteTestReason".
1c20: 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 }.}..#.# If w
1c30: 65 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 e do the tests,
1c40: 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 define a command
1c50: 20 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 to send a comma
1c60: 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f nd to the.# remo
1c70: 74 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 te server..#..if
1c80: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
1c90: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d moteServer == 1}
1ca0: 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 {. proc send
1cb0: 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 Command {c} {..g
1cc0: 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 lobal commandSoc
1cd0: 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 ket...if {[eof $
1ce0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 commandSocket]}
1cf0: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 {.. error "re
1d00: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1d10: 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 ppeared"..}...if
1d20: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1d30: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 commandSocket $c
1d40: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 } msg]} {.. e
1d50: 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 rror "remote ser
1d60: 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 3a ver disappeared:
1d70: 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b $msg"..}..if {[
1d80: 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d catch {puts $com
1d90: 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 mandSocket "--Ma
1da0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 rker--Marker--Ma
1db0: 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b rker--"} msg]} {
1dc0: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d .. error "rem
1dd0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1de0: 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d peared: $msg"..}
1df0: 0a 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 ...set resp ""..
1e00: 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 while {1} {..
1e10: 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 set line [gets
1e20: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a $commandSocket].
1e30: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 . if {[eof $c
1e40: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b ommandSocket]} {
1e50: 0a 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 ...error "remote
1e60: 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 server disappea
1e70: 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 red".. }..
1e80: 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d if {[string com
1e90: 70 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 pare $line "--Ma
1ea0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 rker--Marker--Ma
1eb0: 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b rker--"] == 0} {
1ec0: 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 ...if {[string c
1ed0: 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 ompare [lindex $
1ee0: 72 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d resp 0] error] =
1ef0: 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 = 0} {... err
1f00: 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 or [lindex $resp
1f10: 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 1]...} else {..
1f20: 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e . return [lin
1f30: 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d dex $resp 1]...}
1f40: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1f50: 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 .append resp $li
1f60: 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 ne "\n".. }..
1f70: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 6e }. }.. sen
1f80: 64 43 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 70 dCommand [list p
1f90: 72 6f 63 20 64 70 75 74 73 20 5b 69 6e 66 6f 20 roc dputs [info
1fa0: 61 72 67 73 20 64 70 75 74 73 5d 20 5b 69 6e 66 args dputs] [inf
1fb0: 6f 20 62 6f 64 79 20 64 70 75 74 73 5d 5d 0a 0a o body dputs]]..
1fc0: 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 65 72 proc sendCer
1fd0: 74 56 61 6c 75 65 73 20 7b 7d 20 7b 0a 09 23 20 tValues {} {..#
1fe0: 57 65 20 6e 65 65 64 20 74 6f 20 62 65 20 61 62 We need to be ab
1ff0: 6c 65 20 74 6f 20 73 65 6e 64 20 63 65 72 74 69 le to send certi
2000: 66 69 63 61 74 65 20 76 61 6c 75 65 73 20 74 68 ficate values th
2010: 61 74 20 6e 6f 72 6d 61 6c 69 7a 65 0a 09 23 20 at normalize..#
2020: 66 69 6c 65 6e 61 6d 65 73 20 61 63 72 6f 73 73 filenames across
2030: 20 70 6c 61 74 66 6f 72 6d 73 0a 09 73 65 6e 64 platforms..send
2040: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 Command {.. s
2050: 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c et certsDir.[fil
2060: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 e join [file dir
2070: 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 name [info scrip
2080: 74 5d 5d 20 63 65 72 74 73 5d 0a 09 20 20 20 20 t]] certs]..
2090: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 5b set serverCert.[
20a0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
20b0: 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a Dir server.pem].
20c0: 09 20 20 20 20 73 65 74 20 63 6c 69 65 6e 74 43 . set clientC
20d0: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
20e0: 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e certsDir client.
20f0: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 61 pem].. set ca
2100: 43 65 72 74 09 09 5b 66 69 6c 65 20 6a 6f 69 6e Cert..[file join
2110: 20 24 63 65 72 74 73 44 69 72 20 63 61 63 65 72 $certsDir cacer
2120: 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 t.pem].. set
2130: 73 65 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 serverKey.[file
2140: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 join $certsDir s
2150: 65 72 76 65 72 2e 6b 65 79 5d 0a 09 20 20 20 20 erver.key]..
2160: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 09 5b 66 set clientKey.[f
2170: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
2180: 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 5d 0a 09 ir client.key]..
2190: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 }. }.}..test
21a0: 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 67 20 70 tlsIO-1.1 {arg p
21b0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
21c0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
21d0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
21e0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
21f0: 65 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 5d et -server} msg]
2200: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2210: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2220: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2230: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2240: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
2250: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2260: 2e 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .2 {arg parsing
2270: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2280: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
2290: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
22a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
22b0: 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d ver foo} msg] $m
22c0: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
22d0: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
22e0: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 "tls::socket -s
22f0: 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f erver command ?o
2300: 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a ptions? port"}}.
2310: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 33 20 .test tlsIO-1.3
2320: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2330: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2340: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2350: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2360: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 ::socket -myaddr
2370: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2380: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2390: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
23a0: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
23b0: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
23c0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 20 7b 61 est tlsIO-1.4 {a
23d0: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
23e0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
23f0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2400: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2410: 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 socket -myaddr 1
2420: 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 27.0.0.1} msg] $
2430: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2440: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2450: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2460: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2470: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2480: 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 69 O-1.5 {arg parsi
2490: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
24a0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
24b0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
24c0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
24d0: 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 myport} msg] $ms
24e0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
24f0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2500: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2510: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2520: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2530: 31 2e 36 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.6 {arg parsing
2540: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2550: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2560: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2570: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2580: 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d 20 port xxxx} msg]
2590: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
25a0: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
25b0: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
25c0: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
25d0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
25e0: 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 61 72 73 IO-1.7 {arg pars
25f0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2600: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2610: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2620: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2630: 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d 20 6d 73 -myport 2522} ms
2640: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2650: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2660: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2670: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2680: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2690: 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 67 20 70 tlsIO-1.8 {arg p
26a0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
26b0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
26c0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
26d0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
26e0: 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d et -froboz} msg]
26f0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2700: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2710: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2720: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2730: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2740: 73 49 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 72 sIO-1.9 {arg par
2750: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2760: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2770: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2780: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2790: 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 -server foo -my
27a0: 70 6f 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 port 2521 3333}
27b0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
27c0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
27d0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
27e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
27f0: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
2800: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
2810: 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 72 IO-1.10 {arg par
2820: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2830: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2840: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2850: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2860: 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b host 2528 -junk
2870: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2880: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2890: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
28a0: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
28b0: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
28c0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 20 7b est tlsIO-1.11 {
28d0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
28e0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
28f0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2900: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2910: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2920: 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d callback 2520 --
2930: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2940: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2950: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2960: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2970: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2980: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2990: 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 20 70 lsIO-1.12 {arg p
29a0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
29b0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
29c0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
29d0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
29e0: 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 et foo badport}
29f0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2a00: 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 expected integer
2a10: 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 but got "badpor
2a20: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
2a30: 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.1 {tcp connec
2a40: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 tion} {socket st
2a50: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
2a60: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2a70: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2a80: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2a90: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
2aa0: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
2ab0: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
2ac0: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
2ad0: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 TH) ";:"] 0]]..p
2ae0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
2af0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
2b00: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
2b10: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
2b20: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
2b30: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
2b40: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
2b50: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
2b60: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
2b70: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
2b80: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
2b90: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
2ba0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
2bb0: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
2bc0: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
2bd0: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
2be0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
2bf0: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
2c00: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2c10: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2c20: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2c30: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
2c40: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2c50: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
2c60: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
2c70: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
2c80: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
2c90: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
2ca0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2cb0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
2cc0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2cd0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
2ce0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
2cf0: 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 0.0.1 8828} msg]
2d00: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2d10: 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 x $msg. } els
2d20: 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 e {. lapp
2d30: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
2d40: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d close $m
2d50: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
2d60: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
2d70: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2d80: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
2d90: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 done {}}..if [i
2da0: 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d nfo exists port]
2db0: 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 {. incr port
2dc0: 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 .} else {. se
2dd0: 74 20 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 t port [expr {$t
2de0: 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b lsServerPort + [
2df0: 70 69 64 5d 25 31 30 32 34 7d 5d 0a 7d 0a 0a 74 pid]%1024}].}..t
2e00: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 est tlsIO-2.2 {t
2e10: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
2e20: 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 th client port s
2e30: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
2e40: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2e50: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2e60: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2e70: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2e80: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
2e90: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
2ea0: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
2eb0: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
2ec0: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
2ed0: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
2ee0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
2ef0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
2f00: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
2f10: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
2f20: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
2f30: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
2f40: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
2f50: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
2f60: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
2f70: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 $serverKey 8829
2f80: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
2f90: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
2fa0: 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d {sock addr port}
2fb0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 {. g
2fc0: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
2fd0: 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 puts "[gets
2fe0: 24 73 6f 63 6b 5d 20 24 70 6f 72 74 22 0a 20 20 $sock] $port".
2ff0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3000: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 $sock.
3010: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
3020: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3030: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3040: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3050: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
3060: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3070: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3080: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3090: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
30a0: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
30b0: 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 global port.
30c0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
30d0: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
30e0: 20 24 70 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 $port \..-certf
30f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3100: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3110: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3120: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
3130: 20 38 38 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8829} sock]} {.
3140: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
3150: 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 ock..catch {clos
3160: 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 e [tls::socket 1
3170: 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 27.0.0.1 8829]}.
3180: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
3190: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
31a0: 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f hello..flush $so
31b0: 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 ck. lappe
31c0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
31d0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
31e0: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ck. }. clo
31f0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
3200: 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 } [list ready "h
3210: 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 ello $port"]..te
3220: 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 st tlsIO-2.3 {tc
3230: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
3240: 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 h client interfa
3250: 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 ce specified} {s
3260: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3270: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3280: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3290: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
32a0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
32b0: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
32c0: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
32d0: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
32e0: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
32f0: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
3300: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3310: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3320: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3330: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3340: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3350: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3360: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3370: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3380: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3390: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
33a0: 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 8830 \]". put
33b0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
33c0: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
33d0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
33e0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
33f0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
3400: 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 72 ets $sock] $addr
3410: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
3420: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
3430: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3440: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
3450: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3460: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3470: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
3480: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3490: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
34a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
34b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
34c0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
34d0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
34e0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
34f0: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c addr 127.0.0.1 \
3500: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
3510: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3520: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3530: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
3540: 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 73 27.0.0.1 8830} s
3550: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
3560: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
3570: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3580: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
3590: 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 o..catch {flush
35a0: 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c $sock}. l
35b0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
35c0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
35d0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
35e0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
35f0: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 t x.} {ready {he
3600: 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a llo 127.0.0.1}}.
3610: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 .test tlsIO-2.4
3620: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
3630: 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 with server inte
3640: 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d rface specified}
3650: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3660: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
3670: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
3680: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3690: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
36a0: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
36b0: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
36c0: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
36d0: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
36e0: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
36f0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3700: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3710: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
3720: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
3730: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3740: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3750: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3760: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3770: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
3780: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
3790: 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 6e 66 6f ey -myaddr [info
37a0: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 20 hostname] 8831
37b0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
37c0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
37d0: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
37e0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
37f0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3800: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3810: 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 sock]".
3820: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3830: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3840: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
3850: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3860: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3870: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3880: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3890: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
38a0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
38b0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
38c0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
38d0: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
38e0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
38f0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3900: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3910: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3920: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b ile $clientKey [
3930: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
3940: 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 831} sock]} {.
3950: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
3960: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 k. } else {.
3970: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 puts $soc
3980: 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 k hello..flush $
3990: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 sock. lap
39a0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
39b0: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
39c0: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
39d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
39e0: 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f x.} {ready hello
39f0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3a00: 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 5 {tcp connectio
3a10: 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 6e 74 n with redundant
3a20: 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 7b 73 server port} {s
3a30: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3a40: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3a50: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3a60: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3a70: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
3a80: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
3a90: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
3aa0: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
3ab0: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
3ac0: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
3ad0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3ae0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3af0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3b00: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3b10: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3b20: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3b30: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3b40: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3b50: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3b60: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3b70: 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 8832 \]". put
3b80: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3b90: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
3ba0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3bb0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3bc0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
3bd0: 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 ets $sock]".
3be0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3bf0: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
3c00: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3c10: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3c20: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3c30: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3c40: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3c50: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3c60: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3c70: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3c80: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3c90: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
3ca0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3cb0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3cc0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3cd0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3ce0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3cf0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
3d00: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3d10: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3d20: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3d30: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3d40: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
3d50: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
3d60: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3d70: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3d80: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3d90: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
3da0: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
3db0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 .test tlsIO-2.6
3dc0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
3dd0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
3de0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
3df0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
3e00: 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f et sock [tls::so
3e10: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
3e20: 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 833]}]} {..if {!
3e30: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f [catch {gets $so
3e40: 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 ck}]} {.. set
3e50: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
3e60: 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 }..close $sock.
3e70: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
3e80: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 tus.} ok..test t
3e90: 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 lsIO-2.7 {echo s
3ea0: 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d erver, one line}
3eb0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3ec0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
3ed0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
3ee0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3ef0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3f00: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
3f10: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
3f20: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
3f30: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
3f40: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
3f50: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3f60: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3f70: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
3f80: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
3f90: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3fa0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3fb0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3fc0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3fd0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
3fe0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
3ff0: 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 ey 8834 \]".
4000: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
4010: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
4030: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4040: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
4050: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
4060: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
4070: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
4080: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
4090: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
40a0: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
40b0: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
40c0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
40d0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
40e0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
4100: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
4110: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
4120: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
4130: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
4140: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
4150: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
4160: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
4170: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
4180: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4190: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
41a0: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
41b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
41c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
41d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
41e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
41f0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4200: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
4210: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
4220: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
4230: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
4240: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
4250: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 127.0.0.1 8834]
4260: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4270: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
4280: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
4290: 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 lf. puts $s "
42a0: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
42b0: 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 klmnop". afte
42c0: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 r 1000. set x
42d0: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
42e0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
42f0: 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 y [gets $f].
4300: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 close $f. lis
4310: 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c t $x $y.} {{hell
4320: 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e o abcdefghijklmn
4330: 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 op} done}..test
4340: 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 tlsIO-2.8 {echo
4350: 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 server, loop 50
4360: 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f times, single co
4370: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
4380: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
4390: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
43a0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
43b0: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
43c0: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
43d0: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
43e0: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
43f0: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 20 20 20 20 ) ";:"] 0]].
4400: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
4410: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
4420: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
4430: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4440: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
4450: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4460: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4470: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4480: 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 rKey 8835 \]".
4490: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
44a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
44b0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
44c0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
44d0: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
44e0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
44f0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4500: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
4510: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
4520: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
4530: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
4540: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
4550: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
4560: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
4570: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
4580: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
4590: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
45a0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
45b0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
45c0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
45d0: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
45e0: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
45f0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
4600: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
4610: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
4620: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
4630: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
4640: 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 0000 "set x done
4650: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
4660: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4670: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
4680: 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d "done $i". }
4690: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
46a0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
46b0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
46c0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
46d0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
46e0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
46f0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4700: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4710: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4720: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4730: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
4740: 38 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8835]. fconfi
4750: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4760: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
4770: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
4780: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
4790: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
47a0: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
47b0: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
47c0: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
47d0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
47e0: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
47f0: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
4800: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4810: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
4820: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 .test tlsIO-2.9
4830: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
4840: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
4850: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
4860: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4870: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 r accept 8828].
4880: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4890: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
48a0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
48b0: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
48c0: 6e 65 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ne $f {..set aut
48d0: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
48e0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
48f0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
4900: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
4910: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
4920: 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b e tls..tls::sock
4930: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4940: 74 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 20 20 t 8828. }.
4950: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4960: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
4970: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
4980: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
4990: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
49a0: 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 after 100.
49b0: 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 set x [list [cat
49c0: 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 ch {close $f} ms
49d0: 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 g] [string range
49e0: 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 20 $msg 0 43]].
49f0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
4a00: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
4a10: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4a20: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4a30: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
4a40: 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 lsIO-2.10 {close
4a50: 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 on accept, acce
4a60: 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 pted socket live
4a70: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
4a80: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
4a90: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
4aa0: 72 20 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 20000 "set don
4ab0: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
4ac0: 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 set ss [tls::s
4ad0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4ae0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
4af0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4b00: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4b10: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
4b20: 79 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 y 8830]. proc
4b30: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
4b40: 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c {..global ss..cl
4b50: 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 ose $ss..fileeve
4b60: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
4b70: 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e readit $s"..fcon
4b80: 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 figure $s -trans
4b90: 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 lf. }. pr
4ba0: 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a oc readit {s} {.
4bb0: 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 .global done..ge
4bc0: 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a ts $s..close $s.
4bd0: 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 .set done 1.
4be0: 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c }. set cs [tl
4bf0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
4c00: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
4c10: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4c20: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
4c30: 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 entKey [info hos
4c40: 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 tname] 8830].
4c50: 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 close $cs..
4c60: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
4c70: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
4c80: 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a er. set done.
4c90: 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d } 1..test tlsIO-
4ca0: 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 2.11 {detecting
4cb0: 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 new data} {socke
4cc0: 74 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 t} {. proc ac
4cd0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
4ce0: 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 global sock..# w
4cf0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
4d00: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
4d10: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
4d20: 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 sides need..# t
4d30: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
4d40: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
4d50: 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d ndshake. Also m
4d60: 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 ake sure..# to r
4d70: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
4d80: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
4d90: 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 ing mode...fconf
4da0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
4db0: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
4dc0: 6c 69 6e 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 line..set sock $
4dd0: 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 s..fileevent $s
4de0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 readable [list d
4df0: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a o_handshake $s].
4e00: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 }.. set s
4e10: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
4e20: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
4e30: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
4e40: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
4e50: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
4e60: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 34 le $serverKey 84
4e70: 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 00]. set sock
4e80: 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b "". set s2 [
4e90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
4ea0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
4eb0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4ec0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
4ed0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
4ee0: 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 23 20 77 .1 8400]. # w
4ef0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
4f00: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
4f10: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
4f20: 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 sides need.
4f30: 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 # to be non-bloc
4f40: 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 king for the TLS
4f50: 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f handshake Also
4f60: 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 make sure to.
4f70: 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 # return the c
4f80: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
4f90: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 uffering mode (T
4fa0: 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e LS sets it to 'n
4fb0: 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 one').. fconf
4fc0: 69 67 75 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b igure $s2 -block
4fd0: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
4fe0: 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 line. vwait
4ff0: 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 sock. puts $s
5000: 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 2 one. flush
5010: 24 73 32 0a 20 20 20 20 23 20 6e 65 65 64 20 75 $s2. # need u
5020: 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 pdate to complet
5030: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
5040: 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 in-process. u
5050: 70 64 61 74 65 0a 20 20 20 20 61 66 74 65 72 20 pdate. after
5060: 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 500. fconfigu
5070: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
5080: 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 ng 0. set res
5090: 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 ult a:[gets $soc
50a0: 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 k]. lappend r
50b0: 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 esult b:[gets $s
50c0: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
50d0: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
50e0: 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 ing 1. puts $
50f0: 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 s2 two. flush
5100: 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 $s2. fconfig
5110: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
5120: 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e ing 0. lappen
5130: 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 d result c:[gets
5140: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e $sock]. fcon
5150: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
5160: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f ocking 1. clo
5170: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
5180: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
5190: 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 ock. set resu
51a0: 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 lt.} {a:one b: c
51b0: 3a 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 :two}..test tlsI
51c0: 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e O-2.12 {tcp conn
51d0: 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 ection; no certi
51e0: 66 69 63 61 74 65 73 20 73 70 65 63 69 66 69 65 ficates specifie
51f0: 64 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 74 d} \..{socket st
5200: 64 69 6f 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a dio unixOnly} {.
5210: 20 20 20 20 23 20 54 68 65 72 65 20 69 73 20 61 # There is a
5220: 20 64 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e debug assertion
5230: 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 on Windows/SSL
5240: 74 68 61 74 20 63 61 75 73 65 73 20 61 20 63 72 that causes a cr
5250: 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 ash when the.
5260: 20 23 20 63 65 72 74 69 66 69 63 61 74 65 20 69 # certificate i
5270: 73 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a sn't specified..
5280: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5290: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
52a0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
52b0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
52c0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
52d0: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
52e0: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
52f0: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
5300: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
5310: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
5320: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
5330: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5340: 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c out"]..set f [tl
5350: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5360: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
5370: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
5380: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
5390: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
53a0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
53b0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
53c0: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
53d0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
53e0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
53f0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
5400: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
5410: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5420: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
5430: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5440: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
5450: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
5460: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
5470: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
5480: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
5490: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
54a0: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
54b0: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
54c0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
54d0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
54e0: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
54f0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
5500: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5510: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
5520: 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c one {}}..test tl
5530: 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 sIO-3.1 {socket
5540: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
5550: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
5560: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5570: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5580: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5590: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
55a0: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
55b0: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
55c0: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
55d0: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
55e0: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
55f0: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
5600: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
5610: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
5620: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
5630: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
5640: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5650: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
5660: 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
5670: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
5680: 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 uts ready..gets
5690: 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a stdin..close $f.
56a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
56b0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
56c0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
56d0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
56e0: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
56f0: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
5700: 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b x [list [catch {
5710: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5720: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5730: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5740: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5750: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
5760: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
5770: 70 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 5c 0a pt 8828} msg] \.
5780: 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 ..$msg]. puts
5790: 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 $f bye. clos
57a0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
57b0: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
57c0: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
57d0: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
57e0: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
57f0: 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 3.2 {server with
5800: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
5810: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
5820: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
5830: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5840: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
5850: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
5860: 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 ..set auto_path
5870: 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 [linsert $auto_p
5880: 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 ath 0 [lindex [s
5890: 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 plit $env(PATH)
58a0: 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 ";:"] 0]]..packa
58b0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
58c0: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
58d0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
58e0: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b _out"]..set t2 [
58f0: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
5900: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
5910: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
5920: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
5930: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e _out"]..set coun
5940: 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 ter 0. }.
5950: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
5960: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
5970: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
5980: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
5990: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
59a0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
59b0: 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 erKey 8828 \]".
59c0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
59d0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
59e0: 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 } {.. fileeve
59f0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
5a00: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
5a10: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5a20: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5a30: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
5a40: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
5a50: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
5a60: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
5a70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
5a80: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
5aa0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
5ab0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
5ac0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
5ad0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5ae0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
5af0: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
5b00: 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 }..}..puts re
5b10: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5b20: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 ter cancel $t1..
5b30: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5b40: 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 ancel $t2..vwait
5b50: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5b60: 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 $t3..close $s..
5b70: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
5b80: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
5b90: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
5ba0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5bb0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5bc0: 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 r+]. set x [g
5bd0: 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 ets $f]. set
5be0: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
5bf0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5c00: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5c10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5c20: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
5c30: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
5c40: 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 8828]. fcon
5c50: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
5c60: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
5c70: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
5c80: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
5c90: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5ca0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5cb0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5cc0: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5cd0: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
5ce0: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
5cf0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5d00: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
5d10: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5d20: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5d30: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5d40: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5d50: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5d60: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
5d70: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
5d80: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5d90: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
5da0: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
5db0: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
5dc0: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
5dd0: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5de0: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
5df0: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
5e00: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
5e10: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5e20: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
5e30: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
5e40: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
5e50: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
5e60: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
5e70: 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 {ready done}..t
5e80: 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 est tlsIO-4.1 {s
5e90: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
5ea0: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
5eb0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
5ec0: 20 23 20 68 61 76 65 20 73 65 65 6e 20 69 6e 74 # have seen int
5ed0: 65 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 73 20 ermittent hangs
5ee0: 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 72 on Windows. r
5ef0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5f00: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5f10: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5f20: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
5f30: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
5f40: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
5f50: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
5f60: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
5f70: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
5f80: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
5f90: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
5fa0: 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c s $f "set s \[tl
5fb0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
5fc0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5fd0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5fe0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5ff0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
6000: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
6010: 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 $f {..fconfigure
6020: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
6030: 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 ine..for {set i
6040: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
6050: 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 ncr i} {.. pu
6060: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 ts $s hello..
6070: 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f gets $s..}..clo
6080: 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 0a se $s..puts bye.
6090: 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 .gets stdin.
60a0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
60b0: 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 set p1 [open
60c0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
60d0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
60e0: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
60f0: 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 66 nfigure $p1 -buf
6100: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
6110: 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b set p2 [open "|[
6120: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
6130: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
6140: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
6150: 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 72 gure $p2 -buffer
6160: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
6170: 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p3 [open "|[lis
6180: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6190: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
61a0: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
61b0: 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e 67 e $p3 -buffering
61c0: 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 line. proc a
61d0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
61e0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
61f0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
6200: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
6210: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
6220: 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 $s]. }. p
6230: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
6240: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
6250: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
6260: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f . if {[eo
6270: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
6280: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
6290: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
62a0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 65 done. } e
62b0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 lse {.
62c0: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
62d0: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 }. }.
62e0: 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 set t1 [after 3
62f0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6300: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
6310: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
6320: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
6330: 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 "]. set t3 [a
6340: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
6350: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
6360: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6370: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
6380: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
6390: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
63a0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
63b0: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
63c0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 rver accept 8828
63d0: 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f ]. puts $p1 o
63e0: 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 pen. puts $p2
63f0: 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 open. puts $
6400: 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 p3 open. vwai
6410: 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a t x. vwait x.
6420: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
6430: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
6440: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6450: 6c 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 l $t2. after
6460: 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 cancel $t3. c
6470: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
6480: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
6490: 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 l [list p1 [get
64a0: 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c s $p1] $x]. l
64b0: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
64c0: 32 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 2 [gets $p2] $x]
64d0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
64e0: 6c 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 list p3 [gets $p
64f0: 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 3] $x]. puts
6500: 24 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p1 bye. puts
6510: 20 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 $p2 bye. put
6520: 73 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c s $p3 bye. cl
6530: 6f 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 ose $p1. clos
6540: 65 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $p2. close
6550: 24 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 $p3. set l.}
6560: 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b {{p1 bye done} {
6570: 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 p2 bye done} {p3
6580: 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 bye done}}..tes
6590: 74 20 74 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 t tlsIO-4.2 {byt
65a0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
65b0: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
65c0: 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 , htons} {socket
65d0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b } {. set x ok
65e0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
65f0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
6600: 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 rver dodo 0x3000
6610: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
6620: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
6630: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 {..close $msg.
6640: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
6650: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
6660: 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.1 {byte order
6670: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
6680: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
6690: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 \..{socket unix
66a0: 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a Only notRoot} {.
66b0: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
66c0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
66d0: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 not owner}.
66e0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
66f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6700: 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d dodo 0x1} msg]}
6710: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
6720: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
6730: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
6740: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
6750: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
6760: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
6770: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
6780: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
6790: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 et: not owner}.t
67a0: 65 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 est tlsIO-5.2 {b
67b0: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
67c0: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
67d0: 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b rs, htons} {sock
67e0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 et} {. set x
67f0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
6800: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
6810: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 er too high}.
6820: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
6830: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6840: 72 20 64 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 r dodo 0x10000}
6850: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b msg]} {..set x {
6860: 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 port resolution
6870: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
6880: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 be disallowed}..
6890: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
68a0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
68b0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
68c0: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 et: port number
68d0: 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 20 74 too high}.test t
68e0: 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f lsIO-5.3 {byte o
68f0: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
6900: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
6910: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
6920: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
6930: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
6940: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
6950: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
6960: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
6970: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
6980: 65 72 76 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d erver dodo 21} m
6990: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 sg]} {..set x {h
69a0: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tons problem, sh
69b0: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
69c0: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e ed, are you runn
69d0: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f ing as SU?}..clo
69e0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
69f0: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
6a00: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
6a10: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 not owner}..tes
6a20: 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 t tlsIO-6.1 {acc
6a30: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
6a40: 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 or} {socket stdi
6a50: 6f 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 o} {. # There
6a60: 20 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65 is a debug asse
6a70: 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 rtion on Windows
6a80: 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 /SSL that causes
6a90: 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 a crash when th
6aa0: 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63 e. # certific
6ab0: 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 ate isn't specif
6ac0: 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 ied.. removeF
6ad0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
6ae0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
6af0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
6b00: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
6b10: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
6b20: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
6b30: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
6b40: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 20 20 20 20 ) ";:"] 0]].
6b50: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
6b60: 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e tls..gets stdin
6b70: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
6b80: 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f $f [list tls::so
6b90: 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 cket -cafile $ca
6ba0: 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 Cert 127.0.0.1 8
6bb0: 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 848]. close $
6bc0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
6bd0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
6be0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
6bf0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 70 ript]" r+]. p
6c00: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
6c10: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
6c20: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
6c30: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6c40: 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 {s a p} {expr 10
6c50: 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 73 20 / 0}. set s
6c60: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
6c70: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 rver accept \..
6c80: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
6c90: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6ca0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6cb0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 34 e $serverKey 884
6cc0: 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 8]. puts $f h
6cd0: 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 ello. close $
6ce0: 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 f. set timer
6cf0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
6d00: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
6d10: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
6d20: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
6d30: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
6d40: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
6d50: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
6d60: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
6d70: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ero}}..test tlsI
6d80: 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 O-7.1 {testing s
6d90: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
6da0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
6db0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
6dc0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
6dd0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
6de0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
6df0: 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f s $f {..set auto
6e00: 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 _path [linsert $
6e10: 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e auto_path 0 [lin
6e20: 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 dex [split $env(
6e30: 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a PATH) ";:"] 0]].
6e40: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
6e50: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
6e60: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 uts $f [list tls
6e70: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6e80: 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d accept \.. -
6e90: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6ea0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6eb0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6ec0: 65 72 76 65 72 4b 65 79 20 38 38 32 30 5d 0a 20 erverKey 8820].
6ed0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
6ee0: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
6ef0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
6f00: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
6f10: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
6f20: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
6f30: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
6f40: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
6f50: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
6f60: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
6f70: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6f80: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6f90: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6fa0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6fb0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
6fc0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6fd0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
6fe0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
6ff0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7000: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7010: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
7020: 2e 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 .0.0.1 8820].
7030: 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 set p [fconfigu
7040: 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d re $s -peername]
7050: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7060: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
7070: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
7080: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f end l [string co
7090: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 mpare [lindex $p
70a0: 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 0] 127.0.0.1].
70b0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
70c0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
70d0: 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d ndex $p 2] 8820]
70e0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
70f0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 llength $p].} {0
7100: 20 30 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 0 3}..test tlsI
7110: 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 O-7.2 {testing s
7120: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
7130: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
7140: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
7150: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
7160: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
7170: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
7180: 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f s $f {..set auto
7190: 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 _path [linsert $
71a0: 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e auto_path 0 [lin
71b0: 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 dex [split $env(
71c0: 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a PATH) ";:"] 0]].
71d0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
71e0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
71f0: 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 uts $f "tls::soc
7200: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7210: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
7220: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
7230: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7240: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
7250: 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 1". puts $f {
7260: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
7270: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
7280: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
7290: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
72a0: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
72b0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
72c0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
72d0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
72e0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
72f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
7300: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
7310: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
7320: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
7330: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
7340: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
7350: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
7360: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
7370: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
7380: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7390: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
73a0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 127.0.0.1 8821]
73b0: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
73c0: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
73d0: 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 ame]. close $
73e0: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 s. close $f.
73f0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
7400: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
7410: 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 th $p]. lappe
7420: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
7430: 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 0]. lappend l
7440: 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b [string equal [
7450: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 lindex $p 2] 882
7460: 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 1].} {3 127.0.0.
7470: 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 1 0}..test tlsIO
7480: 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.3 {testing so
7490: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
74a0: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 tions} {socket}
74b0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
74c0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
74d0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
74e0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
74f0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7500: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
7510: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 rver accept 8822
7520: 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 6c 65 ]. set l [lle
7530: 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 72 65 ngth [fconfigure
7540: 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s]]. close
7550: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 $s. update.
7560: 20 20 23 20 41 20 62 75 67 20 66 69 78 65 64 20 # A bug fixed
7570: 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 66 6f in fconfigure fo
7580: 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 74 68 r 8.3.4+ make th
7590: 69 73 20 72 65 74 75 72 6e 20 31 34 20 6e 6f 72 is return 14 nor
75a0: 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 75 74 mally,. # but
75b0: 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 65 72 12 in older ver
75c0: 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 72 20 sions.. expr
75d0: 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 28 24 {$l >= 12 && (($
75e0: 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 l % 2) == 0)}.}
75f0: 31 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 1..# bug report
7600: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
7610: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
7620: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
7630: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
7640: 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 O-7.4 {testing s
7650: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
7660: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d ptions} {socket}
7670: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
7680: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
7690: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
76a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
76b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
76c0: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
76d0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
76e0: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
76f0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7700: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
7710: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
7720: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
7730: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
7740: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
7750: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
7760: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7770: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7780: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
7790: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
77a0: 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 73 65 me] 8823]. se
77b0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
77c0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
77d0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
77e0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
77f0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
7800: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7810: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
7820: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
7830: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 l [lindex $x 2]
7840: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
7850: 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 72 8823 3}..# bug r
7860: 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e eport #5812 fcon
7870: 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 figure doesn't r
7880: 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 eturn value for
7890: 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 '-sockname'..tes
78a0: 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 73 t tlsIO-7.5 {tes
78b0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
78c0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
78d0: 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 7d 20 ocket unixOrPc}
78e0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
78f0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
7900: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
7910: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
7920: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7930: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
7940: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7950: 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 8829]. proc a
7960: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7970: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
7980: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
7990: 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 -sockname]..clos
79a0: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $s. }. s
79b0: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
79c0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
79d0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
79e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
79f0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
7a00: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
7a10: 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 73 .0.1 8829]. s
7a20: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
7a30: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
7a40: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
7a50: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
7a60: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
7a70: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
7a80: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
7a90: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
7aa0: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d l [lindex $x 0]
7ab0: 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b [lindex $x 2] [
7ac0: 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 llength $x].} {1
7ad0: 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 7d 27.0.0.1 8829 3}
7ae0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e 31 ..test tlsIO-8.1
7af0: 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 {testing -async
7b00: 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 flag on sockets
7b10: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
7b20: 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 74 65 # NOTE: This te
7b30: 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e 20 73 st may fail on s
7b40: 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e 34 20 ome Solaris 2.4
7b50: 73 79 73 74 65 6d 73 2e 0a 20 20 20 20 23 20 53 systems.. # S
7b60: 65 65 20 6e 6f 74 65 73 20 69 6e 20 54 63 6c 27 ee notes in Tcl'
7b70: 73 20 73 6f 63 6b 65 74 2e 74 65 73 74 2e 0a 20 s socket.test..
7b80: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
7b90: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
7ba0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
7bb0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7bc0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
7bd0: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
7be0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
7bf0: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
7c00: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7c10: 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 6e 20 64 obal x..# when d
7c20: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
7c30: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
7c40: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
7c50: 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 20 s need..# to be
7c60: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 non-blocking for
7c70: 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 the TLS handsha
7c80: 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 ke. Also make s
7c90: 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 72 6e ure..# to return
7ca0: 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 the channel to
7cb0: 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d line buffering m
7cc0: 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 ode...fconfigure
7cd0: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
7ce0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7cf0: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 23 20 .puts $s bye..#
7d00: 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 30 2e 39 Only OpenSSL 0.9
7d10: 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 73 20 73 .5a on Windows s
7d20: 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 74 68 65 eems to need the
7d30: 20 61 66 74 65 72 20 28 64 65 6c 61 79 65 64 29 after (delayed)
7d40: 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 74 20 69 ..# close, but i
7d50: 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 74 68 65 t works just the
7d60: 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c 20 6f 74 same for all ot
7d70: 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a 09 61 66 hers. -hobbs..af
7d80: 74 65 72 20 35 30 30 20 63 6c 6f 73 65 20 24 73 ter 500 close $s
7d90: 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 ..set x done.
7da0: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
7db0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
7dc0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
7dd0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
7de0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7df0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
7e00: 20 20 20 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 -async [info
7e10: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a hostname] 8830].
7e20: 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 # when doing
7e30: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
7e40: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
7e50: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
7e60: 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e ed. # to be n
7e70: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
7e80: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
7e90: 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 e Also make sur
7ea0: 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 e to. # retur
7eb0: 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f n the channel to
7ec0: 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 line buffering
7ed0: 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 mode (TLS sets i
7ee0: 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 t to 'none')..
7ef0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
7f00: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
7f10: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
7f20: 20 76 77 61 69 74 20 78 0a 20 20 20 20 23 20 54 vwait x. # T
7f30: 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e LS handshaking n
7f40: 65 65 64 73 20 6f 6e 65 20 62 79 74 65 20 66 72 eeds one byte fr
7f50: 6f 6d 20 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e om the client...
7f60: 0a 20 20 20 20 70 75 74 73 20 24 73 31 20 61 0a . puts $s1 a.
7f70: 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 # need updat
7f80: 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c e to complete TL
7f90: 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 S handshake in-p
7fa0: 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 rocess. updat
7fb0: 65 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 e. set z [get
7fc0: 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 s $s1]. close
7fd0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
7fe0: 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 1. set z.} by
7ff0: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e e..test tlsIO-9.
8000: 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 1 {testing spuri
8010: 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 ous events} {soc
8020: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c ket} {. set l
8030: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
8040: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
8050: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
8060: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
8070: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
8080: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
8090: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
80a0: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
80b0: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
80c0: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
80d0: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
80e0: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
80f0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
8100: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
8110: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
8120: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
8130: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
8140: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
8150: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8160: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8170: 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 locking 0..filee
8180: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
8190: 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 [list do_handsh
81a0: 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 ake $s readable
81b0: 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d readlittle \...-
81c0: 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a buffering none].
81d0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
81e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
81f0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
8200: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8210: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8220: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8230: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
8240: 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 ept 8831]. se
8250: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8260: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8270: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8280: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8290: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
82a0: 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 y \.. [info h
82b0: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 ostname] 8831].
82c0: 20 20 20 23 20 54 68 69 73 20 64 69 66 66 65 72 # This differ
82d0: 73 20 66 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e s from socket-9.
82e0: 31 20 69 6e 20 74 68 61 74 20 62 6f 74 68 20 73 1 in that both s
82f0: 69 64 65 73 20 6e 65 65 64 20 74 6f 20 62 65 0a ides need to be.
8300: 20 20 20 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 # non-blocki
8310: 6e 67 20 62 65 63 61 75 73 65 20 6f 66 20 54 4c ng because of TL
8320: 53 27 20 72 65 71 75 69 72 65 64 20 68 61 6e 64 S' required hand
8330: 73 68 61 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 shake. fconfi
8340: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
8350: 67 20 30 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f g 0. puts -no
8360: 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 33 34 newline $c 01234
8370: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
8380: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
8390: 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 20 20 7890123456789.
83a0: 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 close $c. s
83b0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
83c0: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
83d0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
83e0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
83f0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
8400: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
8410: 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f list $spurio
8420: 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d us $len.} {0 50}
8430: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 ..test tlsIO-9.2
8440: 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 {testing async
8450: 77 72 69 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 write, fileevent
8460: 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 s, flush on clos
8470: 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 e} {socket} {.
8480: 20 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b set firstblock
8490: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
84a0: 61 20 33 31 5d 0a 20 20 20 20 73 65 74 20 73 65 a 31]. set se
84b0: 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e condblock [strin
84c0: 67 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 g repeat b 65535
84d0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
84e0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
84f0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
8500: 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e king 0..fileeven
8510: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
8520: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
8530: 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 $s readable rea
8540: 64 61 62 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 dable \...-trans
8550: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
8560: 72 73 69 7a 65 20 31 36 33 38 34 20 2d 62 75 66 rsize 16384 -buf
8570: 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 fering line].
8580: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 }. proc read
8590: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 able {s} {..set
85a0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 64 70 75 l [gets $s]..dpu
85b0: 74 73 20 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e ts "got \"[strin
85c0: 67 20 72 65 70 6c 61 63 65 20 24 6c 20 31 30 20 g replace $l 10
85d0: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
85e0: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
85f0: 20 24 6c 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 $l]) from $s"..
8600: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
8610: 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 dable {}..after
8620: 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 1000 respond $s.
8630: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
8640: 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c espond {s} {..gl
8650: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a obal firstblock.
8660: 09 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b .dputs "send \"[
8670: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
8680: 66 69 72 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e firstblock 10 en
8690: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
86a0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
86b0: 66 69 72 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 firstblock]) dow
86c0: 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e n $s"..puts -non
86d0: 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 ewline $s $first
86e0: 62 6c 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 30 block..after 100
86f0: 30 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 20 0 writedata $s.
8700: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 }. proc wr
8710: 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 itedata {s} {..g
8720: 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 lobal secondbloc
8730: 6b 0a 09 64 70 75 74 73 20 22 73 65 6e 64 20 5c k..dputs "send \
8740: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8750: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 $secondblock 10
8760: 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a end-3 ...]\" \.
8770: 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 ..([string lengt
8780: 68 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 h $secondblock])
8790: 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 20 down $s"..puts
87a0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 -nonewline $s $s
87b0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 econdblock..clos
87c0: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $s. }. s
87d0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
87e0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
87f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8800: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8810: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8820: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
8830: 72 20 61 63 63 65 70 74 20 38 38 33 32 5d 0a 20 r accept 8832].
8840: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
8850: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8860: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8870: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8880: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8890: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 entKey \.. [i
88a0: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
88b0: 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 32]. fconfigu
88c0: 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $c -blocking
88d0: 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 0 -trans lf -buf
88e0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
88f0: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
8900: 70 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 puts $c hello.
8910: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
8920: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
8930: 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 t done..set data
8940: 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 75 74 [read $s]..dput
8950: 73 20 22 72 65 61 64 20 5c 22 5b 73 74 72 69 6e s "read \"[strin
8960: 67 20 72 65 70 6c 61 63 65 20 24 64 61 74 61 20 g replace $data
8970: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8980: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8990: 67 74 68 20 24 64 61 74 61 5d 29 20 66 72 6f 6d gth $data]) from
89a0: 20 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 $s"..incr count
89b0: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
89c0: 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 $data]..if {[eof
89d0: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f $s]} {.. clo
89e0: 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 se $s.. set d
89f0: 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 one 1..}. }.
8a00: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 fileevent $c
8a10: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
8a20: 20 24 63 22 0a 20 20 20 20 73 65 74 20 64 6f 6e $c". set don
8a30: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
8a40: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
8a50: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
8a60: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
8a70: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
8a80: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
8a90: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 close $s. lis
8aa0: 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d t $count $done.}
8ab0: 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 {65566 1}..test
8ac0: 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 tlsIO-9.3 {test
8ad0: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
8ae0: 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ss} {unexplained
8af0: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 Failure socket}
8b00: 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e {. # HOBBS: n
8b10: 65 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 ever worked corr
8b20: 65 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 ectly. proc c
8b30: 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 ount_to_eof {s}
8b40: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
8b50: 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 done timer..set
8b60: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
8b70: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
8b80: 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 incr count..
8b90: 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 if {$count > 9
8ba0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
8bb0: 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 .set done true..
8bc0: 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 .set count {eof
8bd0: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
8be0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
8bf0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
8c00: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 . proc timerp
8c10: 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c roc {} {..global
8c20: 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 done count c..s
8c30: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 et done true..se
8c40: 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 t count {timer w
8c50: 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 ent off, eof is
8c60: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f not sticky}..clo
8c70: 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 se $c. }..
8c80: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
8c90: 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a set done false.
8ca0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 proc write_t
8cb0: 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a hen_close {s} {.
8cc0: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c .puts $s bye..cl
8cd0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
8ce0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
8cf0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
8d00: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
8d10: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
8d20: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
8d30: 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 f..fileevent $s
8d40: 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 writable [list d
8d50: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 77 o_handshake $s w
8d60: 72 69 74 61 62 6c 65 20 77 72 69 74 65 5f 74 68 ritable write_th
8d70: 65 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 en_close \...-bu
8d80: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8d90: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 anslation lf].
8da0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
8db0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8dc0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
8dd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
8de0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8df0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
8e00: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
8e10: 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 t 8833]. set
8e20: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
8e30: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8e40: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8e50: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8e60: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8e70: 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 \.. [info hos
8e80: 74 6e 61 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 tname] 8833].
8e90: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
8ea0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
8eb0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
8ec0: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 slation lf. f
8ed0: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
8ee0: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 able "count_to_e
8ef0: 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 of $c". set t
8f00: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
8f10: 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 timerproc].
8f20: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 vwait done. c
8f30: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
8f40: 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 count.} {eof is
8f50: 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 sticky}..removeF
8f60: 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 ile script..test
8f70: 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 tlsIO-10.1 {tes
8f80: 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 ting socket acce
8f90: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
8fa0: 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 r handling} {soc
8fb0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 ket} {. set g
8fc0: 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 oterror 0. pr
8fd0: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
8fe0: 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 {global goterror
8ff0: 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 ; set goterror 1
9000: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
9010: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
9020: 20 24 63 61 43 65 72 74 20 2d 73 65 72 76 65 72 $caCert -server
9030: 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 20 accept 8898].
9040: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
9050: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b a p} {close $s;
9060: 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 error}. set
9070: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d c [tls::socket -
9080: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 cafile $caCert 1
9090: 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 27.0.0.1 8898].
90a0: 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f vwait goterro
90b0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
90c0: 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 close $c.
90d0: 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 set goterror.} 1
90e0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
90f0: 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 1 {tcp connectio
9100: 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 n} {socket doTes
9110: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9120: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
9130: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
9140: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
9150: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
9160: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
9170: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
9180: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
9190: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
91a0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
91b0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
91c0: 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 8834]..proc acce
91d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
91e0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
91f0: 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 $s.. puts $s
9200: 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 done.. close
9210: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
9220: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
9230: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9240: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9250: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9260: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9270: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9280: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 oteServerIP 8834
9290: 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 ]. set r [get
92a0: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
92b0: 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $s. sendComma
92c0: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
92d0: 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_1_test_server
92e0: 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f }. set r.} do
92f0: 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ne..test tlsIO-1
9300: 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 1.2 {client spec
9310: 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 ifies its port}
9320: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9330: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9340: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f {. if {[info
9350: 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b exists port]} {
9360: 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 ..incr port.
9370: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f } else {..set po
9380: 72 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 rt [expr {$tlsSe
9390: 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d rverPort + [pid]
93a0: 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 %1024}]. }.
93b0: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
93c0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
93d0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
93e0: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
93f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
9400: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
9410: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9420: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9430: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9440: 72 76 65 72 4b 65 79 20 38 38 33 35 5d 0a 09 70 rverKey 8835]..p
9450: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9460: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
9470: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
9480: 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 puts $s $p..
9490: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
94a0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
94b0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
94c0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
94d0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
94e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
94f0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9500: 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 -myport $port
9510: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9520: 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 8835]. set r
9530: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c [gets $s]. cl
9540: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 ose $s. sendC
9550: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
9560: 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 ocket9_2_test_se
9570: 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 rver}. if {$r
9580: 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 == $port} {..se
9590: 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 t result ok.
95a0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
95b0: 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 sult broken.
95c0: 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 }. set result
95d0: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
95e0: 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 O-11.3 {trying t
95f0: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
9600: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
9610: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9620: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
9630: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
9640: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
9650: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
9660: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9670: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9680: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9690: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
96a0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
96b0: 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 rverIp 8836]}]}
96c0: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
96d0: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
96e0: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
96f0: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
9700: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
9710: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
9720: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
9730: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
9740: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
9750: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9760: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
9770: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
9780: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
9790: 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 socket10_6_test
97a0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
97b0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
97c0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
97d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
97e0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
97f0: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
9800: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
9810: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
9820: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
9830: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
9840: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
9850: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
9860: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
9870: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
9880: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
9890: 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f ion crlf..}..pro
98a0: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
98b0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
98c0: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
98d0: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
98e0: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
98f0: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
9900: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
9910: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
9920: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9930: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9940: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9950: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9960: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9970: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
9980: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
9990: 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $f -translation
99a0: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
99b0: 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 line. puts $
99c0: 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 f hello. set
99d0: 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 r [gets $f].
99e0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e close $f. sen
99f0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9a00: 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 $socket10_6_test
9a10: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
9a20: 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 r.} hello..test
9a30: 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d tlsIO-11.5 {rem
9a40: 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e ote echo, 50 lin
9a50: 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 es} {socket doTe
9a60: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9a70: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
9a80: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
9a90: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
9aa0: 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 socket10_7_test
9ab0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
9ac0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9ad0: 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ept \...-certfil
9ae0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
9af0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9b00: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
9b10: 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 y 8836]..proc ac
9b20: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9b30: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9b40: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
9b50: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9b60: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9b70: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9b80: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9b90: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
9ba0: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
9bb0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
9bc0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
9bd0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
9be0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
9bf0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
9c00: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
9c10: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9c20: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
9c30: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9c40: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9c50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9c60: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9c70: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9c80: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9c90: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
9ca0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
9cb0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
9cc0: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 e. for {set c
9cd0: 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 nt 0} {$cnt < 50
9ce0: 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 } {incr cnt} {..
9cf0: 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 puts $f "hello,
9d00: 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 $cnt"..if {[stri
9d10: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 ng compare [gets
9d20: 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e $f] "hello, $cn
9d30: 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 t"] != 0} {..
9d40: 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a break..}. }.
9d50: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
9d60: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9d70: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f ose $socket10_7_
9d80: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
9d90: 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 set cnt.} 50..#
9da0: 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 Macintosh socke
9db0: 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 ts can have more
9dc0: 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 than one server
9dd0: 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 per port.if {$t
9de0: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
9df0: 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 form) == "macint
9e00: 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 osh"} {. set
9e10: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
9e20: 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0 8836}.} else {
9e30: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
9e40: 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c tResult {1 {coul
9e50: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
9e60: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
9e70: 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 y in use}}.}..te
9e80: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 st tlsIO-11.6 {s
9e90: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
9ea0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9eb0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9ec0: 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 {. set s1 [t
9ed0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9ee0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
9ef0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9f00: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9f10: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9f20: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9f30: 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b t 8836]. if {
9f40: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b [catch {set s2 [
9f50: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9f60: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
9f70: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9f80: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9f90: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9fa0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
9fb0: 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 pt 8836]} msg]}
9fc0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
9fd0: 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 ist 1 $msg].
9fe0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
9ff0: 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 sult [list 0 [li
a000: 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 ndex [fconfigure
a010: 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 $s2 -sockname]
a020: 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 2]]..close $s2.
a030: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a040: 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c s1. set resul
a050: 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 t.} $conflictRes
a060: 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ult..test tlsIO-
a070: 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 11.7 {server wit
a080: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
a090: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a0a0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a0b0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
a0c0: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
a0d0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
a0e0: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
a0f0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
a100: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a110: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
a120: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a130: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
a140: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 y \...-server ac
a150: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 cept 8836]..proc
a160: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
a170: 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 {.. fconfigur
a180: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
a190: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
a1a0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
a1b0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
a1c0: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
a1d0: 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 {.. set l [g
a1e0: 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 ets $s].. if
a1f0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
a200: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
a210: 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 lse {...puts $s
a220: 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $l.. }..}.
a230: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
a240: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a250: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a260: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a270: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a280: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
a290: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
a2a0: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
a2b0: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 nfigure $s1 -buf
a2c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
a2d0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
a2e0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
a2f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a300: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a310: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a320: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
a330: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
a340: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
a350: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
a360: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
a370: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a380: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a390: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a3a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a3b0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a3c0: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a3d0: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
a3e0: 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 configure $s3 -b
a3f0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
a400: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
a410: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
a420: 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 i} {..puts $s1
a430: 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 hello,s1..gets $
a440: 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c s1..puts $s2 hel
a450: 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a lo,s2..gets $s2.
a460: 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c .puts $s3 hello,
a470: 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 s3..gets $s3.
a480: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 }. close $s1
a490: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 . close $s2.
a4a0: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 close $s3.
a4b0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a4c0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f ose $socket10_9_
a4d0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
a4e0: 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 set i.} 100
a4f0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a500: 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 8 {client with s
a510: 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 everal servers}
a520: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a530: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a540: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
a550: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
a560: 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a 69 6e mmand {..tls::in
a570: 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 it -certfile $se
a580: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
a590: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a5a0: 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 73 65 e $serverKey..se
a5b0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
a5c0: 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 t -server "accep
a5d0: 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73 t 4003" 4003]..s
a5e0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
a5f0: 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 et -server "acce
a600: 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09 pt 4004" 4004]..
a610: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a620: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a630: 65 70 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a ept 4005" 4005].
a640: 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 .proc handshake
a650: 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 69 66 {s mp} {.. if
a660: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
a670: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
a680: 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b elseif {[catch {
a690: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
a6a0: 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 s} result]} {...
a6b0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
a6c0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d e normal... }
a6d0: 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 elseif {$result
a6e0: 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e == 1} {...# Han
a6f0: 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a dshake complete.
a700: 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
a710: 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 75 74 eadable ""...put
a720: 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f 73 65 s $s $mp...close
a730: 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 $s.. }..}..p
a740: 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 roc accept {mp s
a750: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 20 54 a p} {.. # T
a760: 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 63 63 hese have to acc
a770: 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 ept non-blocking
a780: 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 68 61 , because the ha
a790: 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 20 23 ndshaking.. #
a7a0: 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 65 74 order isn't det
a7b0: 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 20 20 erministic..
a7c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
a7d0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
a7e0: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
a7f0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
a800: 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 able [list hands
a810: 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 7d 0a hake $s $mp]..}.
a820: 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a 3a 69 }. tls::i
a830: 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 nit -certfile $c
a840: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a850: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a860: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a 20 20 le $clientKey.
a870: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
a880: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a890: 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 verIP 4003].
a8a0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
a8b0: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
a8c0: 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65 rIP 4004]. se
a8d0: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
a8e0: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
a8f0: 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 20 P 4005]. set
a900: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
a910: 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 l [gets $s1] [g
a920: 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 ets $s1] [eof $s
a930: 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 1] [gets $s2] [g
a940: 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 ets $s2] [eof $s
a950: 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 2] \..[gets $s3]
a960: 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 [gets $s3] [eof
a970: 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s3]. close
a980: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
a990: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
a9a0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a9b0: 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c {..close $s1..cl
a9c0: 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 ose $s2..close $
a9d0: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s3. }. set
a9e0: 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 l.} {4003 {} 1
a9f0: 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 4004 {} 1 4005 {
aa00: 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f } 1}..test tlsIO
aa10: 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 61 -11.9 {accept ca
aa20: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
aa30: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
aa40: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
aa50: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
aa60: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
aa70: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
aa80: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
aa90: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
aaa0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
aab0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
aac0: 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 836]. proc ac
aad0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
aae0: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 pr 10 / 0}. p
aaf0: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
ab00: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
ab10: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
ab20: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
ab30: 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 es. if {[catc
ab40: 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b h {sendCommand {
ab50: 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 6e 61 .. set peerna
ab60: 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 me [fconfigure $
ab70: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 callerSocket -pe
ab80: 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 ername].. set
ab90: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
aba0: 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c \... -certfil
abb0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
abc0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
abd0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
abe0: 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e 64 65 y \... [linde
abf0: 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 38 x $peername 0] 8
ac00: 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 836].. close
ac10: 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d $s. . }} msg]
ac20: 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 } {..close $s..e
ac30: 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a rror $msg. }.
ac40: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
ac50: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
ac60: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
ac70: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
ac80: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
ac90: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
aca0: 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f rename bgerro
acb0: 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d r {}. set x.}
acc0: 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 {{divide by zer
acd0: 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d o}}..test tlsIO-
ace0: 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 20 73 11.10 {testing s
acf0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
ad00: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
ad10: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
ad20: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
ad30: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
ad40: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
ad50: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 .set socket10_12
ad60: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
ad70: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
ad80: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
ad90: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
ada0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
adb0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
adc0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
add0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
ade0: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d a p} {close $s}
adf0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
ae00: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
ae10: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
ae20: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
ae30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ae40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
ae50: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
ae60: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
ae70: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
ae80: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
ae90: 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 set n [fconf
aea0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
aeb0: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 me]. set l ""
aec0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
aed0: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c lindex $p 2] [ll
aee0: 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 ength $p] [lleng
aef0: 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 th $p]. close
af00: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
af10: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
af20: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
af30: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d ver}. set l.}
af40: 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 65 73 {8836 3 3}..tes
af50: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 7b 74 t tlsIO-11.11 {t
af60: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
af70: 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 events} {socket
af80: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
af90: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 eServer} {. #
afa0: 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 remote equivale
afb0: 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 73 65 nt of 9.1. se
afc0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
afd0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
afe0: 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 74 5f set socket_test_
aff0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
b000: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
b010: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
b020: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
b030: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b040: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
b050: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 61 6e 8836]..proc han
b060: 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 20 20 dshake {s} {..
b070: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
b080: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
b090: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 } elseif {[cat
b0a0: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
b0b0: 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 ke $s} result]}
b0c0: 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 {...# Some error
b0d0: 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 s are normal...
b0e0: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 } elseif {$re
b0f0: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 sult == 1} {...#
b100: 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c Handshake compl
b110: 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 ete...fileevent
b120: 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 0a 09 $s writable ""..
b130: 09 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65 .after 100 write
b140: 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 some $s.. }..
b150: 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b }..proc accept {
b160: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 s a p} {.. fc
b170: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
b180: 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c nslation "auto l
b190: 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e f".. fileeven
b1a0: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c t $s writable [l
b1b0: 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73 ist handshake $s
b1c0: 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 ]..}..proc write
b1d0: 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 some {s} {..
b1e0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
b1f0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
b200: 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c } {...puts $s "l
b210: 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f ine $i from remo
b220: 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 te server"..
b230: 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a }.. close $s.
b240: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b250: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 len 0. set s
b260: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 purious 0. se
b270: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
b280: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d c readlittle {s}
b290: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 {..global spuri
b2a0: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 ous done len..se
b2b0: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a t l [read $s 1].
b2c0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e .if {[string len
b2d0: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a gth $l] == 0} {.
b2e0: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 . if {![eof $
b2f0: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 s]} {...incr spu
b300: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 rious.. } els
b310: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 e {...close $s..
b320: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 .set done 1..
b330: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
b340: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 incr len [stri
b350: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d ng length $l]..}
b360: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
b370: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b380: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
b390: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
b3a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b3b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
b3c0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
b3d0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
b3e0: 23 20 47 65 74 20 74 68 65 20 62 75 66 66 65 72 # Get the buffer
b3f0: 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a 20 20 ing corrected.
b400: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
b410: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
b420: 20 20 20 20 23 20 50 75 74 20 61 20 62 79 74 65 # Put a byte
b430: 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 6e 74 into the client
b440: 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 65 72 pipe to trigger
b450: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 TLS handshaking
b460: 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 0a 20 . puts $c a.
b470: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 fileevent $c
b480: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 readable [list r
b490: 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a 20 20 eadlittle $c].
b4a0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
b4b0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
b4c0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
b4d0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
b4e0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
b4f0: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f timer. sendCo
b500: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
b510: 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72 cket_test_server
b520: 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 }. list $spur
b530: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 ious $len.} {0 2
b540: 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 690}..test tlsIO
b550: 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 -11.12 {testing
b560: 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 EOF stickyness}
b570: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c {unexplainedFail
b580: 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 ure socket doTes
b590: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
b5a0: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f er} {. # remo
b5b0: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 te equivalent of
b5c0: 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 42 53 9.3. # HOBBS
b5d0: 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 : never worked c
b5e0: 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 65 74 orrectly. set
b5f0: 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 73 counter 0. s
b600: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
b610: 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 oc count_up {s}
b620: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 {..global counte
b630: 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a r done after_id.
b640: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
b650: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
b660: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e {.. incr coun
b670: 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 6f ter.. if {$co
b680: 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73 unter > 9} {...s
b690: 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20 et done {EOF is
b6a0: 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 sticky}...after
b6b0: 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 64 cancel $after_id
b6c0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
b6d0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
b6e0: 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b proc timed_out {
b6f0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f } {..global c do
b700: 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 69 ne..set done {ti
b710: 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20 med_out, EOF is
b720: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f not sticky}..clo
b730: 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 se $c. }.
b740: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
b750: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b760: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
b770: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 4_test_server [t
b780: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
b790: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
b7a0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b7b0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
b7c0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
b7d0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
b7e0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
b7f0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
b800: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
b810: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 . after 100 c
b820: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b830: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
b840: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b850: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b860: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b870: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b880: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
b890: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b8a0: 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 8836]. fileev
b8b0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b8c0: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 "count_up $c".
b8d0: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b set after_id [
b8e0: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 after 1000 timed
b8f0: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 _out]. vwait
b900: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d done. sendCom
b910: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
b920: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b930: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f rver}. set do
b940: 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 ne.} {EOF is sti
b950: 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f cky}..test tlsIO
b960: 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 -11.13 {testing
b970: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 async write, asy
b980: 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 nc flush, async
b990: 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 close} \..{socke
b9a0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b9b0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b9c0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
b9d0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
b9e0: 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 done..set l [re
b9f0: 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 ad $s]..incr cou
ba00: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 nt [string lengt
ba10: 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 h $l]..if {[eof
ba20: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
ba30: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
ba40: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
ba50: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
ba60: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
ba70: 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f {..set firstblo
ba80: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 ck [string repea
ba90: 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 65 63 t a 31]..set sec
baa0: 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 ondblock [string
bab0: 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 5d repeat b 65535]
bac0: 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f ..set l [tls::so
bad0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
bae0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
baf0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
bb00: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
bb10: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
bb20: 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 72 6f ccept 8845]..pro
bb30: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
bb40: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
bb50: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
bb60: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
bb70: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
bb80: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
bb90: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 20 size 16384 \...
bba0: 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 -buffering li
bbb0: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
bbc0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
bbd0: 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 eadable $s"..}..
bbe0: 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 proc readable {s
bbf0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
bc00: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69 gets $s].. fi
bc10: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
bc20: 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 ble {}.. afte
bc30: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 r 1000 respond $
bc40: 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f s..}..proc respo
bc50: 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c nd {s} {.. gl
bc60: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a obal firstblock.
bc70: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
bc80: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c line $s $firstbl
bc90: 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31 ock.. after 1
bca0: 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73 000 writedata $s
bcb0: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64 ..}..proc writed
bcc0: 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 ata {s} {.. g
bcd0: 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 lobal secondbloc
bce0: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
bcf0: 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e ewline $s $secon
bd00: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 dblock.. clos
bd10: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
bd20: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
bd30: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
bd40: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
bd50: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
bd60: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
bd70: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
bd80: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 34 moteServerIP 884
bd90: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 5]. fconfigur
bda0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
bdb0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
bdc0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
bdd0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
bde0: 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
bdf0: 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 lo. fileevent
be00: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
be10: 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 adit $s". set
be20: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
be30: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
be40: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
be50: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
be60: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
be70: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
be80: 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 {close $l}.
be90: 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 set count.} 6556
bea0: 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 61 20 6..proc getdata
beb0: 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a 20 20 {type file} {.
bec0: 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 # Read handler
bed0: 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 on the accepted
bee0: 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 6c 6f socket.. glo
bef0: 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c bal x. global
bf00: 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 74 20 failed. set
bf10: 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 status [catch {r
bf20: 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d ead $file} data]
bf30: 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 75 73 . if {$status
bf40: 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 78 20 != 0} {..set x
bf50: 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 "read failed, er
bf60: 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 0a 09 ror was $data"..
bf70: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
bf80: 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ile }. } else
bf90: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
bfa0: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b are {} $data]} {
bfb0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
bfc0: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d fblocked $file]}
bfd0: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 {. } elseif
bfe0: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
bff0: 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a .if {$failed} {.
c000: 09 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70 . set x "$typ
c010: 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 e socket was inh
c020: 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 65 20 erited"..} else
c030: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74 {.. set x "$t
c040: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ype socket was n
c050: 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d ot inherited"..}
c060: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
c070: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
c080: 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70 se {..set x {imp
c090: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 63 ossible case}..c
c0a0: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
c0b0: 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 le }. }. r
c0c0: 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c eturn.}..test tl
c0d0: 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e sIO-12.1 {testin
c0e0: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
c0f0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d server sockets}
c100: 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b {socket exec} {
c110: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
c120: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b script1. mak
c130: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 eFile {} script2
c140: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
c150: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
c160: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
c170: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c180: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
c190: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
c1a0: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
c1b0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
c1c0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c1d0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
c1e0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
c1f0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c200: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c210: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
c220: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 ript2 creates th
c230: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c e server socket,
c240: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
c250: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 1,. # waits a
c260: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 second, and exi
c270: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 ts. The server
c280: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a socket will now.
c290: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 # be closed
c2a0: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 unless script1 i
c2b0: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 nherited it...
c2c0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c2d0: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c2e0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c2f0: 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a clsh $::tcltest:
c300: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
c310: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
c320: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
c330: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
c340: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
c350: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
c360: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
c370: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
c380: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
c390: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
c3a0: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 rver accept \..
c3b0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
c3c0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
c3d0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
c3e0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
c3f0: 38 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 8\]". puts $f
c400: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
c410: 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 { file addr port
c420: 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 } {.. close
c430: 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 $file..}..exec $
c440: 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a tclsh script1 &.
c450: 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 .close $f..after
c460: 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 1000 exit..vwai
c470: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c480: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c490: 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 # Launch scrip
c4a0: 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 t2 and wait 5 se
c4b0: 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 conds.. exec
c4c0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
c4d0: 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 est script2 &.
c4e0: 20 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 after 5000 { s
c4f0: 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 et ok_to_proceed
c500: 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 1 }. vwait o
c510: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 k_to_proceed..
c520: 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 # If we can st
c530: 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 ill connect to t
c540: 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 he server, the s
c550: 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 ocket got inheri
c560: 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 ted... if {[c
c570: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
c580: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
c590: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
c5a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c5b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
c5c0: 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 . . 127.0.0.1
c5d0: 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 8828} msg]} {..s
c5e0: 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 et x {server soc
c5f0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
c600: 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 rited}. } els
c610: 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a e {..close $msg.
c620: 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 .set x {server s
c630: 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 ocket was inheri
c640: 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 ted}. }..
c650: 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 set x.} {server
c660: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c670: 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 nherited}..test
c680: 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 74 tlsIO-12.2 {test
c690: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
c6a0: 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 of client socket
c6b0: 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d s} {socket exec}
c6c0: 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 {. makeFile
c6d0: 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d {} script1. m
c6e0: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
c6f0: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
c700: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
c710: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
c720: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
c730: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
c740: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
c750: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
c760: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
c770: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c780: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
c790: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
c7a0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
c7b0: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
c7c0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
c7d0: 53 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 Script2 opens th
c7e0: 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 e client socket
c7f0: 61 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 and writes to it
c800: 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 . It then. #
c810: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
c820: 31 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 1 and exits. If
c830: 20 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 the child proce
c840: 73 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 ss inherited the
c850: 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f . # client so
c860: 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 cket, the socket
c870: 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f will still be o
c880: 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 pen... set f
c890: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
c8a0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
c8b0: 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a st set tclsh $::
c8c0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
c8d0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c8e0: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
c8f0: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
c900: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
c910: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
c920: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
c930: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
c940: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
c950: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
c960: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
c970: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
c980: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 20 20 le $caCert \..
c990: 20 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 -keyfile $clie
c9a0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
c9b0: 38 38 32 39 5c 5d 22 0a 20 20 20 20 70 75 74 73 8829\]". puts
c9c0: 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c $f {..exec $tcl
c9d0: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 sh script1 &..pu
c9e0: 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 ts $f testing..f
c9f0: 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 lush $f..after 1
ca00: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
ca10: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
ca20: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
ca30: 23 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 # Create the ser
ca40: 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 ver socket..
ca50: 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a set server [tls:
ca60: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
ca70: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
ca80: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
ca90: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
caa0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
cab0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
cac0: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
cad0: 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 cept { file host
cae0: 20 70 6f 72 74 20 7d 20 7b 0a 09 23 20 57 68 65 port } {..# Whe
caf0: 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e n the client con
cb00: 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 nects, establish
cb10: 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 the read handle
cb20: 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 r..global server
cb30: 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a ..close $server.
cb40: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c .fconfigure $fil
cb50: 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 e -blocking 0..f
cb60: 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 ileevent $file r
cb70: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
cb80: 5f 68 61 6e 64 73 68 61 6b 65 20 24 66 69 6c 65 _handshake $file
cb90: 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 5b 6c readable \...[l
cba0: 69 73 74 20 67 65 74 64 61 74 61 20 63 6c 69 65 ist getdata clie
cbb0: 6e 74 5d 20 2d 62 75 66 66 65 72 69 6e 67 20 6c nt] -buffering l
cbc0: 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a 20 20 20 ine]..return.
cbd0: 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 }.. # If the
cbe0: 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 socket doesn't
cbf0: 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 hit end-of-file
cc00: 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 in 5 seconds, th
cc10: 65 0a 20 20 20 20 23 20 73 63 72 69 70 74 31 20 e. # script1
cc20: 70 72 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 process must hav
cc30: 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 e inherited the
cc40: 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 client... set
cc50: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
cc60: 74 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 ter 5000 [list s
cc70: 65 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 et failed 1]..
cc80: 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 # Launch the s
cc90: 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a cript2 process..
cca0: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
ccb0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
ccc0: 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 ipt2 &.. vwai
ccd0: 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 t x. if {!$fa
cce0: 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 iled} {..vwait f
ccf0: 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 ailed. }.
cd00: 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 set x.} {client
cd10: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
cd20: 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 nherited}..test
cd30: 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 tlsIO-12.3 {test
cd40: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
cd50: 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b of accepted sock
cd60: 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ets} \..{socket
cd70: 65 78 65 63 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b exec unixOnly} {
cd80: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
cd90: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b script1. mak
cda0: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 eFile {} script2
cdb0: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
cdc0: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
cdd0: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
cde0: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
cdf0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
ce00: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
ce10: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
ce20: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
ce30: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
ce40: 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 tclsh $::tcltes
ce50: 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 t::tcltest].
ce60: 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 puts $f {..set a
ce70: 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 uto_path [linser
ce80: 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b t $auto_path 0 [
ce90: 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 lindex [split $e
cea0: 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 nv(PATH) ";:"] 0
ceb0: 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 ]]..package requ
cec0: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
ced0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
cee0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
cef0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
cf00: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
cf10: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
cf20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
cf30: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
cf40: 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 930\]". puts
cf50: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
cf60: 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f t { file host po
cf70: 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 rt } {.. glob
cf80: 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 66 63 al tclsh.. fc
cf90: 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d onfigure $file -
cfa0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
cfb0: 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b puts $file {
cfc0: 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 test data on soc
cfd0: 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 ket}.. exec $
cfe0: 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a tclsh script1 &.
cff0: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
d000: 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 exit..}..vwait f
d010: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
d020: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
d030: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
d040: 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 pt2 process and
d050: 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 connect to it.
d060: 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 See how long.
d070: 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 # the socket st
d080: 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 ays open.. ex
d090: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
d0a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
d0b0: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
d0c0: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
d0d0: 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f ed 1. vwait o
d0e0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 k_to_proceed..
d0f0: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
d100: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
d110: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
d120: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
d130: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
d140: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
d150: 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 .0.0.1 8930].
d160: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
d170: 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d buffering full -
d180: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 blocking 0. #
d190: 20 57 65 20 6e 65 65 64 20 74 6f 20 70 75 74 20 We need to put
d1a0: 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 a byte into the
d1b0: 72 65 61 64 20 71 75 65 75 65 2c 20 6f 74 68 65 read queue, othe
d1c0: 72 77 69 73 65 20 74 68 65 0a 20 20 20 20 23 20 rwise the. #
d1d0: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 64 6f TLS handshake do
d1e0: 65 73 6e 27 74 20 66 69 6e 69 73 68 0a 20 20 20 esn't finish.
d1f0: 20 70 75 74 73 20 24 66 20 61 3b 20 66 6c 75 73 puts $f a; flus
d200: 68 20 24 66 0a 20 20 20 20 66 69 6c 65 65 76 65 h $f. fileeve
d210: 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b nt $f readable [
d220: 6c 69 73 74 20 67 65 74 64 61 74 61 20 61 63 63 list getdata acc
d230: 65 70 74 65 64 20 24 66 5d 0a 0a 20 20 20 20 23 epted $f].. #
d240: 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 If the socket i
d250: 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 s still open aft
d260: 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 er 5 seconds, th
d270: 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 e script1 proces
d280: 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 s. # must hav
d290: 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 e inherited the
d2a0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e accepted socket.
d2b0: 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 .. set failed
d2c0: 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0. after 500
d2d0: 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 0 set failed 1..
d2e0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
d2f0: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
d300: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
d310: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
d320: 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 t tlsIO-13.1 {Te
d330: 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 sting use of sha
d340: 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 red socket betwe
d350: 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 en two threads}
d360: 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 \..{socket testt
d370: 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 hread} {. # H
d380: 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 65 73 74 OBBS: never test
d390: 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ed. removeFil
d3a0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 e script. thr
d3b0: 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b eadReap.. mak
d3c0: 65 46 69 6c 65 20 7b 0a 09 73 65 74 20 61 75 74 eFile {..set aut
d3d0: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
d3e0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
d3f0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
d400: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
d410: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
d420: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 quire tls..set f
d430: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
d440: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
d450: 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 8]..proc accept
d460: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
d470: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
d480: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
d490: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
d4a0: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
d4b0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
d4c0: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
d4d0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
d4e0: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
d4f0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
d500: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
d510: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
d520: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
d530: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
d540: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
d550: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
d560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
d570: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
d580: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
d590: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
d5a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d5b0: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
d5c0: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
d5d0: 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 set i 0..vwait x
d5e0: 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 ..close $f...# t
d5f0: 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 hread cleans its
d600: 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 elf up...testthr
d610: 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 ead exit. } s
d620: 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23 cript. . #
d630: 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 64 create a thread
d640: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 74 . set servert
d650: 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 hread [testthrea
d660: 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 d create { sourc
d670: 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 e script } ].
d680: 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20 update. .
d690: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 after 1000.
d6a0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
d6b0: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
d6c0: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
d6d0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
d6e0: 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 line.. catch
d6f0: 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c {..puts $s "hell
d700: 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 o"..gets $s resu
d710: 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f lt. }. clo
d720: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 se $s. update
d730: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
d740: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
d750: 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d ult [threadReap]
d760: 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 65 . . set re
d770: 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 sult..} {hello 1
d780: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }..test tlsIO-14
d790: 2e 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .1 {test tls::un
d7a0: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d7b0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
d7c0: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 ch {tls::unimpor
d7d0: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
d7e0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
d7f0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
d800: 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 :unimport channe
d810: 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d l"}}.test tlsIO-
d820: 31 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 3a 3a 14.2 {test tls::
d830: 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 unimport} {socke
d840: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
d850: 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 atch {tls::unimp
d860: 6f 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d 73 67 ort foo bar} msg
d870: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
d880: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
d890: 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 d be "tls::unimp
d8a0: 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 ort channel"}}.t
d8b0: 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b est tlsIO-14.3 {
d8c0: 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f test tls::unimpo
d8d0: 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 rt} {socket} {.
d8e0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
d8f0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 6f tls::unimport bo
d900: 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d gus} msg] $msg.}
d910: 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 69 6e {1 {can not fin
d920: 64 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 20 d channel named
d930: 22 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 20 74 "bogus"}}.test t
d940: 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 74 20 lsIO-14.4 {test
d950: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b tls::unimport} {
d960: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 socket} {. #
d970: 73 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 20 64 stdin can take d
d980: 69 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 20 61 ifferent names a
d990: 73 20 74 68 65 20 22 74 6f 70 22 20 63 68 61 6e s the "top" chan
d9a0: 6e 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 nel. list [ca
d9b0: 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f tch {tls::unimpo
d9c0: 72 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d 20 5c rt stdin} msg] \
d9d0: 0a 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 ..[string match
d9e0: 7b 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 2a 22 {bad channel "*"
d9f0: 3a 20 6e 6f 74 20 61 20 54 4c 53 20 63 68 61 6e : not a TLS chan
da00: 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b 31 20 nel} $msg].} {1
da10: 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 1}.test tlsIO-14
da20: 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .5 {test tls::un
da30: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
da40: 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 {. set len 0
da50: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
da60: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
da70: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
da80: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
da90: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
daa0: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
dab0: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
dac0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
dad0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
dae0: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
daf0: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
db00: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
db10: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
db20: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
db30: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
db40: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
db50: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
db60: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
db70: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
db80: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
db90: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
dba0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
dbb0: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
dbc0: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
dbd0: 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 little \...-buff
dbe0: 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 ering none].
dbf0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
dc00: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
dc10: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
dc20: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
dc30: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
dc40: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
dc50: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
dc60: 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 8831]. set c
dc70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
dc80: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
dc90: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
dca0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
dcb0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
dcc0: 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e . [info hostn
dcd0: 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 23 ame] 8831]. #
dce0: 20 6f 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e 74 only the client
dcf0: 20 67 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 gets tls::impor
dd00: 74 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b 74 t. set res [t
dd10: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 5d ls::unimport $c]
dd20: 0a 20 20 20 20 6c 69 73 74 20 24 72 65 73 20 5b . list $res [
dd30: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d catch {close $c}
dd40: 20 65 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b 63 err] $err \..[c
dd50: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 20 atch {close $s}
dd60: 65 72 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 err] $err.} {{}
dd70: 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 23 20 63 6c 0 {} 0 {}}..# cl
dd80: 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e eanup.if {[strin
dd90: 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 g match sock* $c
dda0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d ommandSocket] ==
ddb0: 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 1} {. puts $c
ddc0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 ommandSocket exi
ddd0: 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d t. flush $comm
dde0: 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 andSocket.}.catc
ddf0: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
de00: 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b dSocket}.catch {
de10: 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f close $remotePro
de20: 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 cChan}.::tcltest
de30: 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 ::cleanupTests.f
de40: 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 lush stdout.retu
de50: 72 6e 0a rn.