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 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 31 34 2e 32 2e 34 20 32 30 30 30 2f 30 37 2f .14.2.4 2000/07/
0210: 32 31 20 30 35 3a 33 32 3a 35 37 20 68 6f 62 62 21 05:32:57 hobb
0220: 73 20 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e 69 s Exp $..# Runni
0230: 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 73 20 ng socket tests
0240: 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 73 65 with a remote se
0250: 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d rver:.# --------
0260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0280: 2d 2d 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 73 --.# .# Some tes
0290: 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 ts in socket.tes
02a0: 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 20 t depend on the
02b0: 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 20 72 existence of a r
02c0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 6f 0a emote server to.
02d0: 23 20 77 68 69 63 68 20 74 68 65 79 20 63 6f 6e # which they con
02e0: 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 65 nect. The remote
02f0: 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 server must be
0300: 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 74 an instance of t
0310: 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a 23 20 cltest and it.#
0320: 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 63 72 must run the scr
0330: 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 ipt found in the
0340: 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 63 file "remote.tc
0350: 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 65 63 l" in this direc
0360: 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e 20 tory. You.# can
0370: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0380: 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 6d server on any m
0390: 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 6c 65 achine reachable
03a0: 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 6e from the machin
03b0: 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f 75 e on.# which you
03c0: 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 65 want to run the
03d0: 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 62 socket tests, b
03e0: 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 20 y issuing:.# .#
03f0: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
0400: 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 38 30 34 te.tcl -port 804
0410: 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 6e 8.# Or choose an
0420: 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 65 other port numbe
0430: 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 20 6d r..# .# If the m
0440: 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 20 72 achine you are r
0450: 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 unning the remot
0460: 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 73 20 e server on has
0470: 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 6e 74 several IP.# int
0480: 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 61 6e erfaces, you can
0490: 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 69 6e choose which in
04a0: 74 65 72 66 61 63 65 20 74 68 65 20 73 65 72 76 terface the serv
04b0: 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 6f er listens on fo
04c0: 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 r.# connections
04d0: 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 74 68 by specifying th
04e0: 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 e -address comma
04f0: 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 6f nd line flag, so
0500: 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 :.# .# tclte
0510: 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 st remote.tcl -a
0520: 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 ddress your.mach
0530: 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 65 ine.com.# .# The
0540: 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 se options can a
0550: 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 6e lso be set by en
0560: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0570: 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f les. On Unix, yo
0580: 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 65 u can.# type the
0590: 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 se commands to t
05a0: 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 he shell from wh
05b0: 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ich the remote s
05c0: 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 64 erver is started
05d0: 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c 6c :.# .# shell
05e0: 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 50 % setenv serverP
05f0: 6f 72 74 20 38 30 34 38 0a 23 20 20 20 20 20 73 ort 8048.# s
0600: 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 hell% setenv ser
0610: 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 2e verAddress your.
0620: 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 machine.com.# .#
0630: 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e 74 6c and subsequentl
0640: 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 74 20 y you can start
0650: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0660: 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 20 r with:.# .#
0670: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e tcltest remote.
0680: 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 65 tcl.# .# to have
0690: 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 6f it listen on po
06a0: 72 74 20 38 30 34 38 20 6f 6e 20 74 68 65 20 69 rt 8048 on the i
06b0: 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e 6d 61 nterface your.ma
06c0: 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 chine.com..#
06d0: 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 .# When the ser
06e0: 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 ver starts, it p
06f0: 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 rints out a deta
0700: 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e iled message con
0710: 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f taining its.# co
0720: 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f nfiguration info
0730: 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 rmation, and it
0740: 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c will block until
0750: 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 killed with a C
0760: 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 trl-C..# Once th
0770: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
0780: 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 exists, you can
0790: 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e run the tests in
07a0: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 socket.test wit
07b0: 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 62 h.# the server b
07c0: 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 y setting two Tc
07d0: 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 0a l variables:.# .
07e0: 23 20 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f # % set remo
07f0: 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 teServerIP <name
0800: 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d or address of m
0810: 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 achine on which
0820: 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 server runs>.#
0830: 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 % set remoteS
0840: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 erverPort 8048.#
0850: 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 61 62 .# These variab
0860: 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 65 74 les are also set
0870: 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 table from the e
0880: 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 nvironment. On U
0890: 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 20 nix, you can:.#
08a0: 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 .# shell% se
08b0: 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 65 tenv remoteServe
08c0: 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 72 rIP machine.wher
08d0: 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 20 e.server.runs.#
08e0: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e shell% seten
08f0: 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f v remoteServerPo
0900: 72 74 20 38 30 34 38 0a 23 20 0a 23 20 54 68 65 rt 8048.# .# The
0910: 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 65 preamble of the
0920: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 6c socket.test fil
0930: 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 65 20 e checks to see
0940: 69 66 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 if the variables
0950: 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 68 65 are set.# eithe
0960: 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 74 r in Tcl or in t
0970: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 he environment;
0980: 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 74 20 if they are, it
0990: 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e 6e attempts to conn
09a0: 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 65 72 ect to.# the ser
09b0: 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f 6e 6e ver. If the conn
09c0: 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 65 73 ection is succes
09d0: 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 73 20 sful, the tests
09e0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
09f0: 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c 20 62 .# server will b
0a00: 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 68 e performed; oth
0a10: 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c 6c 20 erwise, it will
0a20: 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 72 74 attempt to start
0a30: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
0a40: 72 76 65 72 20 28 76 69 61 20 65 78 65 63 29 20 rver (via exec)
0a50: 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 on platforms tha
0a60: 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 2c 20 t support this,
0a70: 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 on the local hos
0a80: 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 61 t,.# listening a
0a90: 74 20 70 6f 72 74 20 38 30 34 38 2e 20 49 66 20 t port 8048. If
0aa0: 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 73 all fails, a mes
0ab0: 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 64 20 sage is printed
0ac0: 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a 23 20 and the tests.#
0ad0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
0ae0: 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f 74 20 server are not
0af0: 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 70 72 6f 63 performed...proc
0b00: 20 64 70 75 74 73 20 7b 6d 73 67 7d 20 7b 20 72 dputs {msg} { r
0b10: 65 74 75 72 6e 20 3b 20 70 75 74 73 20 73 74 64 eturn ; puts std
0b20: 65 72 72 20 24 6d 73 67 20 3b 20 66 6c 75 73 68 err $msg ; flush
0b30: 20 73 74 64 65 72 72 20 7d 0a 0a 69 66 20 7b 5b stderr }..if {[
0b40: 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 70 61 lsearch [namespa
0b50: 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 ce children] ::t
0b60: 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b cltest] == -1} {
0b70: 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 65 71 . package req
0b80: 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 20 20 uire tcltest.
0b90: 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 6f 72 namespace impor
0ba0: 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 65 t -force ::tclte
0bb0: 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 st::*.}..# Load
0bc0: 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 65 0a the tls package.
0bd0: 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
0be0: 20 74 6c 73 0a 0a 73 65 74 20 74 6c 73 53 65 72 tls..set tlsSer
0bf0: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 23 20 verPort 8048..#
0c00: 53 70 65 63 69 66 79 20 77 68 65 72 65 20 74 68 Specify where th
0c10: 65 20 63 65 72 74 69 66 69 63 61 74 65 73 20 61 e certificates a
0c20: 72 65 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 re..set certsDir
0c30: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c .[file join [fil
0c40: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 e dirname [info
0c50: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a script]] certs].
0c60: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 5b set serverCert.[
0c70: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0c80: 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a Dir server.pem].
0c90: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b set clientCert.[
0ca0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0cb0: 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a Dir client.pem].
0cc0: 73 65 74 20 63 61 43 65 72 74 09 5b 66 69 6c 65 set caCert.[file
0cd0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0ce0: 63 61 63 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 cacert.pem].set
0cf0: 73 65 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 serverKey.[file
0d00: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 join $certsDir s
0d10: 6b 65 79 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 key.pem].set cli
0d20: 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 entKey.[file joi
0d30: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 79 n $certsDir ckey
0d40: 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 .pem]..# Some te
0d50: 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 sts require the
0d60: 74 65 73 74 74 68 72 65 61 64 20 61 6e 64 20 65 testthread and e
0d70: 78 65 63 20 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 xec commands..se
0d80: 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 t ::tcltest::tes
0d90: 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 tConstraints(tes
0da0: 74 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 tthread) \..[exp
0db0: 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 r {[info command
0dc0: 73 20 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d s testthread] !=
0dd0: 20 7b 7d 7d 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 {}}].set ::tclt
0de0: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
0df0: 69 6e 74 73 28 65 78 65 63 29 20 5b 65 78 70 72 ints(exec) [expr
0e00: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
0e10: 20 65 78 65 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a exec] != {}}]..
0e20: 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 #.# If remoteSer
0e30: 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 verIP or remoteS
0e40: 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f erverPort are no
0e50: 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 t set, check in
0e60: 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e the.# environmen
0e70: 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 t variables for
0e80: 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 externally set v
0e90: 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b alues..#..if {![
0ea0: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0eb0: 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 teServerIP]} {.
0ec0: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0ed0: 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 sts env(remoteSe
0ee0: 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 rverIP)]} {..set
0ef0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0f00: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
0f10: 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 rIP). }.}.if
0f20: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0f30: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d emoteServerPort]
0f40: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
0f50: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d o exists env(rem
0f60: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 5d 7d oteServerPort)]}
0f70: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0f80: 72 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 rverPort $env(re
0f90: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a moteServerPort).
0fa0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
0fb0: 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 if {[info e
0fc0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0fd0: 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 erIP]} {.. se
0fe0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0ff0: 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 rt $tlsServerPor
1000: 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 t. }.
1010: 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f 68 61 6e }.}..proc do_han
1020: 64 73 68 61 6b 65 20 7b 73 20 7b 74 79 70 65 20 dshake {s {type
1030: 72 65 61 64 61 62 6c 65 7d 20 7b 63 6d 64 20 7b readable} {cmd {
1040: 7d 7d 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 69 }} args} {. i
1050: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
1060: 63 6c 6f 73 65 20 24 73 0a 09 64 70 75 74 73 20 close $s..dputs
1070: 22 68 61 6e 64 73 68 61 6b 65 3a 20 65 6f 66 22 "handshake: eof"
1080: 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 ..set ::do_hands
1090: 68 61 6b 65 20 22 65 6f 66 22 0a 20 20 20 20 7d hake "eof". }
10a0: 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 elseif {[catch
10b0: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
10c0: 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 $s} result]} {..
10d0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
10e0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 64 70 75 74 73 e normal...dputs
10f0: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 24 72 65 "handshake: $re
1100: 73 75 6c 74 22 0a 20 20 20 20 7d 20 65 6c 73 65 sult". } else
1110: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
1120: 7d 20 7b 0a 09 23 20 48 61 6e 64 73 68 61 6b 65 } {..# Handshake
1130: 20 63 6f 6d 70 6c 65 74 65 0a 09 69 66 20 7b 5b complete..if {[
1140: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 7d 20 llength $args]}
1150: 7b 20 65 76 61 6c 20 66 63 6f 6e 66 69 67 75 72 { eval fconfigur
1160: 65 20 24 73 20 24 61 72 67 73 20 7d 0a 09 69 66 e $s $args }..if
1170: 20 7b 24 63 6d 64 20 3d 3d 20 22 22 7d 20 7b 0a {$cmd == ""} {.
1180: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
1190: 73 20 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c s $type ""..} el
11a0: 73 65 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 se {.. fileev
11b0: 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 24 63 ent $s $type "$c
11c0: 6d 64 20 24 73 22 0a 09 7d 0a 09 64 70 75 74 73 md $s"..}..dputs
11d0: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 63 6f 6d "handshake: com
11e0: 70 6c 65 74 65 22 0a 09 73 65 74 20 3a 3a 64 6f plete"..set ::do
11f0: 5f 68 61 6e 64 73 68 61 6b 65 20 22 63 6f 6d 70 _handshake "comp
1200: 6c 65 74 65 22 0a 20 20 20 20 7d 20 65 6c 73 65 lete". } else
1210: 20 7b 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 {..dputs "hands
1220: 68 61 6b 65 3a 20 69 6e 20 70 72 6f 67 72 65 73 hake: in progres
1230: 73 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 s". }.}..#.#
1240: 43 68 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 Check if we're s
1250: 75 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 upposed to do te
1260: 73 74 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 sts against the
1270: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a remote server.#.
1280: 0a 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 .set doTestsWith
1290: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 RemoteServer 1.i
12a0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
12b0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d remoteServerIP]
12c0: 20 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f && ($tcl_platfo
12d0: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 rm(platform) !=
12e0: 22 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a "macintosh")} {.
12f0: 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 set remoteSe
1300: 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 rverIP 127.0.0.1
1310: 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 .}.if {($doTests
1320: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1330: 20 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 == 1) && (![inf
1340: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
1350: 65 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 erverPort])} {.
1360: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
1370: 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 verPort $tlsServ
1380: 65 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 74 65 erPort.}..# Atte
1390: 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 mpt to connect t
13a0: 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 o a remote serve
13b0: 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 r if one is alre
13c0: 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 ady running. If
13d0: 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e it.# is not runn
13e0: 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 ing or for some
13f0: 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 other reason the
1400: 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 connect fails,
1410: 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 attempt to.# sta
1420: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 rt the remote se
1430: 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 rver on the loca
1440: 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 l host listening
1450: 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 2e 20 54 on port 8048. T
1460: 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f his.# is only do
1470: 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 ne on platforms
1480: 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 that support exe
1490: 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 c (i.e. not on t
14a0: 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c he Mac). On.# pl
14b0: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 atforms that do
14c0: 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 not support exec
14d0: 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 , the remote ser
14e0: 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 ver must be star
14f0: 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 ted.# by the use
1500: 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 r before running
1510: 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 the tests...set
1520: 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 remoteProcChan
1530: 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f "".set commandSo
1540: 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 cket "".if {$doT
1550: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1560: 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 rver} {. catc
1570: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
1580: 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 dSocket}. if
1590: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d {[catch {set com
15a0: 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a mandSocket [tls:
15b0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
15c0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
15d0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
15e0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
15f0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
1600: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
1610: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
1620: 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 t]}] != 0} {..if
1630: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
1640: 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a exec] == ""} {.
1650: 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 . set noRemot
1660: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e eTestReason "can
1670: 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 't exec".. se
1680: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
1690: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 oteServer 0..} e
16a0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 lse {.. set r
16b0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
16c0: 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 7.0.0.1.. set
16d0: 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c remoteFile [fil
16e0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d e join [pwd] rem
16f0: 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 ote.tcl].. if
1700: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 {[catch {set re
1710: 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 moteProcChan \..
1720: 09 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 . [open "|[li
1730: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
1740: 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 cltest $remoteFi
1750: 6c 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 72 76 le \... -serv
1760: 65 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f 72 74 erIsSilent -port
1770: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f $remoteServerPo
1780: 72 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 64 72 rt \... -addr
1790: 65 73 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ess $remoteServe
17a0: 72 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 rIP]" w+]} msg]
17b0: 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 == 0} {...after
17c0: 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 1000...if {[catc
17d0: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f h {set commandSo
17e0: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 cket [tls::socke
17f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
1800: 74 20 5c 0a 09 09 09 2d 63 65 72 74 66 69 6c 65 t \....-certfile
1810: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 6b 65 $clientCert -ke
1820: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
1830: 20 5c 0a 09 09 09 24 72 65 6d 6f 74 65 53 65 72 \....$remoteSer
1840: 76 65 72 49 50 20 24 72 65 6d 6f 74 65 53 65 72 verIP $remoteSer
1850: 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d verPort]} msg] =
1860: 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f = 0} {... fco
1870: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
1880: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
1890: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
18a0: 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 ing line...} els
18b0: 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 6f e {... set no
18c0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
18d0: 20 24 6d 73 67 0a 09 09 20 20 20 20 73 65 74 20 $msg... set
18e0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
18f0: 65 53 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 eServer 0...}..
1900: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 } else {...se
1910: 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 t noRemoteTestRe
1920: 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 ason "$msg $::tc
1930: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a ltest::tcltest".
1940: 09 09 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 ..set doTestsWit
1950: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a hRemoteServer 0.
1960: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 . }..}. }
1970: 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 else {..fconfigu
1980: 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 re $commandSocke
1990: 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 t -translation c
19a0: 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c rlf -buffering l
19b0: 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 ine. }.}..# S
19c0: 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 75 ome tests are ru
19d0: 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 n only if we are
19e0: 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 doing testing a
19f0: 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 gainst a remote
1a00: 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 server..set ::tc
1a10: 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 ltest::testConst
1a20: 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 raints(doTestsWi
1a30: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 thRemoteServer)
1a40: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1a50: 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f teServer.if {$do
1a60: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1a70: 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 erver == 0} {.
1a80: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 if {[string fi
1a90: 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 rst s $::tcltest
1aa0: 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 ::verbose] != -1
1ab0: 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 } {. .puts "S
1ac0: 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 kipping tests wi
1ad0: 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 th remote server
1ae0: 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b . See tests/sock
1af0: 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 et.test for"..pu
1b00: 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 ts "information
1b10: 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 on how to run re
1b20: 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 mote server."..p
1b30: 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 uts "Reason for
1b40: 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 not doing remote
1b50: 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 tests: $noRemot
1b60: 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 eTestReason".
1b70: 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 }.}..#.# If we
1b80: 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 do the tests, de
1b90: 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 fine a command t
1ba0: 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 o send a command
1bb0: 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 to the.# remote
1bc0: 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b server..#..if {
1bd0: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1be0: 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b teServer == 1} {
1bf0: 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f . proc sendCo
1c00: 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f mmand {c} {..glo
1c10: 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 bal commandSocke
1c20: 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f t...if {[eof $co
1c30: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a mmandSocket]} {.
1c40: 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f . error "remo
1c50: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
1c60: 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b eared"..}...if {
1c70: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
1c80: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 mmandSocket $c}
1c90: 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 msg]} {.. err
1ca0: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1cb0: 72 20 64 69 73 61 70 70 61 65 72 65 64 3a 20 24 r disappaered: $
1cc0: 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 msg"..}..if {[ca
1cd0: 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 tch {puts $comma
1ce0: 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b ndSocket "--Mark
1cf0: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1d00: 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 er--"} msg]} {..
1d10: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1d20: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1d30: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a ared: $msg"..}..
1d40: 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 .set resp ""..wh
1d50: 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 ile {1} {.. s
1d60: 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 et line [gets $c
1d70: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 ommandSocket]..
1d80: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d if {[eof $com
1d90: 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 mandSocket]} {..
1da0: 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 .error "remote s
1db0: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
1dc0: 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 d".. }.. i
1dd0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
1de0: 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b re $line "--Mark
1df0: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1e00: 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 er--"] == 0} {..
1e10: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
1e20: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 pare [lindex $re
1e30: 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 sp 0] error] ==
1e40: 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 0} {... error
1e50: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1e60: 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 ]...} else {...
1e70: 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 return [linde
1e80: 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 x $resp 1]...}..
1e90: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 } else {...a
1ea0: 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 ppend resp $line
1eb0: 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a "\n".. }..}.
1ec0: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 6e 64 43 }.. sendC
1ed0: 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 70 72 6f ommand [list pro
1ee0: 63 20 64 70 75 74 73 20 5b 69 6e 66 6f 20 61 72 c dputs [info ar
1ef0: 67 73 20 64 70 75 74 73 5d 20 5b 69 6e 66 6f 20 gs dputs] [info
1f00: 62 6f 64 79 20 64 70 75 74 73 5d 5d 0a 0a 20 20 body dputs]]..
1f10: 20 20 70 72 6f 63 20 73 65 6e 64 43 65 72 74 56 proc sendCertV
1f20: 61 6c 75 65 73 20 7b 7d 20 7b 0a 09 23 20 57 65 alues {} {..# We
1f30: 20 6e 65 65 64 20 74 6f 20 62 65 20 61 62 6c 65 need to be able
1f40: 20 74 6f 20 73 65 6e 64 20 63 65 72 74 69 66 69 to send certifi
1f50: 63 61 74 65 20 76 61 6c 75 65 73 20 74 68 61 74 cate values that
1f60: 20 6e 6f 72 6d 61 6c 69 7a 65 0a 09 23 20 66 69 normalize..# fi
1f70: 6c 65 6e 61 6d 65 73 20 61 63 72 6f 73 73 20 70 lenames across p
1f80: 6c 61 74 66 6f 72 6d 73 0a 09 73 65 6e 64 43 6f latforms..sendCo
1f90: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
1fa0: 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 certsDir.[file
1fb0: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 join [file dirna
1fc0: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d me [info script]
1fd0: 5d 20 63 65 72 74 73 5d 0a 09 20 20 20 20 73 65 ] certs].. se
1fe0: 74 20 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 t serverCert.[fi
1ff0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
2000: 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 09 20 r server.pem]..
2010: 20 20 20 73 65 74 20 63 6c 69 65 6e 74 43 65 72 set clientCer
2020: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
2030: 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 rtsDir client.pe
2040: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 61 43 65 m].. set caCe
2050: 72 74 09 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 rt..[file join $
2060: 63 65 72 74 73 44 69 72 20 63 61 63 65 72 74 2e certsDir cacert.
2070: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 73 65 pem].. set se
2080: 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f rverKey.[file jo
2090: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 6b 65 in $certsDir ske
20a0: 79 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 y.pem].. set
20b0: 63 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 clientKey.[file
20c0: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 join $certsDir c
20d0: 6b 65 79 2e 70 65 6d 5d 0a 09 7d 0a 20 20 20 20 key.pem]..}.
20e0: 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d }.}..test tlsIO-
20f0: 31 2e 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.1 {arg parsing
2100: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2110: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2120: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2130: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2140: 72 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a rver} msg] $msg.
2150: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2160: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2170: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2180: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
2190: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
21a0: 73 74 20 74 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 st tlsIO-1.2 {ar
21b0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
21c0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
21d0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
21e0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
21f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f ocket -server fo
2200: 6f 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b o} msg] $msg.} {
2210: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2220: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2230: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2240: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2250: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2260: 74 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 tlsIO-1.3 {arg p
2270: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2280: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2290: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
22a0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
22b0: 65 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 67 5d et -myaddr} msg]
22c0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
22d0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
22e0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
22f0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2300: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2310: 73 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 sIO-1.4 {arg par
2320: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2330: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2340: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2350: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2360: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 -myaddr 127.0.0
2370: 2e 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 .1} msg] $msg.}
2380: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2390: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
23a0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
23b0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
23c0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 .test tlsIO-1.5
23d0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
23e0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
23f0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2400: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2410: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2420: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2430: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2440: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2450: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2460: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2470: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 est tlsIO-1.6 {a
2480: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2490: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
24a0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
24b0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
24c0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 socket -myport x
24d0: 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d xxx} msg] $msg.}
24e0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
24f0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2500: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2510: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2520: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 ..test tlsIO-1.7
2530: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2540: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2550: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2560: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2570: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
2580: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
2590: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
25a0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
25b0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
25c0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
25d0: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
25e0: 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.8 {arg parsing
25f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2600: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2610: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2620: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 {tls::socket -fr
2630: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a oboz} msg] $msg.
2640: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2650: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2660: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2670: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2680: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2690: 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 9 {arg parsing f
26a0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
26b0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
26c0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
26d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
26e0: 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 er foo -myport 2
26f0: 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 521 3333} msg] $
2700: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2710: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2720: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2730: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2740: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
2750: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2760: 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 0 {arg parsing f
2770: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2780: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2790: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
27a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 ls::socket host
27b0: 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 2528 -junk} msg]
27c0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
27d0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
27e0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
27f0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2800: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2810: 73 49 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 sIO-1.11 {arg pa
2820: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2830: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2840: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2850: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2860: 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 t -server callba
2870: 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d ck 2520 --} msg]
2880: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2890: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
28a0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
28b0: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
28c0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
28d0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
28e0: 2e 31 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .12 {arg parsing
28f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2900: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2910: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2920: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f {tls::socket foo
2930: 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 badport} msg] $
2940: 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 msg.} {1 {expect
2950: 65 64 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 ed integer but g
2960: 6f 74 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a ot "badport"}}..
2970: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b test tlsIO-2.1 {
2980: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
2990: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
29a0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
29b0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
29c0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
29d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
29e0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
29f0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
2a00: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
2a10: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
2a20: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
2a30: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
2a40: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2a50: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
2a60: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2a70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2a80: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2a90: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
2aa0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2ab0: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2ac0: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
2ad0: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
2ae0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
2af0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
2b00: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
2b10: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
2b20: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
2b30: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
2b40: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2b50: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2b60: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2b70: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2b80: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2b90: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2ba0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2bb0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
2bc0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2bd0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2be0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2bf0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
2c00: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
2c10: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
2c20: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2c30: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2c40: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
2c50: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
2c60: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2c70: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
2c80: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
2c90: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
2ca0: 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 if [info exists
2cb0: 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 port] {. incr
2cc0: 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 0a port.} else { .
2cd0: 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 set port [ex
2ce0: 70 72 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 pr $tlsServerPor
2cf0: 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a t + [pid]%1024].
2d00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
2d10: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
2d20: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f n with client po
2d30: 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 rt specified} {s
2d40: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2d50: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2d60: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2d70: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2d80: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
2d90: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2da0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2db0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2dc0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
2dd0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2de0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2df0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2e00: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2e10: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2e20: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2e30: 76 65 72 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a verKey 8829 \]".
2e40: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2e50: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
2e60: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2e70: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2e80: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2e90: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
2ea0: 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 ] $port".
2eb0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
2ec0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2ed0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2ee0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2ef0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2f00: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2f10: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2f20: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2f30: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2f40: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2f50: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2f60: 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 ts $f x. glob
2f70: 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b al port. if {
2f80: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2f90: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 ket -myport $por
2fa0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
2fb0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2fc0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2fd0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2fe0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
2ff0: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
3000: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 set x $sock..
3010: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c catch {close [tl
3020: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3030: 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 20 7d 0.1 8829]}. }
3040: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
3050: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
3060: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
3070: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
3080: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
3090: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
30a0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
30b0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 . set x.} [li
30c0: 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 st ready "hello
30d0: 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c $port"]..test tl
30e0: 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e sIO-2.3 {tcp con
30f0: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 nection with cli
3100: 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 ent interface sp
3110: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
3120: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3130: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3140: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3150: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3160: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
3170: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3180: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3190: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
31a0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
31b0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
31c0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
31d0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
31e0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
31f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3200: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3210: 79 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 y 8830 \]". p
3220: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3230: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3240: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3250: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3260: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3270: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 [gets $sock] $ad
3280: 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 dr".
3290: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
32a0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
32b0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
32c0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
32d0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
32e0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
32f0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3300: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3310: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3320: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3330: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3340: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
3350: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
3360: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
3370: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
3380: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3390: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
33a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
33b0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 127.0.0.1 8830}
33c0: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
33d0: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 set x $sock.
33e0: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
33f0: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
3400: 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 llo..catch {flus
3410: 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 h $sock}.
3420: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3430: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3440: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3450: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3460: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b set x.} {ready {
3470: 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d hello 127.0.0.1}
3480: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3490: 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 4 {tcp connectio
34a0: 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e n with server in
34b0: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
34c0: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
34d0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
34e0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
34f0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3500: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3510: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3520: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
3530: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
3540: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3550: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3560: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3570: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3580: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3590: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
35a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
35b0: 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 $serverKey -mya
35c0: 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ddr [info hostna
35d0: 6d 65 5d 20 38 38 33 31 20 5c 5d 22 0a 20 20 20 me] 8831 \]".
35e0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
35f0: 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 accept {sock ad
3600: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
3610: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
3620: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
3630: 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a "[gets $sock]".
3640: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3650: 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 e $sock.
3660: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
3670: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
3680: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
3690: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
36a0: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
36b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
36c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
36d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
36e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
36f0: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
3700: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
3710: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3720: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3730: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3740: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3750: 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f ientKey [info ho
3760: 73 74 6e 61 6d 65 5d 20 38 38 33 31 7d 20 73 6f stname] 8831} so
3770: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
3780: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
3790: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
37a0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
37b0: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
37c0: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
37d0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
37e0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
37f0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3800: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
3810: 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 ady hello}..test
3820: 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 tlsIO-2.5 {tcp
3830: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3840: 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 redundant server
3850: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 port} {socket s
3860: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
3870: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
3880: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
3890: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
38a0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
38b0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
38c0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
38d0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
38e0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
38f0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3900: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3910: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3920: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3930: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3940: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3950: 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 8832 \]". put
3960: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3970: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
3980: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3990: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
39a0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
39b0: 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 ets $sock]".
39c0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
39d0: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
39e0: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
39f0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3a00: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3a10: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3a20: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3a30: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3a40: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3a50: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3a60: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3a70: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
3a80: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3a90: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3aa0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3ab0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3ac0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3ad0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
3ae0: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3af0: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3b00: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3b10: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3b20: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
3b30: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
3b40: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3b50: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3b60: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3b70: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
3b80: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
3b90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 .test tlsIO-2.6
3ba0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
3bb0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
3bc0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
3bd0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
3be0: 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f et sock [tls::so
3bf0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
3c00: 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 833]}]} {..if {!
3c10: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f [catch {gets $so
3c20: 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 ck}]} {.. set
3c30: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
3c40: 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 }..close $sock.
3c50: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
3c60: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 tus.} ok..test t
3c70: 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 lsIO-2.7 {echo s
3c80: 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d erver, one line}
3c90: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3ca0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
3cb0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
3cc0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3cd0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3ce0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3cf0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3d00: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3d10: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3d20: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3d30: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3d40: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3d50: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3d60: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3d70: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3d80: 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c serverKey 8834 \
3d90: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
3da0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
3db0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
3dc0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
3dd0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3de0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3df0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3e00: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3e10: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3e20: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3e30: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
3e40: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
3e50: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
3e60: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
3e70: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
3e80: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
3e90: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
3eb0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
3ec0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ee0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
3ef0: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
3f00: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3f10: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3f20: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3f30: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
3f40: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3f50: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3f60: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3f70: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3f80: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3f90: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
3fa0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3fb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3fc0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3fd0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3fe0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3ff0: 31 20 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 1 8834]. fcon
4000: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4010: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
4020: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 lation lf. pu
4030: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
4040: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 defghijklmnop".
4050: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
4060: 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 set x [gets $s
4070: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
4080: 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 set y [gets $
4090: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
40a0: 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d list $x $y.}
40b0: 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 {{hello abcdefg
40c0: 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d hijklmnop} done}
40d0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 ..test tlsIO-2.8
40e0: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c {echo server, l
40f0: 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 oop 50 times, si
4100: 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d ngle connection}
4110: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
4120: 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 {. set f [ope
4130: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4140: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
4150: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
4160: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
4170: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
4180: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4190: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
41a0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
41b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
41c0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
41d0: 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 ey 8835 \]".
41e0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
41f0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
4210: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4220: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
4230: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
4240: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
4250: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
4260: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
4270: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
4280: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
4290: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
42a0: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
42b0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42d0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
42e0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
42f0: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
4300: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
4320: 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 lse { ..
4330: 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 incr i.
4340: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
4350: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
4360: 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 }..}..set i 0..
4370: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
4380: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
4390: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
43a0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
43b0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
43c0: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 close $f..puts "
43d0: 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 done $i". }.
43e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
43f0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4400: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4410: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4420: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
4430: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4440: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
4450: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
4460: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4470: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
4480: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
4490: 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 35]. fconfigu
44a0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
44b0: 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 line. catch
44c0: 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d {..for {set x 0}
44d0: 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 {$x < 50} {incr
44e0: 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 x} {.. puts
44f0: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
4500: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 ghijklmnop"..
4510: 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 gets $s..}.
4520: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
4530: 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 catch {set x
4540: 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 [gets $f]}. c
4550: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4560: 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 x.} {done 50}..t
4570: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 est tlsIO-2.9 {s
4580: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
4590: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
45a0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
45b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
45c0: 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 accept 8828].
45d0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
45e0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
45f0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4600: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
4610: 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 $f {package req
4620: 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 uire tls; tls::s
4630: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4640: 63 65 70 74 20 38 38 32 38 7d 0a 20 20 20 20 63 cept 8828}. c
4650: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4660: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4670: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4680: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
4690: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
46a0: 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 65 after 100. se
46b0: 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 t x [list [catch
46c0: 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d {close $f} msg]
46d0: 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 [string range $
46e0: 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 20 20 63 msg 0 43]]. c
46f0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
4700: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
4710: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
4720: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
4730: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
4740: 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f IO-2.10 {close o
4750: 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 74 n accept, accept
4760: 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d ed socket lives}
4770: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
4780: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
4790: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
47a0: 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 20000 "set done
47b0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
47c0: 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 set ss [tls::soc
47d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
47e0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
47f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
4800: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4810: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
4820: 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 8830]. proc a
4830: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
4840: 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 .global ss..clos
4850: 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 e $ss..fileevent
4860: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
4870: 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 adit $s"..fconfi
4880: 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c gure $s -trans l
4890: 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 f. }. proc
48a0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
48b0: 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 lobal done..gets
48c0: 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 $s..close $s..s
48d0: 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a et done 1. }.
48e0: 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a set cs [tls:
48f0: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
4900: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4910: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
4920: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
4930: 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e tKey [info hostn
4940: 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 63 ame] 8830]. c
4950: 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 lose $cs.. vw
4960: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
4970: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4980: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
4990: 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 1..test tlsIO-2.
49a0: 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 11 {detecting ne
49b0: 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d w data} {socket}
49c0: 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 {. proc acce
49d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
49e0: 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 obal sock..# whe
49f0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
4a00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
4a10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
4a20: 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 ides need..# to
4a30: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
4a40: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
4a50: 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b shake. Also mak
4a60: 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 e sure..# to ret
4a70: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
4a80: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
4a90: 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 g mode...fconfig
4aa0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
4ab0: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
4ac0: 6e 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a ne..set sock $s.
4ad0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
4ae0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f adable [list do_
4af0: 68 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 handshake $s].
4b00: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b }.. set s [
4b10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4b20: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
4b30: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
4b40: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4b50: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4b60: 20 24 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 $serverKey 8400
4b70: 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 ]. set sock "
4b80: 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c ". set s2 [tl
4b90: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
4ba0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
4bb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4bc0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
4bd0: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
4be0: 20 38 34 30 30 5d 0a 20 20 20 20 23 20 77 68 65 8400]. # whe
4bf0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
4c00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
4c10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
4c20: 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 ides need. #
4c30: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
4c40: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
4c50: 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d andshake Also m
4c60: 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 ake sure to.
4c70: 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 # return the cha
4c80: 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 nnel to line buf
4c90: 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 fering mode (TLS
4ca0: 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e sets it to 'non
4cb0: 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 e').. fconfig
4cc0: 75 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e ure $s2 -blockin
4cd0: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
4ce0: 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 73 6f ine. vwait so
4cf0: 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 ck. puts $s2
4d00: 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 one. flush $s
4d10: 32 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 2. # need upd
4d20: 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 ate to complete
4d30: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e TLS handshake in
4d40: 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 -process. upd
4d50: 61 74 65 0a 20 20 20 20 61 66 74 65 72 20 35 30 ate. after 50
4d60: 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 0. fconfigure
4d70: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4d80: 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 0. set resul
4d90: 74 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d t a:[gets $sock]
4da0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
4db0: 75 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 ult b:[gets $soc
4dc0: 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 k]. fconfigur
4dd0: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
4de0: 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 g 1. puts $s2
4df0: 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 two. flush $
4e00: 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 s2. fconfigur
4e10: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
4e20: 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 g 0. lappend
4e30: 72 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 result c:[gets $
4e40: 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 sock]. fconfi
4e50: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
4e60: 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 king 1. close
4e70: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
4e80: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 s. close $soc
4e90: 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 k. set result
4ea0: 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 .} {a:one b: c:t
4eb0: 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d wo}..test tlsIO-
4ec0: 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 2.12 {tcp connec
4ed0: 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 tion; no certifi
4ee0: 63 61 74 65 73 20 73 70 65 63 69 66 69 65 64 7d cates specified}
4ef0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 {socket stdio p
4f00: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 cCrash} {. re
4f10: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
4f20: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4f30: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
4f40: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
4f50: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
4f60: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
4f70: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
4f80: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
4f90: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
4fa0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
4fb0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
4fc0: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
4fd0: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
4fe0: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
4ff0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
5000: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
5010: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
5020: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5030: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
5040: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
5050: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5060: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
5070: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5080: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5090: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
50a0: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
50b0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 h {tls::socket 1
50c0: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
50d0: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
50e0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
50f0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
5100: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5110: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
5120: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
5130: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
5140: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
5150: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
5160: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 ady done {}}..te
5170: 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f st tlsIO-3.1 {so
5180: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
5190: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
51a0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
51b0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
51c0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
51d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
51e0: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
51f0: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
5200: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
5210: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
5220: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
5230: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
5240: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5250: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
5260: 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
5270: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
5280: 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 uts ready..gets
5290: 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a stdin..close $f.
52a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
52b0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
52c0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
52d0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
52e0: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
52f0: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
5300: 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b x [list [catch {
5310: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5320: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5330: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5340: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5350: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
5360: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
5370: 70 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 5c 0a pt 8828} msg] \.
5380: 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 ..$msg]. puts
5390: 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 $f bye. clos
53a0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
53b0: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
53c0: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
53d0: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
53e0: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
53f0: 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 3.2 {server with
5400: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
5410: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
5420: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
5430: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5440: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
5450: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
5460: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
5470: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
5480: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
5490: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
54a0: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
54b0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
54c0: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
54d0: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
54e0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
54f0: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
5500: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
5510: 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a $f "set s \[tls:
5520: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5530: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
5540: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
5550: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5560: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
5570: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
5580: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
5590: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
55a0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
55b0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
55c0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
55d0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
55e0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
55f0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
5600: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 . global x.
5610: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
5620: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
5630: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
5640: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
5650: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
5660: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
5670: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
5680: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
5690: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
56a0: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
56b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
56c0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
56d0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
56e0: 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 ancel $t1..vwait
56f0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5700: 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 $t2..vwait x..a
5710: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
5720: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
5730: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
5740: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
5750: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5760: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5770: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5780: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
5790: 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 f]. set s1 [t
57a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
57b0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
57c0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
57d0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
57e0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
57f0: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
5800: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5810: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
5820: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
5830: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
5840: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5850: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5860: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5870: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5880: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5890: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
58a0: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
58b0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
58c0: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
58d0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
58e0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
58f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5900: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5910: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5920: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
5930: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
5940: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5950: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
5960: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
5970: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
5980: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
5990: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
59a0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
59b0: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
59c0: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
59d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
59e0: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
59f0: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c close $s3. l
5a00: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5a10: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
5a20: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
5a30: 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 dy done}..test t
5a40: 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 lsIO-4.1 {server
5a50: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
5a60: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
5a70: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
5a80: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5a90: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5aa0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5ab0: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
5ac0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5ad0: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5ae0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5af0: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
5b00: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
5b10: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5b20: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5b30: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
5b40: 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 0.0.1 8828 \]".
5b50: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 puts $f {..fc
5b60: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5b70: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 fering line..for
5b80: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
5b90: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
5ba0: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 .. puts $s he
5bb0: 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 llo.. gets $s
5bc0: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 ..}..close $s..p
5bd0: 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 uts bye..gets st
5be0: 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c din. }. cl
5bf0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 ose $f. set p
5c00: 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 1 [open "|[list
5c10: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5c20: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
5c30: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5c40: 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p1 -buffering l
5c50: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b ine. set p2 [
5c60: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5c70: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5c80: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5c90: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 fconfigure $p2
5ca0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5cb0: 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 . set p3 [ope
5cc0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5cd0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5ce0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
5cf0: 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 configure $p3 -b
5d00: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5d10: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
5d20: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
5d30: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5d40: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
5d50: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
5d60: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
5d70: 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f }. proc echo
5d80: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 {s} {..global x
5d90: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b . set l [
5da0: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 gets $s].
5db0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
5dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
5dd0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
5de0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5df0: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
5e00: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
5e10: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 s $l. }.
5e20: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 }. set t1
5e30: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
5e40: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5e50: 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 set t2 [afte
5e60: 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 r 31000 "set x t
5e70: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5e80: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
5e90: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5ea0: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 out"]. set s
5eb0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5ec0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
5ed0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
5ee0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5ef0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
5f00: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
5f10: 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 ept 8828]. pu
5f20: 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 ts $p1 open.
5f30: 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 puts $p2 open.
5f40: 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a puts $p3 open.
5f50: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
5f60: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
5f70: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
5f80: 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 ncel $t1. aft
5f90: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 er cancel $t2.
5fa0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5fb0: 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a t3. close $s.
5fc0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5fd0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 lappend l [list
5fe0: 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 p1 [gets $p1] $
5ff0: 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c x]. lappend l
6000: 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 [list p2 [gets
6010: 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 $p2] $x]. lap
6020: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 pend l [list p3
6030: 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 [gets $p3] $x].
6040: 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a puts $p1 bye.
6050: 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 puts $p2 bye
6060: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 . puts $p3 by
6070: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a e. close $p1.
6080: 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 close $p2.
6090: 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 close $p3.
60a0: 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 set l.} {{p1 bye
60b0: 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 done} {p2 bye d
60c0: 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e one} {p3 bye don
60d0: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
60e0: 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 4.2 {byte order
60f0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
6100: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
6110: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
6120: 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 set x ok. if
6130: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
6140: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
6150: 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 o 0x3000} msg]}
6160: 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 {..set x $msg.
6170: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
6180: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
6190: 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 set x.} ok..tes
61a0: 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 t tlsIO-5.1 {byt
61b0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
61c0: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
61d0: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
61e0: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
61f0: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
6200: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
6210: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
6220: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
6230: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
6240: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
6250: 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 1} msg]} {.
6260: 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 set x {htons
6270: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
6280: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
6290: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
62a0: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
62b0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
62c0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
62d0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
62e0: 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 owner}.test tlsI
62f0: 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-5.2 {byte orde
6300: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
6310: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
6320: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
6330: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
6340: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
6350: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
6360: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
6370: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
6380: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
6390: 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a x10000} msg]} {.
63a0: 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 .set x {port res
63b0: 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c olution problem,
63c0: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
63d0: 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d lowed}..close $m
63e0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
63f0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
6400: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
6410: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
6420: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 }.test tlsIO-5.3
6430: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
6440: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
6450: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a mbers, htons} \.
6460: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c .{socket unixOnl
6470: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 y notRoot} {.
6480: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
6490: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
64a0: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 t owner}. if
64b0: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
64c0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
64d0: 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 do 21} msg]} {..
64e0: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
64f0: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
6500: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
6510: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
6520: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
6530: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
6540: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
6550: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
6560: 65 72 7d 0a 0a 69 66 20 7b 30 7d 20 7b 0a 20 20 er}..if {0} {.
6570: 20 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 package requir
6580: 65 20 74 6c 73 0a 0a 20 20 20 20 70 72 6f 63 20 e tls.. proc
6590: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
65a0: 0a 09 70 75 74 73 20 5b 69 6e 66 6f 20 6c 65 76 ..puts [info lev
65b0: 65 6c 20 30 5d 0a 09 65 78 70 72 20 31 30 20 2f el 0]..expr 10 /
65c0: 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 0. }. set
65d0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
65e0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
65f0: 38 34 38 5d 0a 0a 20 20 20 20 70 72 6f 63 20 62 848].. proc b
6600: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 20 70 75 gerror args { pu
6610: 74 73 20 22 62 67 65 72 72 6f 72 3a 20 24 61 72 ts "bgerror: $ar
6620: 67 73 22 20 7d 0a 20 20 20 20 73 65 74 20 73 20 gs" }. set s
6630: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 7a 61 6d [tls::socket zam
6640: 6f 72 61 2e 73 63 72 69 70 74 69 63 73 2e 63 6f ora.scriptics.co
6650: 6d 20 38 38 34 38 5d 0a 7d 0a 0a 74 65 73 74 20 m 8848].}..test
6660: 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 tlsIO-6.1 {accep
6670: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
6680: 7d 20 7b 20 73 6f 63 6b 65 74 20 73 74 64 69 6f } { socket stdio
6690: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
66a0: 23 20 48 4f 42 42 53 3a 20 73 74 69 6c 6c 20 66 # HOBBS: still f
66b0: 61 69 6c 73 20 70 6f 73 74 2d 72 65 77 72 69 74 ails post-rewrit
66c0: 65 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 e. removeFile
66d0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
66e0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
66f0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
6700: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
6710: 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 uire tls..gets s
6720: 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 tdin..tls::socke
6730: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 t 127.0.0.1 8848
6740: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
6750: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
6760: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6770: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6780: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6790: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
67a0: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
67b0: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
67c0: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
67d0: 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 t {s a p} {expr
67e0: 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 10 / 0}. set
67f0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
6800: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
6810: 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 48]. puts $f
6820: 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 hello. close
6830: 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 $f. set timer
6840: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
6850: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
6860: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
6870: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
6880: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
6890: 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 s. rename bge
68a0: 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 rror {}. set
68b0: 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 x.} {{divide by
68c0: 7a 65 72 6f 7d 7d 0a 0a 23 20 62 75 67 20 72 65 zero}}..# bug re
68d0: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
68e0: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
68f0: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
6900: 2d 70 65 65 72 6e 61 6d 65 27 0a 0a 74 65 73 74 -peername'..test
6910: 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 tlsIO-7.1 {test
6920: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6930: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
6940: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
6950: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
6960: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
6970: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
6980: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
6990: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
69a0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
69b0: 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 $f "tls::socket
69c0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
69d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
69e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
69f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6a00: 65 72 76 65 72 4b 65 79 20 38 38 32 30 22 0a 20 erverKey 8820".
6a10: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
6a20: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
6a30: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
6a40: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
6a50: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
6a60: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
6a70: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
6a80: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
6a90: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
6aa0: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
6ab0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6ac0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6ad0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6ae0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6af0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
6b00: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6b10: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
6b20: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
6b30: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6b40: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
6b50: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
6b60: 2e 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 .0.0.1 8820].
6b70: 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 set p [fconfigu
6b80: 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d re $s -peername]
6b90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6ba0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6bb0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
6bc0: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f end l [string co
6bd0: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 mpare [lindex $p
6be0: 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 0] 127.0.0.1].
6bf0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
6c00: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
6c10: 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d ndex $p 2] 8820]
6c20: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6c30: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 llength $p].} {0
6c40: 20 30 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 0 3}..# bug rep
6c50: 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 ort #5812 fconfi
6c60: 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 gure doesn't ret
6c70: 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d urn value for '-
6c80: 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 sockname'..test
6c90: 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 tlsIO-7.2 {testi
6ca0: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6cb0: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
6cc0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6cd0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6ce0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6cf0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6d00: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
6d10: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6d20: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6d30: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
6d40: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
6d50: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6d60: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6d70: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6d80: 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 20 rverKey 8821".
6d90: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
6da0: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6db0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6dc0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6dd0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
6de0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6df0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6e00: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
6e10: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
6e20: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
6e30: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6e40: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6e50: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6e60: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6e70: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6e80: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6e90: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6ea0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6eb0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6ec0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6ed0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
6ee0: 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 0.0.1 8821].
6ef0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
6f00: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6f10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6f20: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6f30: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6f40: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
6f50: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6f60: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
6f70: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6f80: 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 ing equal [linde
6f90: 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 x $p 2] 8821].}
6fa0: 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a {3 127.0.0.1 0}.
6fb0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 .test tlsIO-7.3
6fc0: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6fd0: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6fe0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
6ff0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7000: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7010: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7020: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7030: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7040: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
7050: 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 20 accept 8822].
7060: 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 set l [fconfigu
7070: 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 re $s]. close
7080: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 $s. update.
7090: 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 llength $l.}
70a0: 31 32 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 12..# bug report
70b0: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
70c0: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
70d0: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
70e0: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
70f0: 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 IO-7.4 {testing
7100: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
7110: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
7120: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
7130: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7140: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
7150: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7160: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7170: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
7180: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
7190: 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 23]. proc acc
71a0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
71b0: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b lobal x..set x [
71c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
71d0: 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 ockname]..close
71e0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
71f0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
7200: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
7210: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7220: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7230: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7240: 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e .[info hostn
7250: 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 73 ame] 8823]. s
7260: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
7270: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
7280: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
7290: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
72a0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
72b0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
72c0: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
72d0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
72e0: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d l [lindex $x 2]
72f0: 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 [llength $x].}
7300: 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 {8823 3}..# bug
7310: 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f report #5812 fco
7320: 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 nfigure doesn't
7330: 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 return value for
7340: 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 '-sockname'..te
7350: 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 st tlsIO-7.5 {te
7360: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7370: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
7380: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 7d socket unixOrPc}
7390: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
73a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
73b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
73c0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
73d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
73e0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
73f0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
7400: 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 8829]. proc
7410: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
7420: 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 ..global x..set
7430: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
7440: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f -sockname]..clo
7450: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
7460: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
7470: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
7480: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7490: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
74a0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
74b0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
74c0: 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 0.0.1 8829].
74d0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
74e0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
74f0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
7500: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
7510: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
7520: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7530: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7540: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
7550: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
7560: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
7570: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
7580: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 127.0.0.1 8829 3
7590: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e }..test tlsIO-8.
75a0: 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 1 {testing -asyn
75b0: 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 c flag on socket
75c0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
75d0: 20 20 23 20 48 4f 42 42 53 3a 20 73 74 69 6c 6c # HOBBS: still
75e0: 20 66 61 69 6c 73 20 70 6f 73 74 2d 72 65 77 72 fails post-rewr
75f0: 69 74 65 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 ite. # NOTE:
7600: 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 This test may fa
7610: 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 il on some Solar
7620: 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a is 2.4 systems..
7630: 20 20 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 # See notes
7640: 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e in Tcl's socket.
7650: 74 65 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 test.. set s
7660: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7670: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
7680: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7690: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
76a0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
76b0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
76c0: 65 70 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 ept 8830]. pr
76d0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
76e0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 } {..global x..#
76f0: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
7700: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
7710: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
7720: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 th sides need..#
7730: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
7740: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
7750: 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f handshake. Also
7760: 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f make sure..# to
7770: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
7780: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
7790: 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f ering mode...fco
77a0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
77b0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
77c0: 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 g line..puts $s
77d0: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 bye..close $s..s
77e0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a et x done. }.
77f0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
7800: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7810: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
7820: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7830: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7840: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
7850: 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f 73 -async [info hos
7860: 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 tname] 8830].
7870: 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e # when doing an
7880: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
7890: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
78a0: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
78b0: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
78c0: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
78d0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 TLS handshake
78e0: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 Also make sure t
78f0: 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 o. # return t
7900: 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 he channel to li
7910: 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 ne buffering mod
7920: 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 e (TLS sets it t
7930: 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 o 'none').. f
7940: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
7950: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7960: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 ring line. vw
7970: 61 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 ait x. # TLS
7980: 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 handshaking need
7990: 73 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 s one byte from
79a0: 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 the client....
79b0: 20 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 puts $s1 a.
79c0: 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 # need update t
79d0: 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 o complete TLS h
79e0: 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 andshake in-proc
79f0: 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 ess. update.
7a00: 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 set z [gets $
7a10: 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 s1]. close $s
7a20: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
7a30: 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a set z.} bye..
7a40: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b test tlsIO-9.1 {
7a50: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
7a60: 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 events} {socket
7a70: 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 } {. set len
7a80: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
7a90: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
7aa0: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
7ab0: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
7ac0: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
7ad0: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
7ae0: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
7af0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
7b00: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
7b10: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
7b20: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
7b30: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
7b40: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
7b50: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
7b60: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
7b70: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
7b80: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
7b90: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
7ba0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
7bb0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7bc0: 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e king 0..fileeven
7bd0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
7be0: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
7bf0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 $s readable rea
7c00: 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 dlittle \...-buf
7c10: 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 fering none].
7c20: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
7c30: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
7c40: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
7c50: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
7c60: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
7c70: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
7c80: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
7c90: 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 8831]. set c
7ca0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7cb0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7cc0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7cd0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7ce0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7cf0: 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 .. [info host
7d00: 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 name] 8831].
7d10: 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 66 # This differs f
7d20: 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 rom socket-9.1 i
7d30: 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 n that both side
7d40: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 s need to be.
7d50: 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 # non-blocking
7d60: 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 because of TLS'
7d70: 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 required handsha
7d80: 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ke. fconfigur
7d90: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
7da0: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
7db0: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
7dc0: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
7dd0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
7de0: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 0123456789. c
7df0: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
7e00: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
7e10: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
7e20: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
7e30: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
7e40: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
7e50: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
7e60: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
7e70: 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 $len.} {0 50}..t
7e80: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 est tlsIO-9.2 {t
7e90: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
7ea0: 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 te, fileevents,
7eb0: 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 flush on close}
7ec0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
7ed0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
7ee0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
7ef0: 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 1]. set secon
7f00: 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 dblock [string r
7f10: 65 70 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 epeat b 65535].
7f20: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7f30: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
7f40: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
7f50: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
7f60: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
7f70: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
7f80: 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 readable readab
7f90: 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 le \...-translat
7fa0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
7fb0: 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 ze 16384 -buffer
7fc0: 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a ing line]. }.
7fd0: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
7fe0: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
7ff0: 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 gets $s]..dputs
8000: 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 "got \"[string r
8010: 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 eplace $l 10 end
8020: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
8030: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8040: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c ]) from $s"..fil
8050: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
8060: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
8070: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
8080: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
8090: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
80a0: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 l firstblock..dp
80b0: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
80c0: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 ing replace $fir
80d0: 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 stblock 10 end-3
80e0: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
80f0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 ring length $fir
8100: 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 stblock]) down $
8110: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
8120: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
8130: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
8140: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
8150: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
8160: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
8170: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
8180: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8190: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 tring replace $s
81a0: 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e econdblock 10 en
81b0: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
81c0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
81d0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f secondblock]) do
81e0: 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f wn $s"..puts -no
81f0: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
8200: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
8210: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
8220: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8230: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8240: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8250: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8260: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8270: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
8280: 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 ccept 8832].
8290: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
82a0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
82b0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
82c0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
82d0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
82e0: 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f Key \.. [info
82f0: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 32 5d hostname] 8832]
8300: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8310: 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $c -blocking 0 -
8320: 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 trans lf -buffer
8330: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
8340: 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 count 0. put
8350: 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 20 20 70 s $c hello. p
8360: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
8370: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 ..global count d
8380: 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 20 5b 72 one..set data [r
8390: 65 61 64 20 24 73 5d 0a 09 64 70 75 74 73 20 22 ead $s]..dputs "
83a0: 72 65 61 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 read \"[string r
83b0: 65 70 6c 61 63 65 20 24 64 61 74 61 20 31 30 20 eplace $data 10
83c0: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
83d0: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
83e0: 20 24 64 61 74 61 5d 29 20 66 72 6f 6d 20 24 73 $data]) from $s
83f0: 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 "..incr count [s
8400: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 tring length $da
8410: 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 ta]..if {[eof $s
8420: 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 ]} {.. close
8430: 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 $s.. set done
8440: 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 1..}. }.
8450: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
8460: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 63 dable "readit $c
8470: 22 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 ". set done 0
8480: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
8490: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
84a0: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
84b0: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
84c0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
84d0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
84e0: 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 se $s. list $
84f0: 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 count $done.} {6
8500: 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 20 74 6c 5566 1}..test tl
8510: 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-9.3 {testing
8520: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
8530: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 {unexplainedFai
8540: 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 lure socket} {.
8550: 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 # HOBBS: neve
8560: 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 r worked correct
8570: 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e ly. proc coun
8580: 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 t_to_eof {s} {..
8590: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
85a0: 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b e timer..set l [
85b0: 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 gets $s]..if {[e
85c0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 of $s]} {.. i
85d0: 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 ncr count.. i
85e0: 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b f {$count > 9} {
85f0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
8600: 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 t done true...se
8610: 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 t count {eof is
8620: 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 sticky}...after
8630: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 cancel $timer..
8640: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
8650: 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 proc timerproc
8660: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f {} {..global do
8670: 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 ne count c..set
8680: 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 done true..set c
8690: 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 ount {timer went
86a0: 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 off, eof is not
86b0: 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 sticky}..close
86c0: 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 65 $c. }.. se
86d0: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 t count 0. se
86e0: 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 t done false.
86f0: 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 6e proc write_then
8700: 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 _close {s} {..pu
8710: 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 ts $s bye..close
8720: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
8730: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8740: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
8750: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
8760: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
8770: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 translation lf..
8780: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 fileevent $s wri
8790: 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 table [list do_h
87a0: 61 6e 64 73 68 61 6b 65 20 24 73 20 77 72 69 74 andshake $s writ
87b0: 61 62 6c 65 20 77 72 69 74 65 5f 74 68 65 6e 5f able write_then_
87c0: 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 66 66 65 close \...-buffe
87d0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
87e0: 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 20 7d lation lf]. }
87f0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
8800: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
8810: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
8820: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8830: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8840: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8850: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
8860: 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 833]. set c [
8870: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8880: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8890: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
88a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
88b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
88c0: 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 [info hostna
88d0: 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 63 me] 8833]. fc
88e0: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
88f0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
8900: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
8910: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 tion lf. file
8920: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8930: 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 e "count_to_eof
8940: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
8950: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 74 69 r [after 2000 ti
8960: 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 merproc]. vwa
8970: 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 it done. clos
8980: 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 e $s. set cou
8990: 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 nt.} {eof is sti
89a0: 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 cky}..removeFile
89b0: 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c script..test tl
89c0: 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e sIO-10.1 {testin
89d0: 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 g socket accept
89e0: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 callback error h
89f0: 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 andling} {socket
8a00: 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 } {. set gote
8a10: 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 rror 0. proc
8a20: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c bgerror args {gl
8a30: 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 obal goterror; s
8a40: 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 et goterror 1}.
8a50: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8a60: 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 ocket -cafile $c
8a70: 61 43 65 72 74 20 2d 73 65 72 76 65 72 20 61 63 aCert -server ac
8a80: 63 65 70 74 20 38 38 39 38 5d 0a 20 20 20 20 70 cept 8898]. p
8a90: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8aa0: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 p} {close $s; er
8ab0: 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b ror}. set c [
8ac0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 tls::socket -caf
8ad0: 69 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 2e ile $caCert 127.
8ae0: 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 20 20 20 0.0.1 8898].
8af0: 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 vwait goterror.
8b00: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
8b10: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 close $c. set
8b20: 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 goterror.} 1..t
8b30: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 20 7b est tlsIO-11.1 {
8b40: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
8b50: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
8b60: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
8b70: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
8b80: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
8b90: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
8ba0: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
8bb0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
8bc0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
8bd0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8be0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
8bf0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8c00: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
8c10: 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 4]..proc accept
8c20: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
8c30: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
8c40: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 64 6f .. puts $s do
8c50: 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ne.. close $s
8c60: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
8c70: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8c80: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8c90: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8ca0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8cb0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8cc0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
8cd0: 53 65 72 76 65 72 49 50 20 38 38 33 34 5d 0a 20 ServerIP 8834].
8ce0: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
8cf0: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
8d00: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8d10: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f {close $socket9_
8d20: 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 1_test_server}.
8d30: 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a set r.} done.
8d40: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 .test tlsIO-11.2
8d50: 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 {client specifi
8d60: 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f es its port} {so
8d70: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8d80: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8d90: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
8da0: 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 ists port]} {..i
8db0: 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 ncr port. } e
8dc0: 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 lse {..set port
8dd0: 5b 65 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 [expr $tlsServer
8de0: 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 Port + [pid]%102
8df0: 34 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 4]. }. sen
8e00: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
8e10: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
8e20: 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 et socket9_2_tes
8e30: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
8e40: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
8e50: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
8e60: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8e70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8e80: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8e90: 65 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 ey 8835]..proc a
8ea0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8eb0: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
8ec0: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
8ed0: 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 $s $p.. clos
8ee0: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
8ef0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8f00: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8f10: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8f20: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8f30: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8f40: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 ntKey \.. -my
8f50: 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f port $port $remo
8f60: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 35 5d teServerIP 8835]
8f70: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
8f80: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
8f90: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
8fa0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
8fb0: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_2_test_server}
8fc0: 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 . if {$r == $
8fd0: 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 port} {..set res
8fe0: 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 ult ok. } els
8ff0: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9000: 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 broken. }.
9010: 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b set result.} ok
9020: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9030: 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 3 {trying to con
9040: 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d nect, no server}
9050: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
9060: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9070: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 } {. set stat
9080: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b us ok. if {![
9090: 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c catch {set s [tl
90a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
90b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
90c0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
90d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
90e0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
90f0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9100: 70 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 p 8836]}]} {..if
9110: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
9120: 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 $s}]} {.. set
9130: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
9140: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 }..close $s.
9150: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
9160: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
9170: 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 O-11.4 {remote e
9180: 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b cho, one line} {
9190: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
91a0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
91b0: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
91c0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
91d0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
91e0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
91f0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
9200: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
9210: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9220: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9230: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9240: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
9250: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
9260: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9270: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9280: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
9290: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
92a0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
92b0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
92c0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
92d0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
92e0: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
92f0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
9300: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
9310: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
9320: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
9330: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
9340: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
9350: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9360: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
9370: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9380: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9390: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
93a0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
93b0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
93c0: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
93d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
93e0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
93f0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9400: 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c . puts $f hel
9410: 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 lo. set r [ge
9420: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
9430: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
9440: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
9450: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
9460: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
9470: 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 hello..test tlsI
9480: 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 O-11.5 {remote e
9490: 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b cho, 50 lines} {
94a0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
94b0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
94c0: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
94d0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
94e0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
94f0: 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 et10_7_test_serv
9500: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
9510: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
9520: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9530: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9540: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9550: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9560: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9570: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9580: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9590: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
95a0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
95b0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
95c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
95d0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
95e0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
95f0: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9600: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
9610: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
9620: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
9630: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
9640: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
9650: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
9660: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
9670: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9680: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9690: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
96a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
96b0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
96c0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
96d0: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
96e0: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
96f0: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
9700: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9710: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
9720: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
9730: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
9740: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
9750: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
9760: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
9770: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
9780: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
9790: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
97a0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
97b0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
97c0: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
97d0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
97e0: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
97f0: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
9800: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
9810: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
9820: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
9830: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
9840: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
9850: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
9860: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 33 ictResult {0 883
9870: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
9880: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
9890: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
98a0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
98b0: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
98c0: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c use}}.}..test tl
98d0: 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 sIO-11.6 {socket
98e0: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
98f0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9900: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9910: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9920: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9930: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9940: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9950: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9960: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
9970: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
9980: 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 6]. if {[catc
9990: 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a h {set s2 [tls::
99a0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
99b0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
99c0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
99d0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
99e0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
99f0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
9a00: 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 36]} msg]} {..se
9a10: 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 t result [list 1
9a20: 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 $msg]. } els
9a30: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9a40: 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 [list 0 [lindex
9a50: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 [fconfigure $s2
9a60: 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 -sockname] 2]]..
9a70: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a close $s2. }.
9a80: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
9a90: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 set result.} $
9aa0: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a conflictResult..
9ab0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 test tlsIO-11.7
9ac0: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
9ad0: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
9ae0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9af0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9b00: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
9b10: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
9b20: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9b30: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
9b40: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
9b50: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9b60: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9b70: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9b80: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9b90: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
9ba0: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
9bb0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
9bc0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9bd0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9be0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9bf0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
9c00: 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 echo $s]..}..pr
9c10: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
9c20: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
9c30: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
9c40: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
9c50: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
9c60: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
9c70: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
9c80: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9c90: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9ca0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9cb0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9cc0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9cd0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9ce0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9cf0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9d00: 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e re $s1 -bufferin
9d10: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
9d20: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
9d30: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9d40: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9d50: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9d60: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9d70: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9d80: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
9d90: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
9da0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9db0: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
9dc0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9dd0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9de0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9df0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9e00: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9e10: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9e20: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
9e30: 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 gure $s3 -buffer
9e40: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
9e50: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
9e60: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
9e70: 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f ..puts $s1 hello
9e80: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
9e90: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 uts $s2 hello,s2
9ea0: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
9eb0: 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 $s3 hello,s3..g
9ec0: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
9ed0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9ee0: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
9ef0: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
9f00: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9f10: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
9f20: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9f30: 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 i.} 100 ..tes
9f40: 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c t tlsIO-11.8 {cl
9f50: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
9f60: 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b l servers} {sock
9f70: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9f80: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9f90: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
9fa0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9fb0: 20 7b 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 {..tls::init -c
9fc0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9fd0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9fe0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9ff0: 72 76 65 72 4b 65 79 0a 09 73 65 74 20 73 31 20 rverKey..set s1
a000: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
a010: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
a020: 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 3" 4003]..set s2
a030: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
a040: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
a050: 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 04" 4004]..set s
a060: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 3 [tls::socket -
a070: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
a080: 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 005" 4005]..proc
a090: 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d 70 handshake {s mp
a0a0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f } {.. if {[eo
a0b0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
a0c0: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 $s.. } elsei
a0d0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
a0e0: 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 handshake $s} re
a0f0: 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d sult]} {...# Som
a100: 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 e errors are nor
a110: 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 mal... } else
a120: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
a130: 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b } {...# Handshak
a140: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c e complete...fil
a150: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
a160: 6c 65 20 22 22 0a 09 09 70 75 74 73 20 24 73 20 le ""...puts $s
a170: 24 6d 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 $mp...close $s..
a180: 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 }..}..proc a
a190: 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d ccept {mp s a p}
a1a0: 20 7b 0a 09 20 20 20 20 23 20 54 68 65 73 65 20 {.. # These
a1b0: 68 61 76 65 20 74 6f 20 61 63 63 65 70 74 20 6e have to accept n
a1c0: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 on-blocking, bec
a1d0: 61 75 73 65 20 74 68 65 20 68 61 6e 64 73 68 61 ause the handsha
a1e0: 6b 69 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 65 king.. # orde
a1f0: 72 20 69 73 6e 27 74 20 64 65 74 65 72 6d 69 6e r isn't determin
a200: 69 73 74 69 63 0a 09 20 20 20 20 66 63 6f 6e 66 istic.. fconf
a210: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
a220: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
a230: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
a240: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
a250: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
a260: 24 73 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d $s $mp]..}. }
a270: 0a 20 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 2d . tls::init -
a280: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
a290: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a2a0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
a2b0: 6c 69 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 74 lientKey. set
a2c0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
a2d0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a2e0: 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 4003]. set s
a2f0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 2 [tls::socket $
a300: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
a310: 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 004]. set s3
a320: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a330: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a340: 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 5]. set l "".
a350: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 lappend l [g
a360: 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 ets $s1] [gets $
a370: 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 s1] [eof $s1] [g
a380: 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 ets $s2] [gets $
a390: 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a s2] [eof $s2] \.
a3a0: 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 .[gets $s3] [get
a3b0: 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d s $s3] [eof $s3]
a3c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
a3d0: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
a3e0: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
a3f0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c endCommand {..cl
a400: 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 ose $s1..close $
a410: 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 s2..close $s3.
a420: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 }. set l.}
a430: 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 {4003 {} 1 4004
a440: 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a {} 1 4005 {} 1}.
a450: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 .test tlsIO-11.9
a460: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
a470: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
a480: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
a490: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
a4a0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a4b0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a4c0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
a4d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a4e0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a4f0: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
a500: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
a510: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
a520: 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 {s a p} {expr 10
a530: 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 / 0}. proc b
a540: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
a550: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
a560: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 args. }. s
a570: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
a580: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
a590: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 ndCommand {..
a5a0: 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 set peername [f
a5b0: 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 configure $calle
a5c0: 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d rSocket -peernam
a5d0: 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 e].. set s [t
a5e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 ls::socket \...
a5f0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
a600: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
a610: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a620: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a630: 09 20 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 65 . [lindex $pe
a640: 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a ername 0] 8836].
a650: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a660: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
a670: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
a680: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
a690: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
a6a0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
a6b0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
a6c0: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
a6d0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a6e0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
a6f0: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
a700: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
a710: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
a720: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
a730: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
a740: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
a750: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a760: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a770: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
a780: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
a790: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
a7a0: 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 socket10_12_test
a7b0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
a7c0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
a7d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
a7e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a7f0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a800: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
a810: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
a820: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
a830: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
a840: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
a850: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
a860: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a870: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a880: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a890: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a8a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a8b0: 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 8836]. set p
a8c0: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
a8d0: 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 -peername]. s
a8e0: 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 et n [fconfigure
a8f0: 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 $s -sockname].
a900: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
a910: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
a920: 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $p 2] [llength
a930: 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 $p] [llength $p
a940: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
a950: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a960: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
a970: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 12_test_server}.
a980: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 set l.} {883
a990: 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 6 3 3}..test tls
a9a0: 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e IO-11.11 {testin
a9b0: 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 g spurious event
a9c0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a9d0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a9e0: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f er} {. # remo
a9f0: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 te equivalent of
aa00: 20 39 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 9.1. sendCer
aa10: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
aa20: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
aa30: 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 ocket_test_serve
aa40: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
aa50: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
aa60: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
aa70: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
aa80: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
aa90: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
aaa0: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
aab0: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 20 e {s} {.. if
aac0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
aad0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
aae0: 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 lseif {[catch {t
aaf0: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
ab00: 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 } result]} {...#
ab10: 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 Some errors are
ab20: 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 normal... }
ab30: 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 elseif {$result
ab40: 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 == 1} {...# Hand
ab50: 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 shake complete..
ab60: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 .fileevent $s wr
ab70: 69 74 61 62 6c 65 20 22 22 0a 09 09 61 66 74 65 itable ""...afte
ab80: 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 r 100 writesome
ab90: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 $s.. }..}..pr
aba0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
abb0: 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 } {.. fconfig
abc0: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 ure $s -translat
abd0: 69 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 ion "auto lf"..
abe0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
abf0: 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 68 writable [list h
ac00: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d 0a andshake $s]..}.
ac10: 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 .proc writesome
ac20: 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b {s} {.. for {
ac30: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
ac40: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
ac50: 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 .puts $s "line $
ac60: 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 i from remote se
ac70: 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 rver".. }..
ac80: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
ac90: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 }. set len
aca0: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
acb0: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
acc0: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
acd0: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
ace0: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
acf0: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
ad00: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
ad10: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
ad20: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
ad30: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
ad40: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
ad50: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
ad60: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
ad70: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
ad80: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
ad90: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
ada0: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
adb0: 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 }. set c [tls
adc0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
add0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
ade0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
adf0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
ae00: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
ae10: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
ae20: 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 74 8836]. # Get
ae30: 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 63 the buffering c
ae40: 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 6f orrected. fco
ae50: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 66 nfigure $c -buff
ae60: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 23 ering line. #
ae70: 20 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f Put a byte into
ae80: 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 65 the client pipe
ae90: 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 20 to trigger TLS
aea0: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 20 handshaking.
aeb0: 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 69 puts $c a. fi
aec0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
aed0: 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 ble [list readli
aee0: 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 74 ttle $c]. set
aef0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
af00: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
af10: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
af20: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
af30: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
af40: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
af50: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 5f {close $socket_
af60: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
af70: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
af80: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
af90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
afa0: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
afb0: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
afc0: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
afd0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
afe0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
aff0: 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 . # remote eq
b000: 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 0a uivalent of 9.3.
b010: 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 # HOBBS: nev
b020: 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 er worked correc
b030: 74 6c 79 0a 20 20 20 20 73 65 74 20 63 6f 75 6e tly. set coun
b040: 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f ter 0. set do
b050: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f ne 0. proc co
b060: 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c unt_up {s} {..gl
b070: 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e obal counter don
b080: 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 e after_id..set
b090: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
b0a0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
b0b0: 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 incr counter..
b0c0: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 if {$counter
b0d0: 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f > 9} {...set do
b0e0: 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b ne {EOF is stick
b0f0: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
b100: 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c l $after_id...cl
b110: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
b120: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
b130: 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 timed_out {} {..
b140: 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 global c done..s
b150: 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f et done {timed_o
b160: 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 ut, EOF is not s
b170: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
b180: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
b190: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
b1a0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
b1b0: 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 socket10_14_tes
b1c0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
b1d0: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
b1e0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
b1f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b200: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
b210: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
b220: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
b230: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b240: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
b250: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
b260: 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 after 100 close
b270: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
b280: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
b290: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b2a0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b2b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b2c0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b2d0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
b2e0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
b2f0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b300: 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e c readable "coun
b310: 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 t_up $c". set
b320: 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 after_id [after
b330: 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 1000 timed_out]
b340: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b350: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b360: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
b370: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _14_test_server}
b380: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
b390: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
b3a0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b3b0: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
b3c0: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
b3d0: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
b3e0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b3f0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b400: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
b410: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
b420: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
b430: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b440: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
b450: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
b460: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
b470: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
b480: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
b490: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
b4a0: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
b4b0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
b4c0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
b4d0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
b4e0: 31 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 1]..set secondbl
b4f0: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
b500: 61 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 at b 65535]..set
b510: 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 l [tls::socket
b520: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
b530: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
b540: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b550: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
b560: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
b570: 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 8845]..proc acc
b580: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b590: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
b5a0: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
b5b0: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
b5c0: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
b5d0: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
b5e0: 31 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 16384 \... -b
b5f0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
b600: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
b610: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 readable "readab
b620: 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 le $s"..}..proc
b630: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
b640: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
b650: 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s].. fileeve
b660: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b nt $s readable {
b670: 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 }.. after 100
b680: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 0 respond $s..}.
b690: 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 .proc respond {s
b6a0: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
b6b0: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
b6c0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
b6d0: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
b6e0: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 after 1000 w
b6f0: 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 ritedata $s..}..
b700: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
b710: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
b720: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 secondblock..
b730: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
b740: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
b750: 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a k.. close $s.
b760: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b770: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
b780: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b790: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b7a0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b7b0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b7c0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
b7d0: 65 72 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 erverIP 8845].
b7e0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
b7f0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
b800: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
b810: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
b820: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
b830: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 puts $s hello.
b840: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
b850: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
b860: 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $s". set time
b870: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
b880: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
b890: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
b8a0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
b8b0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
b8c0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
b8d0: 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 se $l}. set c
b8e0: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 ount.} 65566..te
b8f0: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 st tlsIO-12.1 {t
b900: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
b910: 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 ce of server soc
b920: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 kets} {socket ex
b930: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ec} {. makeFi
b940: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
b950: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
b960: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
b970: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
b980: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
b990: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
b9a0: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
b9b0: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
b9c0: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
b9d0: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
b9e0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
b9f0: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
ba00: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
ba10: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
ba20: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
ba30: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
ba40: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
ba50: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
ba60: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
ba70: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
ba80: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
ba90: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
baa0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
bab0: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
bac0: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
bad0: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
bae0: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
baf0: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
bb00: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
bb10: 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c set tclsh $::tcl
bb20: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
bb30: 20 20 20 70 75 74 73 20 24 66 20 7b 70 61 63 6b puts $f {pack
bb40: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 7d age require tls}
bb50: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
bb60: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
bb70: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
bb80: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
bb90: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
bba0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
bbb0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
bbc0: 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 y 8828\]". pu
bbd0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
bbe0: 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 cept { file addr
bbf0: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 port } {.. c
bc00: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 lose $file..}..e
bc10: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
bc20: 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 t1 &..close $f..
bc30: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
bc40: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
bc50: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
bc60: 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 f... # Launch
bc70: 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 script2 and wai
bc80: 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 t 5 seconds..
bc90: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
bca0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
bcb0: 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 2 &. after 50
bcc0: 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 00 { set ok_to_p
bcd0: 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 roceed 1 }. v
bce0: 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 wait ok_to_proce
bcf0: 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 ed.. # If we
bd00: 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 can still connec
bd10: 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c t to the server,
bd20: 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 the socket got
bd30: 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 inherited...
bd40: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
bd50: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
bd60: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
bd70: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
bd80: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
bd90: 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e tKey \. . 127.
bda0: 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 0.0.1 8828} msg]
bdb0: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 } {..set x {serv
bdc0: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
bdd0: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 t inherited}.
bde0: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
bdf0: 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 $msg..set x {se
be00: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
be10: 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d inherited}. }
be20: 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 .. set x.} {s
be30: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
be40: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
be50: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 .test tlsIO-12.2
be60: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
be70: 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 tance of client
be80: 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 sockets} {socket
be90: 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b exec} {. mak
bea0: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 eFile {} script1
beb0: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
bec0: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
bed0: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
bee0: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
bef0: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
bf00: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
bf10: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
bf20: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
bf30: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
bf40: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
bf50: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
bf60: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
bf70: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
bf80: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
bf90: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
bfa0: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 # Script2 op
bfb0: 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 ens the client s
bfc0: 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 ocket and writes
bfd0: 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e to it. It then
bfe0: 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 . # launches
bff0: 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 script1 and exit
c000: 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 s. If the child
c010: 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 process inherit
c020: 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 ed the. # cli
c030: 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 ent socket, the
c040: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c socket will stil
c050: 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 l be open...
c060: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c070: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
c080: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
c090: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
c0a0: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
c0b0: 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 $f {package req
c0c0: 75 69 72 65 20 74 6c 73 7d 0a 20 20 20 20 70 75 uire tls}. pu
c0d0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
c0e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
c0f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c100: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c110: 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 \.. -keyfile
c120: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
c130: 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 0.0.1 8829\]".
c140: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 puts $f {..exe
c150: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
c160: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
c170: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
c180: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
c190: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c1a0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
c1b0: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
c1c0: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c1d0: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
c1e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
c1f0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
c200: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
c210: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c220: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
c230: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
c240: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
c250: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
c260: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
c270: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
c280: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
c290: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
c2a0: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
c2b0: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
c2c0: 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 erver..fconfigur
c2d0: 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e e $file -blockin
c2e0: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
c2f0: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c file readable [l
c300: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
c310: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
c320: 67 65 74 64 61 74 61 20 5c 0a 09 09 2d 62 75 66 getdata \...-buf
c330: 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 fering line]..re
c340: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 turn. }. p
c350: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 roc getdata { fi
c360: 6c 65 20 7d 20 7b 0a 09 23 20 52 65 61 64 20 68 le } {..# Read h
c370: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
c380: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 cepted socket...
c390: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
c3a0: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
c3b0: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
c3c0: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
c3d0: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
c3e0: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
c3f0: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
c400: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
c410: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c420: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
c430: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
c440: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
c450: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
c460: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
c470: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
c480: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
c490: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
c4a0: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
c4b0: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
c4c0: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
c4d0: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
c4e0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c4f0: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
c500: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c510: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
c520: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
c530: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
c540: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
c550: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
c560: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
c570: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
c580: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
c590: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
c5a0: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
c5b0: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
c5c0: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
c5d0: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
c5e0: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
c5f0: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
c600: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
c610: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
c620: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
c630: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
c640: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c650: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c660: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
c670: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
c680: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
c690: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ed. }. set
c6a0: 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 x.} {client soc
c6b0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
c6c0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
c6d0: 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 IO-12.3 {testing
c6e0: 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 inheritance of
c6f0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 accepted sockets
c700: 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 } {socket exec}
c710: 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b {. makeFile {
c720: 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 } script1. ma
c730: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
c740: 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 2.. set f [op
c750: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
c760: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
c770: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
c780: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c790: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c7a0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
c7b0: 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 script2 w].
c7c0: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
c7d0: 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 t tclsh $::tclte
c7e0: 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 st::tcltest].
c7f0: 20 70 75 74 73 20 24 66 20 7b 70 61 63 6b 61 67 puts $f {packag
c800: 65 20 72 65 71 75 69 72 65 20 74 6c 73 7d 0a 20 e require tls}.
c810: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
c820: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c830: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
c840: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
c850: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
c860: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
c870: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
c880: 38 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 73 8930\]". puts
c890: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
c8a0: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
c8b0: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f ort } {.. glo
c8c0: 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 66 bal tclsh.. f
c8d0: 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 configure $file
c8e0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
c8f0: 09 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 . puts $file
c900: 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f {test data on so
c910: 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 cket}.. exec
c920: 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 $tclsh script1 &
c930: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
c940: 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 exit..}..vwait
c950: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
c960: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
c970: 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 # Launch the scr
c980: 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 ipt2 process and
c990: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 connect to it.
c9a0: 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 See how long.
c9b0: 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 # the socket s
c9c0: 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 tays open.. e
c9d0: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
c9e0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
c9f0: 26 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 &.. after 200
ca00: 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 0 set ok_to_proc
ca10: 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 eed 1. vwait
ca20: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 ok_to_proceed..
ca30: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
ca40: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
ca50: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
ca60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
ca70: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
ca80: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
ca90: 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 20 7.0.0.1 8930].
caa0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
cab0: 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 -buffering full
cac0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
cad0: 23 20 57 65 20 6e 65 65 64 20 74 6f 20 70 75 74 # We need to put
cae0: 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 a byte into the
caf0: 20 72 65 61 64 20 71 75 65 75 65 2c 20 6f 74 68 read queue, oth
cb00: 65 72 77 69 73 65 20 74 68 65 0a 20 20 20 20 23 erwise the. #
cb10: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 64 TLS handshake d
cb20: 6f 65 73 6e 27 74 20 66 69 6e 69 73 68 0a 20 20 oesn't finish.
cb30: 20 20 70 75 74 73 20 24 66 20 61 3b 20 66 6c 75 puts $f a; flu
cb40: 73 68 20 24 66 0a 20 20 20 20 66 69 6c 65 65 76 sh $f. fileev
cb50: 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 ent $f readable
cb60: 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 [list getdata $f
cb70: 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 ].. # If the
cb80: 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 socket is still
cb90: 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 open after 5 sec
cba0: 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 onds, the script
cbb0: 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 1 process. #
cbc0: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
cbd0: 74 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 ted the accepted
cbe0: 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 socket... se
cbf0: 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 t failed 0. a
cc00: 66 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 fter 5000 set fa
cc10: 69 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 iled 1.. proc
cc20: 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 getdata { file
cc30: 7d 20 7b 0a 09 23 20 52 65 61 64 20 68 61 6e 64 } {..# Read hand
cc40: 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e ler on the clien
cc50: 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 t socket...globa
cc60: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
cc70: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
cc80: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
cc90: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
cca0: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
ccb0: 20 20 20 73 65 74 20 78 20 22 72 65 61 64 20 66 set x "read f
ccc0: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
ccd0: 20 24 64 61 74 61 22 0a 09 20 20 20 20 63 61 74 $data".. cat
cce0: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
ccf0: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
cd00: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
cd10: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
cd20: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
cd30: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
cd40: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
cd50: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
cd60: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
cd70: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
cd80: 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a was inherited}.
cd90: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
cda0: 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 set x {accepted
cdb0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
cdc0: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
cdd0: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
cde0: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
cdf0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
ce00: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
ce10: 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 e}.. catch {
ce20: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
ce30: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
ce40: 20 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 0a . vwait x.
ce50: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 set x.} {acc
ce60: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 epted socket was
ce70: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
ce80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 .test tlsIO-13.1
ce90: 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 {Testing use of
cea0: 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 shared socket b
ceb0: 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 etween two threa
cec0: 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 ds} \..{socket t
ced0: 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 20 estthread} {.
cee0: 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 # HOBBS: never
cef0: 74 65 73 74 65 64 0a 20 20 20 20 72 65 6d 6f 76 tested. remov
cf00: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
cf10: 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 threadReap..
cf20: 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 makeFile {.
cf30: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
cf40: 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 tls..set f [tls
cf50: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
cf60: 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 70 accept 8828]..p
cf70: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
cf80: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
cf90: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
cfa0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
cfb0: 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 o $s].
cfc0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
cfd0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
cfe0: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 }..proc
cff0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
d000: 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 global i.
d010: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
d020: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
d030: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
d040: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
d050: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
d060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
d070: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
d080: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
d090: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
d0a0: 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 } else { ..
d0b0: 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 incr i.
d0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
d0d0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
d0e0: 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 }..}..set i
d0f0: 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 0..vwait x..clo
d100: 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 64 se $f...# thread
d110: 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 75 cleans itself u
d120: 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 65 p...testthread e
d130: 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 74 xit. } script
d140: 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 61 . . # crea
d150: 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 te a thread.
d160: 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 64 set serverthread
d170: 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 65 [testthread cre
d180: 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 ate { source scr
d190: 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 ipt } ]. upda
d1a0: 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 65 te. . afte
d1b0: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 r 1000. set s
d1c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
d1d0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
d1e0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
d1f0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
d200: 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 75 . catch {..pu
d210: 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 ts $s "hello"..g
d220: 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 20 ets $s result.
d230: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
d240: 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 . update..
d250: 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 20 after 2000.
d260: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
d270: 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 20 threadReap].
d280: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
d290: 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 .} {hello 1}..#
d2a0: 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 cleanup.if {[str
d2b0: 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 ing match sock*
d2c0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 $commandSocket]
d2d0: 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 == 1} {. puts
d2e0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 $commandSocket e
d2f0: 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f xit. flush $co
d300: 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 mmandSocket.}.ca
d310: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d tch {close $comm
d320: 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 andSocket}.catch
d330: 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 {close $remoteP
d340: 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 rocChan}.::tclte
d350: 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 st::cleanupTests
d360: 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 .flush stdout.re
d370: 74 75 72 6e 0a turn.