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 32 31 20 32 30 30 34 2f 30 32 2f 31 31 20 32 .21 2004/02/11 2
0210: 32 3a 34 31 3a 32 35 20 72 61 7a 7a 65 6c 6c 20 2:41:25 razzell
0220: 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 Exp $..# Running
0230: 20 73 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 socket tests wi
0240: 74 68 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 th a remote serv
0250: 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d er:.# ----------
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: 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 .# .# Some tests
0290: 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 in socket.test
02a0: 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 depend on the ex
02b0: 69 73 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d istence of a rem
02c0: 6f 74 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 ote server to.#
02d0: 77 68 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 which they conne
02e0: 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 ct. The remote s
02f0: 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e erver must be an
0300: 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c instance of tcl
0310: 74 65 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 test and it.# mu
0320: 73 74 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 st run the scrip
0330: 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 t found in the f
0340: 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 ile "remote.tcl"
0350: 20 69 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f in this directo
0360: 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 ry. You.# can st
0370: 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 art the remote s
0380: 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 erver on any mac
0390: 68 69 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 hine reachable f
03a0: 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 rom the machine
03b0: 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 on.# which you w
03c0: 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 ant to run the s
03d0: 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 ocket tests, by
03e0: 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 20 20 20 issuing:.# .#
03f0: 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 tcltest remote
0400: 2e 74 63 6c 20 2d 70 6f 72 74 20 38 30 34 38 09 .tcl -port 8048.
0410: 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 # Or choose anot
0420: 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e her port number.
0430: 0a 23 20 0a 23 20 49 66 20 74 68 65 20 6d 61 63 .# .# If the mac
0440: 68 69 6e 65 20 79 6f 75 20 61 72 65 20 72 75 6e hine you are run
0450: 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 ning the remote
0460: 73 65 72 76 65 72 20 6f 6e 20 68 61 73 20 73 65 server on has se
0470: 76 65 72 61 6c 20 49 50 0a 23 20 69 6e 74 65 72 veral IP.# inter
0480: 66 61 63 65 73 2c 20 79 6f 75 20 63 61 6e 20 63 faces, you can c
0490: 68 6f 6f 73 65 20 77 68 69 63 68 20 69 6e 74 65 hoose which inte
04a0: 72 66 61 63 65 20 74 68 65 20 73 65 72 76 65 72 rface the server
04b0: 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 6f 72 0a listens on for.
04c0: 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 62 79 # connections by
04d0: 20 73 70 65 63 69 66 79 69 6e 67 20 74 68 65 20 specifying the
04e0: 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 -address command
04f0: 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 6f 3a 0a line flag, so:.
0500: 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 # .# tcltest
0510: 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 64 64 remote.tcl -add
0520: 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e ress your.machin
0530: 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 65 73 65 e.com.# .# These
0540: 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 6c 73 options can als
0550: 6f 20 62 65 20 73 65 74 20 62 79 20 65 6e 76 69 o be set by envi
0560: 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 ronment variable
0570: 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 s. On Unix, you
0580: 63 61 6e 0a 23 20 74 79 70 65 20 74 68 65 73 65 can.# type these
0590: 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 commands to the
05a0: 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 69 63 shell from whic
05b0: 68 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 h the remote ser
05c0: 76 65 72 20 69 73 20 73 74 61 72 74 65 64 3a 0a ver is started:.
05d0: 23 20 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 # .# shell%
05e0: 73 65 74 65 6e 76 20 73 65 72 76 65 72 50 6f 72 setenv serverPor
05f0: 74 20 38 30 34 38 0a 23 20 20 20 20 20 73 68 65 t 8048.# she
0600: 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 ll% setenv serve
0610: 72 41 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 rAddress your.ma
0620: 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 chine.com.# .# a
0630: 6e 64 20 73 75 62 73 65 71 75 65 6e 74 6c 79 20 nd subsequently
0640: 79 6f 75 20 63 61 6e 20 73 74 61 72 74 20 74 68 you can start th
0650: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
0660: 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 20 20 74 with:.# .# t
0670: 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 cltest remote.tc
0680: 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 65 20 69 l.# .# to have i
0690: 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 t listen on port
06a0: 20 38 30 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 8048 on the int
06b0: 65 72 66 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 erface your.mach
06c0: 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 20 0a ine.com..# .
06d0: 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 76 65 # When the serve
06e0: 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 72 69 r starts, it pri
06f0: 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 69 6c nts out a detail
0700: 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 61 ed message conta
0710: 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e 66 ining its.# conf
0720: 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 6d iguration inform
0730: 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 69 ation, and it wi
0740: 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b ll block until k
0750: 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 74 72 illed with a Ctr
0760: 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 20 l-C..# Once the
0770: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 65 78 remote server ex
0780: 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 75 ists, you can ru
0790: 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e 20 73 n the tests in s
07a0: 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 68 0a ocket.test with.
07b0: 23 20 74 68 65 20 73 65 72 76 65 72 20 62 79 20 # the server by
07c0: 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 6c 20 setting two Tcl
07d0: 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 0a 23 20 variables:.# .#
07e0: 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 % set remote
07f0: 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f ServerIP <name o
0800: 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 r address of mac
0810: 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 hine on which se
0820: 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 rver runs>.#
0830: 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 % set remoteSer
0840: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 20 0a verPort 8048.# .
0850: 23 20 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 # These variable
0860: 73 20 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 s are also setta
0870: 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 ble from the env
0880: 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 ironment. On Uni
0890: 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 x, you can:.# .#
08a0: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 shell% sete
08b0: 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 nv remoteServerI
08c0: 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e P machine.where.
08d0: 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 server.runs.#
08e0: 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 shell% setenv
08f0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0900: 20 38 30 34 38 0a 23 20 0a 23 20 54 68 65 20 70 8048.# .# The p
0910: 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 reamble of the s
0920: 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 6c 65 20 ocket.test file
0930: 63 68 65 63 6b 73 20 74 6f 20 73 65 65 20 69 66 checks to see if
0940: 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 20 61 the variables a
0950: 72 65 20 73 65 74 0a 23 20 65 69 74 68 65 72 20 re set.# either
0960: 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 in Tcl or in the
0970: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 environment; if
0980: 20 74 68 65 79 20 61 72 65 2c 20 69 74 20 61 74 they are, it at
0990: 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 tempts to connec
09a0: 74 20 74 6f 0a 23 20 74 68 65 20 73 65 72 76 65 t to.# the serve
09b0: 72 2e 20 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 r. If the connec
09c0: 74 69 6f 6e 20 69 73 20 73 75 63 63 65 73 73 66 tion is successf
09d0: 75 6c 2c 20 74 68 65 20 74 65 73 74 73 20 75 73 ul, the tests us
09e0: 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 ing the remote.#
09f0: 20 73 65 72 76 65 72 20 77 69 6c 6c 20 62 65 20 server will be
0a00: 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 performed; other
0a10: 77 69 73 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 wise, it will at
0a20: 74 65 6d 70 74 20 74 6f 20 73 74 61 72 74 20 74 tempt to start t
0a30: 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 he remote.# serv
0a40: 65 72 20 28 76 69 61 20 65 78 65 63 29 20 6f 6e er (via exec) on
0a50: 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 platforms that
0a60: 73 75 70 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e support this, on
0a70: 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c the local host,
0a80: 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 .# listening at
0a90: 70 6f 72 74 20 38 30 34 38 2e 20 49 66 20 61 6c port 8048. If al
0aa0: 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 l fails, a messa
0ab0: 67 65 20 69 73 20 70 72 69 6e 74 65 64 20 61 6e ge is printed an
0ac0: 64 20 74 68 65 20 74 65 73 74 73 0a 23 20 75 73 d the tests.# us
0ad0: 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ing the remote s
0ae0: 65 72 76 65 72 20 61 72 65 20 6e 6f 74 20 70 65 erver are not pe
0af0: 72 66 6f 72 6d 65 64 2e 0a 0a 70 72 6f 63 20 64 rformed...proc d
0b00: 70 75 74 73 20 7b 6d 73 67 7d 20 7b 20 72 65 74 puts {msg} { ret
0b10: 75 72 6e 20 3b 20 70 75 74 73 20 73 74 64 65 72 urn ; puts stder
0b20: 72 20 24 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 r $msg ; flush s
0b30: 74 64 65 72 72 20 7d 0a 0a 69 66 20 7b 5b 6c 73 tderr }..if {[ls
0b40: 65 61 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 earch [namespace
0b50: 20 63 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c children] ::tcl
0b60: 74 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 test] == -1} {.
0b70: 20 20 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 package requi
0b80: 72 65 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e re tcltest. n
0b90: 61 6d 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 amespace import
0ba0: 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 -force ::tcltest
0bb0: 3a 3a 2a 0a 7d 0a 0a 23 20 54 68 65 20 62 75 69 ::*.}..# The bui
0bc0: 6c 64 20 64 69 72 20 69 73 20 61 64 64 65 64 20 ld dir is added
0bd0: 61 73 20 74 68 65 20 66 69 72 73 74 20 65 6c 65 as the first ele
0be0: 6d 65 6e 74 20 6f 66 20 24 50 41 54 48 0a 73 65 ment of $PATH.se
0bf0: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
0c00: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
0c10: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
0c20: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
0c30: 5d 20 30 5d 5d 0a 23 20 4c 6f 61 64 20 74 68 65 ] 0]].# Load the
0c40: 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 tls package.pac
0c50: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
0c60: 20 31 2e 35 0a 0a 73 65 74 20 74 6c 73 53 65 72 1.5..set tlsSer
0c70: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 23 20 verPort 8048..#
0c80: 53 70 65 63 69 66 79 20 77 68 65 72 65 20 74 68 Specify where th
0c90: 65 20 63 65 72 74 69 66 69 63 61 74 65 73 20 61 e certificates a
0ca0: 72 65 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 re..set certsDir
0cb0: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c .[file join [fil
0cc0: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 e dirname [info
0cd0: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a script]] certs].
0ce0: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 5b set serverCert.[
0cf0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0d00: 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a Dir server.pem].
0d10: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b set clientCert.[
0d20: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0d30: 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a Dir client.pem].
0d40: 73 65 74 20 63 61 43 65 72 74 09 5b 66 69 6c 65 set caCert.[file
0d50: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0d60: 63 61 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 ca.pem].set serv
0d70: 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e erKey.[file join
0d80: 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 65 $certsDir serve
0d90: 72 2e 6b 65 79 5d 0a 73 65 74 20 63 6c 69 65 6e r.key].set clien
0da0: 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 tKey.[file join
0db0: 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 $certsDir client
0dc0: 2e 6b 65 79 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 .key]..# Some te
0dd0: 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 sts require the
0de0: 74 65 73 74 74 68 72 65 61 64 20 61 6e 64 20 65 testthread and e
0df0: 78 65 63 20 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 xec commands..se
0e00: 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 t ::tcltest::tes
0e10: 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 tConstraints(tes
0e20: 74 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 tthread) \..[exp
0e30: 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 r {[info command
0e40: 73 20 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d s testthread] !=
0e50: 20 7b 7d 7d 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 {}}].set ::tclt
0e60: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
0e70: 69 6e 74 73 28 65 78 65 63 29 20 5b 65 78 70 72 ints(exec) [expr
0e80: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
0e90: 20 65 78 65 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a exec] != {}}]..
0ea0: 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 #.# If remoteSer
0eb0: 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 verIP or remoteS
0ec0: 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f erverPort are no
0ed0: 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 t set, check in
0ee0: 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e the.# environmen
0ef0: 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 t variables for
0f00: 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 externally set v
0f10: 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b alues..#..if {![
0f20: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0f30: 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 teServerIP]} {.
0f40: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0f50: 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 sts env(remoteSe
0f60: 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 rverIP)]} {..set
0f70: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0f80: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
0f90: 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 rIP). }.}.if
0fa0: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0fb0: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d emoteServerPort]
0fc0: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
0fd0: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d o exists env(rem
0fe0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 5d 7d oteServerPort)]}
0ff0: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
1000: 72 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 rverPort $env(re
1010: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a moteServerPort).
1020: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
1030: 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 if {[info e
1040: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
1050: 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 erIP]} {.. se
1060: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
1070: 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 rt $tlsServerPor
1080: 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 t. }.
1090: 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f 68 61 6e }.}..proc do_han
10a0: 64 73 68 61 6b 65 20 7b 73 20 7b 74 79 70 65 20 dshake {s {type
10b0: 72 65 61 64 61 62 6c 65 7d 20 7b 63 6d 64 20 7b readable} {cmd {
10c0: 7d 7d 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 69 }} args} {. i
10d0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
10e0: 63 6c 6f 73 65 20 24 73 0a 09 64 70 75 74 73 20 close $s..dputs
10f0: 22 68 61 6e 64 73 68 61 6b 65 3a 20 65 6f 66 22 "handshake: eof"
1100: 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 ..set ::do_hands
1110: 68 61 6b 65 20 22 65 6f 66 22 0a 20 20 20 20 7d hake "eof". }
1120: 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 elseif {[catch
1130: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
1140: 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 $s} result]} {..
1150: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
1160: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 64 70 75 74 73 e normal...dputs
1170: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 24 72 65 "handshake: $re
1180: 73 75 6c 74 22 0a 20 20 20 20 7d 20 65 6c 73 65 sult". } else
1190: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
11a0: 7d 20 7b 0a 09 23 20 48 61 6e 64 73 68 61 6b 65 } {..# Handshake
11b0: 20 63 6f 6d 70 6c 65 74 65 0a 09 69 66 20 7b 5b complete..if {[
11c0: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 7d 20 llength $args]}
11d0: 7b 20 65 76 61 6c 20 5b 6c 69 73 74 20 66 63 6f { eval [list fco
11e0: 6e 66 69 67 75 72 65 20 24 73 5d 20 24 61 72 67 nfigure $s] $arg
11f0: 73 20 7d 0a 09 69 66 20 7b 24 63 6d 64 20 3d 3d s }..if {$cmd ==
1200: 20 22 22 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 ""} {.. file
1210: 65 76 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 event $s $type "
1220: 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 "..} else {..
1230: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 24 74 fileevent $s $t
1240: 79 70 65 20 22 24 63 6d 64 20 5b 6c 69 73 74 20 ype "$cmd [list
1250: 24 73 5d 22 0a 09 7d 0a 09 64 70 75 74 73 20 22 $s]"..}..dputs "
1260: 68 61 6e 64 73 68 61 6b 65 3a 20 63 6f 6d 70 6c handshake: compl
1270: 65 74 65 22 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 ete"..set ::do_h
1280: 61 6e 64 73 68 61 6b 65 20 22 63 6f 6d 70 6c 65 andshake "comple
1290: 74 65 22 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b te". } else {
12a0: 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 ..dputs "handsha
12b0: 6b 65 3a 20 69 6e 20 70 72 6f 67 72 65 73 73 22 ke: in progress"
12c0: 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 . }.}..#.# Ch
12d0: 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 eck if we're sup
12e0: 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 posed to do test
12f0: 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 s against the re
1300: 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 mote server.#..s
1310: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1320: 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 moteServer 1.if
1330: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
1340: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 emoteServerIP] &
1350: 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d & ($tcl_platform
1360: 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d (platform) != "m
1370: 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 acintosh")} {.
1380: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1390: 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d erIP 127.0.0.1.}
13a0: 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 .if {($doTestsWi
13b0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d thRemoteServer =
13c0: 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 = 1) && (![info
13d0: 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 exists remoteSer
13e0: 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 verPort])} {.
13f0: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
1400: 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 rPort $tlsServer
1410: 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 Port.}..# Attemp
1420: 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 t to connect to
1430: 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 a remote server
1440: 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 64 if one is alread
1450: 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 74 y running. If it
1460: 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 6e .# is not runnin
1470: 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f 74 g or for some ot
1480: 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 20 63 her reason the c
1490: 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 74 onnect fails, at
14a0: 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 74 tempt to.# start
14b0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
14c0: 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 er on the local
14d0: 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 6f host listening o
14e0: 6e 20 70 6f 72 74 20 38 30 34 38 2e 20 54 68 69 n port 8048. Thi
14f0: 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 s.# is only done
1500: 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 on platforms th
1510: 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 20 at support exec
1520: 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 (i.e. not on the
1530: 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 Mac). On.# plat
1540: 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 6e 6f forms that do no
1550: 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 2c 20 t support exec,
1560: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
1570: 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 74 65 r must be starte
1580: 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 72 20 d.# by the user
1590: 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 before running t
15a0: 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 72 he tests...set r
15b0: 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 22 emoteProcChan ""
15c0: 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b .set commandSock
15d0: 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 73 et "".if {$doTes
15e0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
15f0: 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 20 er} {. catch
1600: 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 {close $commandS
1610: 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b 5b ocket}. if {[
1620: 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 catch {set comma
1630: 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 ndSocket [tls::s
1640: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
1650: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
1660: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
1670: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
1680: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
1690: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 emoteServerIP $r
16a0: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d emoteServerPort]
16b0: 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 20 7b }] != 0} {..if {
16c0: 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 [info commands e
16d0: 78 65 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 xec] == ""} {..
16e0: 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 set noRemoteT
16f0: 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e 27 74 estReason "can't
1700: 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 74 20 exec".. set
1710: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1720: 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 6c 73 eServer 0..} els
1730: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d e {.. set rem
1740: 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 37 2e oteServerIP 127.
1750: 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 20 72 0.0.1.. set r
1760: 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c 65 20 emoteFile [file
1770: 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d 6f 74 join [pwd] remot
1780: 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 20 7b e.tcl].. if {
1790: 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 6d 6f [catch {set remo
17a0: 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 09 20 teProcChan \...
17b0: 20 20 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 [open "|[list
17c0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
17d0: 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 6c 65 test $remoteFile
17e0: 20 5c 0a 09 09 20 20 20 20 2d 73 65 72 76 65 72 \... -server
17f0: 49 73 53 69 6c 65 6e 74 20 2d 70 6f 72 74 20 24 IsSilent -port $
1800: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1810: 20 5c 0a 09 09 20 20 20 20 2d 61 64 64 72 65 73 \... -addres
1820: 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 s $remoteServerI
1830: 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 3d 3d P]" w+]} msg] ==
1840: 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 30 0} {...after 10
1850: 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 20 00...if {[catch
1860: 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b {set commandSock
1870: 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 et [tls::socket
1880: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
1890: 5c 0a 09 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \....-certfile $
18a0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 6b 65 79 66 clientCert -keyf
18b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
18c0: 0a 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 ....$remoteServe
18d0: 72 49 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 rIP $remoteServe
18e0: 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 rPort]} msg] ==
18f0: 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 0} {... fconf
1900: 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f igure $commandSo
1910: 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f cket -translatio
1920: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
1930: 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 g line...} else
1940: 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 {... set noRe
1950: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 moteTestReason $
1960: 6d 73 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f msg... set do
1970: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1980: 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 erver 0...}..
1990: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
19a0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
19b0: 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 on "$msg $::tclt
19c0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 est::tcltest"...
19d0: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
19e0: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 emoteServer 0..
19f0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c }..}. } el
1a00: 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 se {..fconfigure
1a10: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
1a20: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
1a30: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
1a40: 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d e. }.}..# Som
1a50: 65 20 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 e tests are run
1a60: 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 only if we are d
1a70: 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 oing testing aga
1a80: 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 inst a remote se
1a90: 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 rver..set ::tclt
1aa0: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
1ab0: 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 ints(doTestsWith
1ac0: 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 RemoteServer) $d
1ad0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1ae0: 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 Server.if {$doTe
1af0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1b00: 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 ver == 0} {.
1b10: 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 if {[string firs
1b20: 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a t s $::tcltest::
1b30: 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 verbose] != -1}
1b40: 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 6b 69 {. .puts "Ski
1b50: 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 74 68 pping tests with
1b60: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 20 remote server.
1b70: 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 74 See tests/socket
1b80: 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 74 73 .test for"..puts
1b90: 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e "information on
1ba0: 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d 6f how to run remo
1bb0: 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 75 74 te server."..put
1bc0: 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e 6f s "Reason for no
1bd0: 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 74 t doing remote t
1be0: 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 ests: $noRemoteT
1bf0: 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 7d estReason". }
1c00: 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 6f .}..#.# If we do
1c10: 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 66 69 the tests, defi
1c20: 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 ne a command to
1c30: 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 74 send a command t
1c40: 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 73 o the.# remote s
1c50: 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 erver..#..if {$d
1c60: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1c70: 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 Server == 1} {.
1c80: 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d 6d proc sendComm
1c90: 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 and {c} {..globa
1ca0: 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a l commandSocket.
1cb0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d ..if {[eof $comm
1cc0: 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 andSocket]} {..
1cd0: 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 error "remote
1ce0: 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 server disappea
1cf0: 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 red"..}...if {[c
1d00: 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d atch {puts $comm
1d10: 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d 73 andSocket $c} ms
1d20: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 g]} {.. error
1d30: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1d40: 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 disappeared: $ms
1d50: 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 63 g"..}..if {[catc
1d60: 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 h {puts $command
1d70: 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 72 Socket "--Marker
1d80: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1d90: 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 --"} msg]} {..
1da0: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
1db0: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1dc0: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 ed: $msg"..}...s
1dd0: 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 69 6c et resp ""..whil
1de0: 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 e {1} {.. set
1df0: 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 6f 6d line [gets $com
1e00: 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 20 mandSocket]..
1e10: 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 if {[eof $comma
1e20: 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 ndSocket]} {...e
1e30: 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 rror "remote ser
1e40: 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 22 ver disappeared"
1e50: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 .. }.. if
1e60: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
1e70: 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 $line "--Marker
1e80: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1e90: 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 --"] == 0} {...i
1ea0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
1eb0: 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 re [lindex $resp
1ec0: 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 0] error] == 0}
1ed0: 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 20 5b {... error [
1ee0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1ef0: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
1f00: 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 return [lindex
1f10: 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 $resp 1]...}..
1f20: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 } else {...app
1f30: 65 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 20 22 end resp $line "
1f40: 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 \n".. }..}.
1f50: 20 20 7d 0a 0a 20 20 20 20 73 65 6e 64 43 6f 6d }.. sendCom
1f60: 6d 61 6e 64 20 5b 6c 69 73 74 20 70 72 6f 63 20 mand [list proc
1f70: 64 70 75 74 73 20 5b 69 6e 66 6f 20 61 72 67 73 dputs [info args
1f80: 20 64 70 75 74 73 5d 20 5b 69 6e 66 6f 20 62 6f dputs] [info bo
1f90: 64 79 20 64 70 75 74 73 5d 5d 0a 0a 20 20 20 20 dy dputs]]..
1fa0: 70 72 6f 63 20 73 65 6e 64 43 65 72 74 56 61 6c proc sendCertVal
1fb0: 75 65 73 20 7b 7d 20 7b 0a 09 23 20 57 65 20 6e ues {} {..# We n
1fc0: 65 65 64 20 74 6f 20 62 65 20 61 62 6c 65 20 74 eed to be able t
1fd0: 6f 20 73 65 6e 64 20 63 65 72 74 69 66 69 63 61 o send certifica
1fe0: 74 65 20 76 61 6c 75 65 73 20 74 68 61 74 20 6e te values that n
1ff0: 6f 72 6d 61 6c 69 7a 65 0a 09 23 20 66 69 6c 65 ormalize..# file
2000: 6e 61 6d 65 73 20 61 63 72 6f 73 73 20 70 6c 61 names across pla
2010: 74 66 6f 72 6d 73 0a 09 73 65 6e 64 43 6f 6d 6d tforms..sendComm
2020: 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 63 and {.. set c
2030: 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f ertsDir.[file jo
2040: 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 in [file dirname
2050: 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 [info script]]
2060: 63 65 72 74 73 5d 0a 09 20 20 20 20 73 65 74 20 certs].. set
2070: 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 serverCert.[file
2080: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
2090: 73 65 72 76 65 72 2e 70 65 6d 5d 0a 09 20 20 20 server.pem]..
20a0: 20 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 set clientCert.
20b0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
20c0: 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d sDir client.pem]
20d0: 0a 09 20 20 20 20 73 65 74 20 63 61 43 65 72 74 .. set caCert
20e0: 09 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 ..[file join $ce
20f0: 72 74 73 44 69 72 20 63 61 63 65 72 74 2e 70 65 rtsDir cacert.pe
2100: 6d 5d 0a 09 20 20 20 20 73 65 74 20 73 65 72 76 m].. set serv
2110: 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e erKey.[file join
2120: 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 65 $certsDir serve
2130: 72 2e 6b 65 79 5d 0a 09 20 20 20 20 73 65 74 20 r.key].. set
2140: 63 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 clientKey.[file
2150: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 join $certsDir c
2160: 6c 69 65 6e 74 2e 6b 65 79 5d 0a 09 7d 0a 20 20 lient.key]..}.
2170: 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 }.}..test tlsI
2180: 4f 2d 31 2e 31 20 7b 61 72 67 20 70 61 72 73 69 O-1.1 {arg parsi
2190: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
21a0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
21b0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
21c0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
21d0: 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 server} msg] $ms
21e0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
21f0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2200: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
2210: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
2220: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
2230: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 32 20 7b test tlsIO-1.2 {
2240: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2250: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2260: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2270: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2280: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2290: 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d foo} msg] $msg.}
22a0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
22b0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
22c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
22d0: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
22e0: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
22f0: 74 20 74 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 t tlsIO-1.3 {arg
2300: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2310: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2320: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2330: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2340: 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 cket -myaddr} ms
2350: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2360: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2370: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2380: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2390: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
23a0: 74 6c 73 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 tlsIO-1.4 {arg p
23b0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
23c0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
23d0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
23e0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
23f0: 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 et -myaddr 127.0
2400: 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a .0.1} msg] $msg.
2410: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2420: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2430: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2440: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2450: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2460: 35 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 5 {arg parsing f
2470: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2480: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2490: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
24a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f ls::socket -mypo
24b0: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
24c0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
24d0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
24e0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
24f0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2500: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 .test tlsIO-1.6
2510: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2520: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2530: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2540: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2550: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2560: 20 78 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 xxxx} msg] $msg
2570: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2580: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2590: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
25a0: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
25b0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
25c0: 2e 37 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .7 {arg parsing
25d0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
25e0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
25f0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2600: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
2610: 6f 72 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 ort 2522} msg] $
2620: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2630: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2640: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2650: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2660: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2670: 4f 2d 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 O-1.8 {arg parsi
2680: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2690: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
26a0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
26b0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
26c0: 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 froboz} msg] $ms
26d0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
26e0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
26f0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2700: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2710: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2720: 31 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.9 {arg parsing
2730: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2740: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2750: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2760: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2770: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2780: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
2790: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
27a0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
27b0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
27c0: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
27d0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
27e0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
27f0: 2e 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .10 {arg parsing
2800: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2810: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2820: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2830: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 {tls::socket hos
2840: 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 t 2528 -junk} ms
2850: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2860: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2870: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2880: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2890: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
28a0: 74 6c 73 49 4f 2d 31 2e 31 31 20 7b 61 72 67 20 tlsIO-1.11 {arg
28b0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
28c0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
28d0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
28e0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
28f0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c ket -server call
2900: 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 back 2520 --} ms
2910: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2920: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2930: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2940: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
2950: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
2960: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
2970: 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 72 73 69 -1.12 {arg parsi
2980: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2990: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
29a0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
29b0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 h {tls::socket f
29c0: 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 5d oo badport} msg]
29d0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 65 $msg.} {1 {expe
29e0: 63 74 65 64 20 69 6e 74 65 67 65 72 20 62 75 74 cted integer but
29f0: 20 67 6f 74 20 22 62 61 64 70 6f 72 74 22 7d 7d got "badport"}}
2a00: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
2a10: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2a20: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2a30: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2a40: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2a50: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2a60: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2a70: 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 ..set auto_path
2a80: 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 [linsert $auto_p
2a90: 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 ath 0 [lindex [s
2aa0: 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 plit $env(PATH)
2ab0: 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 ";:"] 0]]..packa
2ac0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2ad0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2ae0: 20 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 2000 "set x tim
2af0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 ed_out"]. }.
2b00: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
2b10: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2b20: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2b30: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2b40: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2b50: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2b60: 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d erverKey 8828 \]
2b70: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
2b80: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
2b90: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
2ba0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
2bb0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
2bc0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
2bd0: 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 $file..}..puts r
2be0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
2bf0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
2c00: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
2c10: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
2c20: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2c30: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
2c40: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
2c50: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
2c60: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
2c70: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
2c80: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
2c90: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
2ca0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
2cb0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
2cc0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
2cd0: 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 1 8828} msg]} {.
2ce0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d set x $m
2cf0: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a sg. } else {.
2d00: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
2d10: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2d20: 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 close $msg.
2d30: 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 }. lappend
2d40: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
2d50: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2d60: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
2d70: 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 e {}}..if [info
2d80: 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 exists port] {.
2d90: 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 incr port.} e
2da0: 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 lse { . set p
2db0: 6f 72 74 20 5b 65 78 70 72 20 24 74 6c 73 53 65 ort [expr $tlsSe
2dc0: 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d rverPort + [pid]
2dd0: 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 20 74 %1024].}..test t
2de0: 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f lsIO-2.2 {tcp co
2df0: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c nnection with cl
2e00: 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 ient port specif
2e10: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
2e20: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
2e30: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
2e40: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
2e50: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
2e60: 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 f {..set auto_pa
2e70: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
2e80: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
2e90: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
2ea0: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 H) ";:"] 0]]..pa
2eb0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2ec0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2ed0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2ee0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
2ef0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2f00: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2f10: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2f20: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2f30: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2f40: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2f50: 76 65 72 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a verKey 8829 \]".
2f60: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2f70: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
2f80: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2f90: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2fa0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2fb0: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
2fc0: 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 ] $port".
2fd0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
2fe0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2ff0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
3000: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3010: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3020: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3030: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3040: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3050: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3060: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3070: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3080: 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 ts $f x. glob
3090: 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b al port. if {
30a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
30b0: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 ket -myport $por
30c0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
30d0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
30e0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
30f0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
3100: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
3110: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
3120: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 set x $sock..
3130: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c catch {close [tl
3140: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3150: 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 20 7d 0.1 8829]}. }
3160: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
3170: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
3180: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
3190: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
31a0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
31b0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
31c0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
31d0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 . set x.} [li
31e0: 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 st ready "hello
31f0: 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c $port"]..test tl
3200: 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e sIO-2.3 {tcp con
3210: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 nection with cli
3220: 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 ent interface sp
3230: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
3240: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3250: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3260: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3270: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3280: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
3290: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
32a0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
32b0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
32c0: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
32d0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
32e0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
32f0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3300: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3310: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3320: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3330: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3340: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3350: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3360: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3370: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 20 $serverKey 8830
3380: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3390: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
33a0: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
33b0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
33c0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
33d0: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
33e0: 73 6f 63 6b 5d 20 24 61 64 64 72 22 0a 20 20 20 sock] $addr".
33f0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
3400: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 sock.
3410: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
3420: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3430: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3440: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3450: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
3460: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
3470: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
3480: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
3490: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
34a0: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
34b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
34c0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
34d0: 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 127.0.0.1 \..-ce
34e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
34f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3500: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3510: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
3520: 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 0.1 8830} sock]}
3530: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
3540: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
3550: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
3560: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 $sock hello..ca
3570: 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b tch {flush $sock
3580: 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e }. lappen
3590: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
35a0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
35b0: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
35c0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
35d0: 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 {ready {hello 1
35e0: 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 27.0.0.1}}..test
35f0: 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 tlsIO-2.4 {tcp
3600: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3610: 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 server interface
3620: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
3630: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3640: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3650: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3660: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3670: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
3680: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
3690: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
36a0: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
36b0: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
36c0: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
36d0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
36e0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
36f0: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 "set x done"].
3700: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
3710: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
3720: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
3730: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
3740: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
3750: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3760: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d le $serverKey -m
3770: 79 61 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 yaddr [info host
3780: 6e 61 6d 65 5d 20 38 38 33 31 20 5c 5d 22 0a 20 name] 8831 \]".
3790: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
37a0: 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc accept {sock
37b0: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
37c0: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
37d0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
37e0: 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d ts "[gets $sock]
37f0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
3800: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
3810: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3820: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
3830: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3840: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3850: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
3860: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3870: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3880: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3890: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
38a0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
38b0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
38c0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
38d0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
38e0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
38f0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3900: 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 clientKey [info
3910: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 7d 20 hostname] 8831}
3920: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
3930: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
3940: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
3950: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
3960: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
3970: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
3980: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
3990: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
39a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
39b0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
39c0: 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 ready hello}..te
39d0: 73 74 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 st tlsIO-2.5 {tc
39e0: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
39f0: 68 20 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 h redundant serv
3a00: 65 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 er port} {socket
3a10: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3a20: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3a30: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3a40: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3a50: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
3a60: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
3a70: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
3a80: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
3a90: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
3aa0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3ab0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3ac0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3ad0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3ae0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3af0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3b00: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3b10: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3b20: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3b30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3b40: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 32 20 $serverKey 8832
3b50: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3b60: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3b70: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
3b80: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
3b90: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3ba0: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3bb0: 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 sock]".
3bc0: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3bd0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3be0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
3bf0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3c00: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3c10: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3c20: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3c30: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3c40: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3c50: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3c60: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3c70: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
3c80: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
3c90: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3ca0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3cb0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3cc0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
3cd0: 32 37 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 27.0.0.1 8832} s
3ce0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
3cf0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
3d00: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3d10: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
3d20: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
3d30: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
3d40: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
3d50: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3d60: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3d70: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
3d80: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 eady hello}.test
3d90: 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 tlsIO-2.6 {tcp
3da0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
3db0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ket} {. set s
3dc0: 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 tatus ok. if
3dd0: 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f {![catch {set so
3de0: 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ck [tls::socket
3df0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 127.0.0.1 8833]}
3e00: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
3e10: 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d h {gets $sock}]}
3e20: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 {.. set stat
3e30: 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c us broken..}..cl
3e40: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
3e50: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
3e60: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
3e70: 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.7 {echo server
3e80: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
3e90: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3ea0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3eb0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3ec0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3ed0: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
3ee0: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
3ef0: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
3f00: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
3f10: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
3f20: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
3f30: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
3f40: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
3f50: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 "set x done"].
3f60: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
3f70: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
3f80: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
3f90: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
3fa0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
3fb0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3fc0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
3fd0: 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 34 \]". puts
3fe0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
3ff0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
4000: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
4010: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
4020: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
4030: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
4040: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
4050: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4060: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 }..proc
4070: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
4080: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
4090: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
40a0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
40c0: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
40d0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
40e0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
40f0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
4100: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
4110: 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 e {.
4120: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
4130: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
4140: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
4150: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
4160: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
4170: 73 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 se $f..puts done
4180: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
4190: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
41a0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
41b0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
41c0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
41d0: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
41e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
41f0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4200: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4210: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4220: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
4230: 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 0.0.1 8834].
4240: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4250: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
4260: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
4270: 20 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f puts $s "hello
4280: 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f abcdefghijklmno
4290: 70 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 p". after 100
42a0: 30 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 0. set x [get
42b0: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
42c0: 24 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 $s. set y [ge
42d0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
42e0: 20 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 $f. list $x
42f0: 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 $y.} {{hello abc
4300: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 defghijklmnop} d
4310: 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f one}..test tlsIO
4320: 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 -2.8 {echo serve
4330: 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 r, loop 50 times
4340: 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 , single connect
4350: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
4360: 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 io} {. set f
4370: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
4380: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
4390: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
43a0: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
43b0: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
43c0: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
43d0: 22 5d 20 30 5d 5d 0a 20 20 20 20 09 70 61 63 6b "] 0]]. .pack
43e0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
43f0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
4400: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
4410: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4420: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
4430: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
4440: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
4450: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
4460: 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 8835 \]". put
4470: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
4480: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 ept {s a p} {.
4490: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 fileev
44a0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
44b0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
44c0: 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 fconf
44d0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
44e0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
44f0: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
4500: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c } {.. global
4510: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
4520: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
4540: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
4560: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
4570: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
4580: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4590: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
45a0: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
45b0: 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e { .. in
45c0: 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 cr i.
45d0: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
45e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
45f0: 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74 .}..set i 0..put
4600: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d s ready..set tim
4610: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 er [after 20000
4620: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 "set x done"]..v
4630: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
4640: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
4650: 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e se $f..puts "don
4660: 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 e $i". }.
4670: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4680: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
4690: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
46a0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
46b0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
46c0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
46d0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
46e0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
46f0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
4700: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
4710: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 127.0.0.1 8835]
4720: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4730: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
4740: 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 ne. catch {..
4750: 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 for {set x 0} {$
4760: 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d x < 50} {incr x}
4770: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
4780: 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 "hello abcdefghi
4790: 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 jklmnop".. ge
47a0: 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 ts $s..}. }.
47b0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
47c0: 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b 67 65 catch {set x [ge
47d0: 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 ts $f]}. clos
47e0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
47f0: 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 {done 50}..test
4800: 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b tlsIO-2.9 {sock
4810: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
4820: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4830: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
4840: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4850: 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 72 65 ept 8828]. re
4860: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
4870: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4880: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
4890: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 ts -nonewline $f
48a0: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
48b0: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
48c0: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
48d0: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
48e0: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 ) ";:"] 0]]..pac
48f0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
4900: 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 ..tls::socket -s
4910: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
4920: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 8. }. clos
4930: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
4940: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4950: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4960: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
4970: 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 gets $f. aft
4980: 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 er 100. set x
4990: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 [list [catch {c
49a0: 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 5b 73 lose $f} msg] [s
49b0: 74 72 69 6e 67 20 72 61 6e 67 65 20 24 6d 73 67 tring range $msg
49c0: 20 30 20 34 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 0 43]]. clos
49d0: 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d e $s. set x.}
49e0: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
49f0: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
4a00: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
4a10: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
4a20: 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 2.10 {close on a
4a30: 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 ccept, accepted
4a40: 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 socket lives} {s
4a50: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
4a60: 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 done 0. set
4a70: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
4a80: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
4a90: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
4aa0: 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ss [tls::socket
4ab0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4ac0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4ad0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4ae0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
4af0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
4b00: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
4b10: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
4b20: 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 obal ss..close $
4b30: 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ss..fileevent $s
4b40: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
4b50: 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 t $s"..fconfigur
4b60: 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 e $s -trans lf.
4b70: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
4b80: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
4b90: 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 al done..gets $s
4ba0: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 ..close $s..set
4bb0: 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 done 1. }.
4bc0: 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f set cs [tls::so
4bd0: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
4be0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
4bf0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4c00: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4c10: 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 y [info hostname
4c20: 5d 20 38 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 ] 8830]. clos
4c30: 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 69 74 e $cs.. vwait
4c40: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
4c50: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
4c60: 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a set done.} 1..
4c70: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 20 test tlsIO-2.11
4c80: 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 {detecting new d
4c90: 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ata} {socket} {.
4ca0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
4cb0: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
4cc0: 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e 20 64 l sock..# when d
4cd0: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
4ce0: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
4cf0: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
4d00: 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 20 s need..# to be
4d10: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 non-blocking for
4d20: 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 the TLS handsha
4d30: 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 ke. Also make s
4d40: 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 72 6e ure..# to return
4d50: 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 the channel to
4d60: 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d line buffering m
4d70: 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 ode...fconfigure
4d80: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
4d90: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4da0: 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 66 69 .set sock $s..fi
4db0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
4dc0: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
4dd0: 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 20 7d dshake $s]. }
4de0: 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 .. set s [tls
4df0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4e00: 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d accept \.. -
4e10: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
4e20: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4e30: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
4e40: 65 72 76 65 72 4b 65 79 20 38 34 30 30 5d 0a 20 erverKey 8400].
4e50: 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 set sock "".
4e60: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
4e70: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
4e80: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
4e90: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4ea0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
4eb0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 34 Key 127.0.0.1 84
4ec0: 30 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 00]. # when d
4ed0: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
4ee0: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
4ef0: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
4f00: 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 s need. # to
4f10: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
4f20: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
4f30: 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 shake Also make
4f40: 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 sure to. # r
4f50: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
4f60: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
4f70: 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 ing mode (TLS se
4f80: 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 ts it to 'none')
4f90: 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
4fa0: 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 $s2 -blocking 0
4fb0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4fc0: 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b 0a . vwait sock.
4fd0: 20 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e 65 puts $s2 one
4fe0: 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 . flush $s2.
4ff0: 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 # need update
5000: 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 to complete TLS
5010: 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 handshake in-pr
5020: 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 ocess. update
5030: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 . after 500.
5040: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5050: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ock -blocking 0.
5060: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 61 set result a
5070: 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 :[gets $sock].
5080: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
5090: 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a b:[gets $sock].
50a0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
50b0: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 sock -blocking 1
50c0: 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 74 77 . puts $s2 tw
50d0: 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a o. flush $s2.
50e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
50f0: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
5100: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
5110: 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 73 6f 63 ult c:[gets $soc
5120: 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 k]. fconfigur
5130: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
5140: 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 g 1. close $s
5150: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 2. close $s.
5160: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
5170: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
5180: 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 6f 7d {a:one b: c:two}
5190: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
51a0: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
51b0: 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 n; no certificat
51c0: 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 5c 0a es specified} \.
51d0: 09 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 75 .{socket stdio u
51e0: 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 23 nixOnly} {. #
51f0: 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 75 There is a debu
5200: 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 g assertion on W
5210: 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 indows/SSL that
5220: 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 77 causes a crash w
5230: 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 hen the. # ce
5240: 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 rtificate isn't
5250: 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 specified.. r
5260: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5270: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5280: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5290: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 uts $f {..set au
52a0: 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 to_path [linsert
52b0: 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c $auto_path 0 [l
52c0: 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e index [split $en
52d0: 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d v(PATH) ";:"] 0]
52e0: 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 ]..package requi
52f0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
5300: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
5310: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
5320: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
5330: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
5340: 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 ept 8828]..proc
5350: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
5360: 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 r port} {.. g
5370: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
5380: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
5390: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
53a0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
53b0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
53c0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
53d0: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a ose $f..puts $x.
53e0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
53f0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
5400: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5410: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5420: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
5430: 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 ets $f x. if
5440: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
5450: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
5460: 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 828} msg]} {.
5470: 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a set x $msg.
5480: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
5490: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
54a0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
54b0: 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 close $msg.
54c0: 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 }. lappend x
54d0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c [gets $f]. cl
54e0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
54f0: 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b .} {ready done {
5500: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 }}..test tlsIO-3
5510: 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .1 {socket confl
5520: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ict} {socket std
5530: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
5540: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5550: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5560: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
5570: 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 f {..set auto_pa
5580: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
5590: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
55a0: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
55b0: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 H) ";:"] 0]]..pa
55c0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
55d0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
55e0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
55f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5600: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
5610: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
5620: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5630: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
5640: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
5650: 75 74 73 20 24 66 20 7b 0a 09 70 75 74 73 20 72 uts $f {..puts r
5660: 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e eady..gets stdin
5670: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
5680: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5690: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
56a0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
56b0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
56c0: 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 ]" r+]. gets
56d0: 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 $f. set x [li
56e0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
56f0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5700: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5710: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5720: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5730: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 2d ientKey \. .-
5740: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
5750: 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 28} msg] \...$ms
5760: 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 g]. puts $f b
5770: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ye. close $f.
5780: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b set x.} {1 {
5790: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
57a0: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
57b0: 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a ready in use}}..
57c0: 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 32 20 7b test tlsIO-3.2 {
57d0: 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 server with seve
57e0: 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f ral clients} {so
57f0: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
5800: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
5810: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
5820: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
5830: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 puts $f {..set
5840: 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 auto_path [lins
5850: 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 ert $auto_path 0
5860: 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 [lindex [split
5870: 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d $env(PATH) ";:"]
5880: 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 0]]..package re
5890: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
58a0: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
58b0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
58c0: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
58d0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
58e0: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
58f0: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
5900: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5910: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
5920: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
5930: 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a $f "set s \[tls:
5940: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5950: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
5960: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
5970: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5980: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
5990: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
59a0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
59b0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
59c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
59d0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
59e0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
59f0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5a00: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
5a10: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
5a20: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 . global x.
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
5a40: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
5a50: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
5a60: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
5a70: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
5a80: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
5a90: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
5ab0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
5ac0: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
5ad0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
5ae0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
5af0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5b00: 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 ancel $t1..vwait
5b10: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5b20: 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 $t2..vwait x..a
5b30: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
5b40: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
5b50: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
5b60: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
5b70: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5b80: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5b90: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5ba0: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
5bb0: 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 f]. set s1 [t
5bc0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5bd0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
5be0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5bf0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5c00: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
5c10: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
5c20: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5c30: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
5c40: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
5c50: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
5c60: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5c70: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5c80: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5c90: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5ca0: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5cb0: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
5cc0: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
5cd0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5ce0: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
5cf0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5d00: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5d10: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5d20: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5d30: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5d40: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
5d50: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
5d60: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5d70: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
5d80: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
5d90: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
5da0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
5db0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
5dc0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
5dd0: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
5de0: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
5df0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
5e00: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
5e10: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c close $s3. l
5e20: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5e30: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
5e40: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
5e50: 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 dy done}..test t
5e60: 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 lsIO-4.1 {server
5e70: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
5e80: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
5e90: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 68 61 tdio} {. # ha
5ea0: 76 65 20 73 65 65 6e 20 69 6e 74 65 72 6d 69 74 ve seen intermit
5eb0: 74 65 6e 74 20 68 61 6e 67 73 20 6f 6e 20 57 69 tent hangs on Wi
5ec0: 6e 64 6f 77 73 0a 20 20 20 20 72 65 6d 6f 76 65 ndows. remove
5ed0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5ee0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5ef0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
5f00: 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 f {..set auto_pa
5f10: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
5f20: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
5f30: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
5f40: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 H) ";:"] 0]]..pa
5f50: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5f60: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 s..gets stdin.
5f70: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
5f80: 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f "set s \[tls::so
5f90: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
5fa0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5fb0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5fc0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
5fd0: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 27.0.0.1 8828 \]
5fe0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
5ff0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
6000: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
6010: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
6020: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
6030: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
6040: 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 hello.. gets
6050: 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 $s..}..close $s
6060: 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 ..puts bye..gets
6070: 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 stdin. }.
6080: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6090: 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 t p1 [open "|[li
60a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
60b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
60c0: 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 r+]. fconfigu
60d0: 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e re $p1 -bufferin
60e0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 g line. set p
60f0: 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 2 [open "|[list
6100: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
6110: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
6120: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
6130: 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p2 -buffering l
6140: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b ine. set p3 [
6150: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6160: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6170: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
6180: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 fconfigure $p3
6190: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
61a0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
61b0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
61c0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
61d0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 ring line..filee
61e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
61f0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
6200: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 }. proc e
6210: 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 cho {s} {..globa
6220: 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 l x. set
6230: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
6240: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
6250: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
6260: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
6270: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
6280: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
6290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
62a0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
62b0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
62c0: 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 t1 [after 30000
62d0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
62e0: 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 "]. set t2 [a
62f0: 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 fter 31000 "set
6300: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
6310: 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 set t3 [after
6320: 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 32000 "set x tim
6330: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
6340: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6350: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
6360: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6370: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6380: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6390: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
63a0: 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 accept 8828].
63b0: 20 70 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 puts $p1 open.
63c0: 20 20 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e puts $p2 open
63d0: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 . puts $p3 op
63e0: 65 6e 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 en. vwait x.
63f0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 vwait x. v
6400: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
6410: 20 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 cancel $t1.
6420: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
6430: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6440: 6c 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 l $t3. close
6450: 24 73 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $s. set l "".
6460: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6470: 69 73 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 ist p1 [gets $p1
6480: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
6490: 64 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 d l [list p2 [ge
64a0: 74 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 ts $p2] $x].
64b0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
64c0: 70 33 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 p3 [gets $p3] $x
64d0: 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 62 ]. puts $p1 b
64e0: 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 ye. puts $p2
64f0: 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 bye. puts $p3
6500: 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 bye. close $
6510: 70 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 p1. close $p2
6520: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 . close $p3.
6530: 20 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 set l.} {{p1
6540: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 bye done} {p2 by
6550: 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 e done} {p3 bye
6560: 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 done}}..test tls
6570: 49 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 IO-4.2 {byte ord
6580: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
6590: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
65a0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
65b0: 20 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 set x ok.
65c0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
65d0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
65e0: 64 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 dodo 0x3000} msg
65f0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 ]} {..set x $msg
6600: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 . } else {..c
6610: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
6620: 20 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a set x.} ok..
6630: 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b test tlsIO-5.1 {
6640: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
6650: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
6660: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b ers, htons} \..{
6670: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 socket unixOnly
6680: 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 notRoot} {. s
6690: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
66a0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
66b0: 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 owner}. if {!
66c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
66d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
66e0: 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 0x1} msg]} {.
66f0: 20 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f set x {hto
6700: 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 ns problem, shou
6710: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
6720: 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e , are you runnin
6730: 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 g as SU?}..close
6740: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6750: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
6760: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
6770: 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 ot owner}.test t
6780: 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f lsIO-5.2 {byte o
6790: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
67a0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
67b0: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
67c0: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
67d0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
67e0: 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f : port number to
67f0: 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b o high}. if {
6800: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
6810: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
6820: 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d o 0x10000} msg]}
6830: 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 {..set x {port
6840: 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c resolution probl
6850: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
6860: 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 sallowed}..close
6870: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6880: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
6890: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
68a0: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
68b0: 69 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d igh}.test tlsIO-
68c0: 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.3 {byte order
68d0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
68e0: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
68f0: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 \..{socket unix
6900: 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a Only notRoot} {.
6910: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
6920: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
6930: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 not owner}.
6940: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
6950: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6960: 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 dodo 21} msg]}
6970: 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 {..set x {htons
6980: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
6990: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
69a0: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
69b0: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
69c0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
69d0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
69e0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
69f0: 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 owner}..test tls
6a00: 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 IO-6.1 {accept c
6a10: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b allback error} {
6a20: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
6a30: 20 20 20 20 23 20 54 68 65 72 65 20 69 73 20 61 # There is a
6a40: 20 64 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e debug assertion
6a50: 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 on Windows/SSL
6a60: 74 68 61 74 20 63 61 75 73 65 73 20 61 20 63 72 that causes a cr
6a70: 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 ash when the.
6a80: 20 23 20 63 65 72 74 69 66 69 63 61 74 65 20 69 # certificate i
6a90: 73 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a sn't specified..
6aa0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
6ab0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
6ac0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
6ad0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
6ae0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
6af0: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
6b00: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
6b10: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
6b20: 22 5d 20 30 5d 5d 0a 20 20 20 20 09 70 61 63 6b "] 0]]. .pack
6b30: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6b40: 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 .gets stdin.
6b50: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c }. puts $f [l
6b60: 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ist tls::socket
6b70: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6b80: 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 5d 0a 127.0.0.1 8848].
6b90: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
6ba0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
6bb0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
6bc0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
6bd0: 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 " r+]. proc b
6be0: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
6bf0: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
6c00: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 args. }. p
6c10: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6c20: 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d p} {expr 10 / 0}
6c30: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6c40: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6c50: 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 accept \.. -c
6c60: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6c70: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6c80: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6c90: 72 76 65 72 4b 65 79 20 38 38 34 38 5d 0a 20 20 rverKey 8848].
6ca0: 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a puts $f hello.
6cb0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
6cc0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
6cd0: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
6ce0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
6cf0: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
6d00: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
6d10: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
6d20: 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b rename bgerror {
6d30: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b }. set x.} {{
6d40: 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d divide by zero}}
6d50: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 ..test tlsIO-7.1
6d60: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6d70: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
6d80: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
6d90: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
6da0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6db0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6dc0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6dd0: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
6de0: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
6df0: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
6e00: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
6e10: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
6e20: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6e30: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6e40: 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 f [list tls::soc
6e50: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
6e60: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
6e70: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6e80: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6e90: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6ea0: 4b 65 79 20 38 38 32 30 5d 0a 20 20 20 20 70 75 Key 8820]. pu
6eb0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
6ec0: 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 cept args {..
6ed0: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
6ee0: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
6ef0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
6f00: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6f10: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
6f20: 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t"]..vwait x..af
6f30: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6f40: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
6f50: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6f60: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6f70: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6f80: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
6f90: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
6fa0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6fb0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
6fc0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
6fd0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6fe0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
6ff0: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
7000: 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 1 8820]. set
7010: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
7020: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
7030: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7040: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
7050: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
7060: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
7070: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 [lindex $p 0] 1
7080: 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 27.0.0.1]. la
7090: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
70a0: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
70b0: 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 $p 2] 8820].
70c0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
70d0: 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d th $p].} {0 0 3}
70e0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 ..test tlsIO-7.2
70f0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7100: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7110: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
7120: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
7130: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
7140: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
7150: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
7160: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
7170: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
7180: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
7190: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
71a0: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
71b0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
71c0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
71d0: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
71e0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
71f0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
7200: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7210: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7220: 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 20 rverKey 8821".
7230: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
7240: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
7250: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
7260: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
7270: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
7280: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7290: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
72a0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
72b0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
72c0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
72d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
72e0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
72f0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
7300: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
7310: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
7320: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7330: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
7340: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7350: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7360: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7370: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
7380: 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 0.0.1 8821].
7390: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
73a0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
73b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
73c0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
73d0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
73e0: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
73f0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
7400: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
7410: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
7420: 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 ing equal [linde
7430: 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 x $p 2] 8821].}
7440: 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a {3 127.0.0.1 0}.
7450: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 .test tlsIO-7.3
7460: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
7470: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
7480: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
7490: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
74a0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
74b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
74c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
74d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
74e0: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
74f0: 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 20 accept 8822].
7500: 20 73 65 74 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 set l [llength
7510: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 5d [fconfigure $s]]
7520: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7530: 20 20 75 70 64 61 74 65 0a 20 20 20 20 23 20 41 update. # A
7540: 20 62 75 67 20 66 69 78 65 64 20 69 6e 20 66 63 bug fixed in fc
7550: 6f 6e 66 69 67 75 72 65 20 66 6f 72 20 38 2e 33 onfigure for 8.3
7560: 2e 34 2b 20 6d 61 6b 65 20 74 68 69 73 20 72 65 .4+ make this re
7570: 74 75 72 6e 20 31 34 20 6e 6f 72 6d 61 6c 6c 79 turn 14 normally
7580: 2c 0a 20 20 20 20 23 20 62 75 74 20 31 32 20 69 ,. # but 12 i
7590: 6e 20 6f 6c 64 65 72 20 76 65 72 73 69 6f 6e 73 n older versions
75a0: 2e 0a 20 20 20 20 65 78 70 72 20 7b 24 6c 20 3e .. expr {$l >
75b0: 3d 20 31 32 20 26 26 20 28 28 24 6c 20 25 20 32 = 12 && (($l % 2
75c0: 29 20 3d 3d 20 30 29 7d 0a 7d 20 31 0a 0a 23 20 ) == 0)}.} 1..#
75d0: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
75e0: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
75f0: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
7600: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
7610: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 ..test tlsIO-7.4
7620: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7630: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7640: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
7650: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7660: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7670: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7680: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7690: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
76a0: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
76b0: 20 61 63 63 65 70 74 20 38 38 32 33 5d 0a 20 20 accept 8823].
76c0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
76d0: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
76e0: 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 x..set x [fconfi
76f0: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
7700: 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 e]..close $s.
7710: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
7720: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7730: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
7740: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7750: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
7760: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b ientKey \. .[
7770: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
7780: 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 823]. set tim
7790: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
77a0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
77b0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
77c0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
77d0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
77e0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
77f0: 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 1. set l "".
7800: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
7810: 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e ndex $x 2] [llen
7820: 67 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 33 20 gth $x].} {8823
7830: 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 3}..# bug report
7840: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
7850: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
7860: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
7870: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
7880: 49 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 IO-7.5 {testing
7890: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
78a0: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
78b0: 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 unixOrPc} {.
78c0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
78d0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
78e0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
78f0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7900: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7910: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
7920: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 39 5d ver accept 8829]
7930: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7940: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
7950: 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f al x..set x [fco
7960: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
7970: 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a name]..close $s.
7980: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
7990: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
79a0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
79b0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
79c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
79d0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
79e0: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
79f0: 38 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 8829]. set ti
7a00: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
7a10: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
7a20: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
7a30: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
7a40: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
7a50: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
7a60: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
7a70: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
7a80: 69 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e index $x 0] [lin
7a90: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
7aa0: 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e th $x].} {127.0.
7ab0: 30 2e 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 0.1 8829 3}..tes
7ac0: 74 20 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 t tlsIO-8.1 {tes
7ad0: 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 ting -async flag
7ae0: 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f on sockets} {so
7af0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 4e 4f cket} {. # NO
7b00: 54 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 TE: This test ma
7b10: 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 y fail on some S
7b20: 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 olaris 2.4 syste
7b30: 6d 73 2e 0a 20 20 20 20 23 20 53 65 65 20 6e 6f ms.. # See no
7b40: 74 65 73 20 69 6e 20 54 63 6c 27 73 20 73 6f 63 tes in Tcl's soc
7b50: 6b 65 74 2e 74 65 73 74 2e 0a 20 20 20 20 73 65 ket.test.. se
7b60: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7b70: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
7b80: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7b90: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7ba0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
7bb0: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
7bc0: 20 61 63 63 65 70 74 20 38 38 33 30 5d 0a 20 20 accept 8830].
7bd0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
7be0: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
7bf0: 78 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 x..# when doing
7c00: 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c an in-process cl
7c10: 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 ient/server test
7c20: 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 , both sides nee
7c30: 64 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 d..# to be non-b
7c40: 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 locking for the
7c50: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 TLS handshake.
7c60: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 Also make sure..
7c70: 23 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 # to return the
7c80: 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 channel to line
7c90: 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a buffering mode..
7ca0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
7cb0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
7cc0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 70 75 74 73 ering line..puts
7cd0: 20 24 73 20 62 79 65 0a 09 23 20 4f 6e 6c 79 20 $s bye..# Only
7ce0: 4f 70 65 6e 53 53 4c 20 30 2e 39 2e 35 61 20 6f OpenSSL 0.9.5a o
7cf0: 6e 20 57 69 6e 64 6f 77 73 20 73 65 65 6d 73 20 n Windows seems
7d00: 74 6f 20 6e 65 65 64 20 74 68 65 20 61 66 74 65 to need the afte
7d10: 72 20 28 64 65 6c 61 79 65 64 29 0a 09 23 20 63 r (delayed)..# c
7d20: 6c 6f 73 65 2c 20 62 75 74 20 69 74 20 77 6f 72 lose, but it wor
7d30: 6b 73 20 6a 75 73 74 20 74 68 65 20 73 61 6d 65 ks just the same
7d40: 20 66 6f 72 20 61 6c 6c 20 6f 74 68 65 72 73 2e for all others.
7d50: 20 2d 68 6f 62 62 73 0a 09 61 66 74 65 72 20 35 -hobbs..after 5
7d60: 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 00 close $s..set
7d70: 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 x done. }.
7d80: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
7d90: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
7da0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
7db0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7dc0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
7dd0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 61 entKey \.. -a
7de0: 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f 73 74 6e sync [info hostn
7df0: 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 23 ame] 8830]. #
7e00: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
7e10: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
7e20: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
7e30: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 th sides need.
7e40: 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c # to be non-bl
7e50: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
7e60: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c LS handshake Al
7e70: 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a so make sure to.
7e80: 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 # return the
7e90: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 channel to line
7ea0: 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 buffering mode
7eb0: 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 (TLS sets it to
7ec0: 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 'none').. fco
7ed0: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 6c 6f nfigure $s1 -blo
7ee0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
7ef0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 ng line. vwai
7f00: 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 68 61 t x. # TLS ha
7f10: 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 73 20 ndshaking needs
7f20: 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 74 68 one byte from th
7f30: 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 20 20 e client....
7f40: 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 20 23 puts $s1 a. #
7f50: 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 need update to
7f60: 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e complete TLS han
7f70: 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 dshake in-proces
7f80: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 s. update.
7f90: 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 31 set z [gets $s1
7fa0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
7fb0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7fc0: 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 set z.} bye..te
7fd0: 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b 74 65 st tlsIO-9.1 {te
7fe0: 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 sting spurious e
7ff0: 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 vents} {socket}
8000: 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a {. set len 0.
8010: 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 set spurious
8020: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
8030: 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 0. proc readl
8040: 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f ittle {s} {..glo
8050: 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e bal spurious don
8060: 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 e len..set l [re
8070: 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 ad $s 1]..if {[s
8080: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
8090: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
80a0: 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 {![eof $s]} {..
80b0: 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 .incr spurious..
80c0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 } else {...c
80d0: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
80e0: 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 ne 1.. }..} e
80f0: 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 lse {.. incr
8100: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
8110: 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a th $l]..}. }.
8120: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
8130: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
8140: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
8150: 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 ng 0..fileevent
8160: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
8170: 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 t do_handshake $
8180: 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 6c s readable readl
8190: 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 65 ittle \...-buffe
81a0: 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d ring none]. }
81b0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
81c0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
81d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
81e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
81f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8200: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8210: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
8220: 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 831]. set c [
8230: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8240: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8250: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8260: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8270: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8280: 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 [info hostna
8290: 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 23 20 me] 8831]. #
82a0: 54 68 69 73 20 64 69 66 66 65 72 73 20 66 72 6f This differs fro
82b0: 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 6e 20 m socket-9.1 in
82c0: 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 73 20 that both sides
82d0: 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 20 23 need to be. #
82e0: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 62 65 non-blocking be
82f0: 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 72 65 cause of TLS' re
8300: 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 6b 65 quired handshake
8310: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8320: 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 $c -blocking 0.
8330: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
8340: 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 ne $c 0123456789
8350: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
8360: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
8370: 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 23456789. clo
8380: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 se $c. set ti
8390: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
83a0: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
83b0: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
83c0: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
83d0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
83e0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c close $s. l
83f0: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
8400: 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 en.} {0 50}..tes
8410: 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 t tlsIO-9.2 {tes
8420: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
8430: 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c , fileevents, fl
8440: 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 ush on close} {s
8450: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
8460: 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 firstblock [str
8470: 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 5d ing repeat a 31]
8480: 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 . set secondb
8490: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
84a0: 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 20 20 eat b 65535].
84b0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
84c0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
84d0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
84e0: 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 0..fileevent $s
84f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 readable [list d
8500: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 o_handshake $s r
8510: 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 6c 65 eadable readable
8520: 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 69 6f \...-translatio
8530: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
8540: 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 69 6e 16384 -bufferin
8550: 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 g line]. }.
8560: 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 proc readable
8570: 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65 {s} {..set l [ge
8580: 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 22 67 ts $s]..dputs "g
8590: 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 ot \"[string rep
85a0: 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 2d 33 lace $l 10 end-3
85b0: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
85c0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 29 ring length $l])
85d0: 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c 65 65 from $s"..filee
85e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
85f0: 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 {}..after 1000
8600: 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d respond $s. }
8610: 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e . proc respon
8620: 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 d {s} {..global
8630: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 75 74 firstblock..dput
8640: 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e s "send \"[strin
8650: 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 73 74 g replace $first
8660: 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e block 10 end-3 .
8670: 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 ..]\" \...([stri
8680: 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 73 74 ng length $first
8690: 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 block]) down $s"
86a0: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
86b0: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
86c0: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
86d0: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
86e0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
86f0: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
8700: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 secondblock..dp
8710: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
8720: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 65 63 ing replace $sec
8730: 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d ondblock 10 end-
8740: 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 3 ...]\" \...([s
8750: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 73 65 tring length $se
8760: 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e condblock]) down
8770: 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 $s"..puts -none
8780: 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 wline $s $second
8790: 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a block..close $s.
87a0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
87b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
87c0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
87d0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
87e0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
87f0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8800: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
8810: 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 73 65 ept 8832]. se
8820: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8830: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8840: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8850: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8860: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8870: 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 y \.. [info h
8880: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 32 5d 0a 20 ostname] 8832].
8890: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
88a0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
88b0: 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ans lf -bufferin
88c0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
88d0: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
88e0: 24 63 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f $c hello. pro
88f0: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
8900: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
8910: 65 0a 09 73 65 74 20 64 61 74 61 20 5b 72 65 61 e..set data [rea
8920: 64 20 24 73 5d 0a 09 64 70 75 74 73 20 22 72 65 d $s]..dputs "re
8930: 61 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 ad \"[string rep
8940: 6c 61 63 65 20 24 64 61 74 61 20 31 30 20 65 6e lace $data 10 en
8950: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
8960: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
8970: 64 61 74 61 5d 29 20 66 72 6f 6d 20 24 73 22 0a data]) from $s".
8980: 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 .incr count [str
8990: 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 ing length $data
89a0: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
89b0: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 {.. close $s
89c0: 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 .. set done 1
89d0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 ..}. }. fi
89e0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
89f0: 62 6c 65 20 22 72 65 61 64 69 74 20 24 63 22 0a ble "readit $c".
8a00: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
8a10: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
8a20: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
8a30: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
8a40: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
8a50: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
8a60: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
8a70: 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 63 6f $s. list $co
8a80: 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 unt $done.} {655
8a90: 36 36 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 66 1}..test tlsI
8aa0: 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 O-9.3 {testing E
8ab0: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
8ac0: 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 unexplainedFailu
8ad0: 72 65 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 re socket} {.
8ae0: 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 # HOBBS: never
8af0: 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 worked correctly
8b00: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
8b10: 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c to_eof {s} {..gl
8b20: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 obal count done
8b30: 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 timer..set l [ge
8b40: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
8b50: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
8b60: 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 r count.. if
8b70: 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 {$count > 9} {..
8b80: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
8b90: 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 done true...set
8ba0: 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 count {eof is st
8bb0: 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 icky}...after ca
8bc0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 ncel $timer..
8bd0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
8be0: 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b proc timerproc {
8bf0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
8c00: 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f count c..set do
8c10: 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 ne true..set cou
8c20: 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f nt {timer went o
8c30: 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 ff, eof is not s
8c40: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
8c50: 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 65 74 20 . }.. set
8c60: 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 count 0. set
8c70: 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 done false. p
8c80: 72 6f 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 roc write_then_c
8c90: 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 lose {s} {..puts
8ca0: 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 $s bye..close $
8cb0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
8cc0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8cd0: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
8ce0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
8cf0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8d00: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 anslation lf..fi
8d10: 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 leevent $s writa
8d20: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
8d30: 64 73 68 61 6b 65 20 24 73 20 77 72 69 74 61 62 dshake $s writab
8d40: 6c 65 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c le write_then_cl
8d50: 6f 73 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 ose \...-bufferi
8d60: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
8d70: 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 tion lf]. }.
8d80: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8d90: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8da0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
8db0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8dc0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
8dd0: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
8de0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
8df0: 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 3]. set c [tl
8e00: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
8e10: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
8e20: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
8e30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8e40: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
8e50: 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 [info hostname
8e60: 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e ] 8833]. fcon
8e70: 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b figure $c -block
8e80: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
8e90: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
8ea0: 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 on lf. fileev
8eb0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
8ec0: 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 "count_to_eof $c
8ed0: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
8ee0: 5b 61 66 74 65 72 20 32 30 30 30 20 74 69 6d 65 [after 2000 time
8ef0: 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 rproc]. vwait
8f00: 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 done. close
8f10: 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $s. set count
8f20: 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b .} {eof is stick
8f30: 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 y}..removeFile s
8f40: 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 cript..test tlsI
8f50: 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 O-10.1 {testing
8f60: 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 61 socket accept ca
8f70: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 6e llback error han
8f80: 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 dling} {socket}
8f90: 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 {. set goterr
8fa0: 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 or 0. proc bg
8fb0: 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 error args {glob
8fc0: 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 al goterror; set
8fd0: 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 goterror 1}.
8fe0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
8ff0: 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ket -cafile $caC
9000: 65 72 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ert -server acce
9010: 70 74 20 38 38 39 38 5d 0a 20 20 20 20 70 72 6f pt 8898]. pro
9020: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
9030: 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f {close $s; erro
9040: 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c r}. set c [tl
9050: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c s::socket -cafil
9060: 65 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e e $caCert 127.0.
9070: 30 2e 31 20 38 38 39 38 5d 0a 20 20 20 20 76 77 0.1 8898]. vw
9080: 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 ait goterror.
9090: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
90a0: 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 ose $c. set g
90b0: 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 oterror.} 1..tes
90c0: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 t tlsIO-11.1 {tc
90d0: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
90e0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
90f0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9100: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
9110: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
9120: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9130: 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_1_test_server
9140: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
9150: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
9160: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
9170: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9180: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9190: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 5d $serverKey 8834]
91a0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
91b0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
91c0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
91d0: 20 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 puts $s done
91e0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
91f0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9200: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
9210: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9220: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9230: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9240: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9250: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9260: 72 76 65 72 49 50 20 38 38 33 34 5d 0a 20 20 20 rverIP 8834].
9270: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d set r [gets $s]
9280: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
9290: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
92a0: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f lose $socket9_1_
92b0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
92c0: 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 set r.} done..t
92d0: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 7b est tlsIO-11.2 {
92e0: 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 client specifies
92f0: 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b its port} {sock
9300: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9310: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9320: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
9330: 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 ts port]} {..inc
9340: 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 r port. } els
9350: 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 e {..set port [e
9360: 78 70 72 20 7b 24 74 6c 73 53 65 72 76 65 72 50 xpr {$tlsServerP
9370: 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 ort + [pid]%1024
9380: 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e }]. }. sen
9390: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
93a0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
93b0: 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 et socket9_2_tes
93c0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
93d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
93e0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
93f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9400: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9410: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9420: 65 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 ey 8835]..proc a
9430: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
9440: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9450: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
9460: 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 $s $p.. clos
9470: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
9480: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
9490: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
94a0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
94b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
94c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
94d0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 ntKey \.. -my
94e0: 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f port $port $remo
94f0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 35 5d teServerIP 8835]
9500: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
9510: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
9520: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9530: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
9540: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_2_test_server}
9550: 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 . if {$r == $
9560: 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 port} {..set res
9570: 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 ult ok. } els
9580: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9590: 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 broken. }.
95a0: 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b set result.} ok
95b0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
95c0: 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 3 {trying to con
95d0: 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d nect, no server}
95e0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
95f0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9600: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 } {. set stat
9610: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b us ok. if {![
9620: 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c catch {set s [tl
9630: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9640: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9650: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9660: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9670: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9680: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9690: 70 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 p 8836]}]} {..if
96a0: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
96b0: 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 $s}]} {.. set
96c0: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
96d0: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 }..close $s.
96e0: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
96f0: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
9700: 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 O-11.4 {remote e
9710: 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b cho, one line} {
9720: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9730: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9740: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
9750: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
9760: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
9770: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
9780: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
9790: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
97a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
97b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
97c0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
97d0: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
97e0: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
97f0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9800: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9810: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
9820: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
9830: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
9840: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9850: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
9860: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
9870: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
9880: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
9890: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
98a0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
98b0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
98c0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
98d0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
98e0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
98f0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
9900: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9910: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9920: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9930: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9940: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9950: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
9960: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
9970: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
9980: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9990: 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c . puts $f hel
99a0: 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 lo. set r [ge
99b0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
99c0: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
99d0: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
99e0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
99f0: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
9a00: 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 hello..test tlsI
9a10: 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 O-11.5 {remote e
9a20: 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b cho, 50 lines} {
9a30: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9a40: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9a50: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
9a60: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
9a70: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
9a80: 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 et10_7_test_serv
9a90: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
9aa0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
9ab0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9ac0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9ad0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9ae0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9af0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9b00: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9b10: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9b20: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
9b30: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
9b40: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
9b50: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
9b60: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
9b70: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
9b80: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9b90: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
9ba0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
9bb0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
9bc0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
9bd0: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
9be0: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
9bf0: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
9c00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9c10: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9c20: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9c30: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9c40: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9c50: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9c60: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
9c70: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
9c80: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
9c90: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9ca0: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
9cb0: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
9cc0: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
9cd0: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
9ce0: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
9cf0: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
9d00: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
9d10: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
9d20: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
9d30: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
9d40: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9d50: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
9d60: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9d70: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
9d80: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
9d90: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
9da0: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
9db0: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
9dc0: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
9dd0: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
9de0: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
9df0: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 33 ictResult {0 883
9e00: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
9e10: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
9e20: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
9e30: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
9e40: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
9e50: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c use}}.}..test tl
9e60: 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 sIO-11.6 {socket
9e70: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
9e80: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9e90: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9ea0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9eb0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9ec0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9ed0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9ee0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9ef0: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
9f00: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
9f10: 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 6]. if {[catc
9f20: 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a h {set s2 [tls::
9f30: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9f40: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9f50: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9f60: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9f70: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
9f80: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
9f90: 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 36]} msg]} {..se
9fa0: 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 t result [list 1
9fb0: 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 $msg]. } els
9fc0: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9fd0: 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 [list 0 [lindex
9fe0: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 [fconfigure $s2
9ff0: 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 -sockname] 2]]..
a000: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a close $s2. }.
a010: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
a020: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 set result.} $
a030: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a conflictResult..
a040: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 test tlsIO-11.7
a050: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
a060: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
a070: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
a080: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
a090: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
a0a0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
a0b0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
a0c0: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
a0d0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
a0e0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
a0f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
a100: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a110: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
a120: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
a130: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
a140: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
a150: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
a160: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
a170: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
a180: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
a190: 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 echo $s]..}..pr
a1a0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
a1b0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
a1c0: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
a1d0: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
a1e0: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
a1f0: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
a200: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
a210: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
a220: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
a230: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a240: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a250: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a260: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a270: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
a280: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
a290: 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e re $s1 -bufferin
a2a0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
a2b0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
a2c0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a2d0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a2e0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a2f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
a300: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
a310: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
a320: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
a330: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
a340: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
a350: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
a360: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
a370: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a380: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
a390: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
a3a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
a3b0: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
a3c0: 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 gure $s3 -buffer
a3d0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
a3e0: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
a3f0: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
a400: 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f ..puts $s1 hello
a410: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
a420: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 uts $s2 hello,s2
a430: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
a440: 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 $s3 hello,s3..g
a450: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
a460: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
a470: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
a480: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
a490: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
a4a0: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
a4b0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
a4c0: 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 i.} 100 ..tes
a4d0: 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c t tlsIO-11.8 {cl
a4e0: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
a4f0: 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b l servers} {sock
a500: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
a510: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a520: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
a530: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a540: 20 7b 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 {..tls::init -c
a550: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
a560: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a570: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
a580: 72 76 65 72 4b 65 79 0a 09 73 65 74 20 73 31 20 rverKey..set s1
a590: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
a5a0: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
a5b0: 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 3" 4003]..set s2
a5c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
a5d0: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
a5e0: 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 04" 4004]..set s
a5f0: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 3 [tls::socket -
a600: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
a610: 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 005" 4005]..proc
a620: 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d 70 handshake {s mp
a630: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f } {.. if {[eo
a640: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
a650: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 $s.. } elsei
a660: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
a670: 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 handshake $s} re
a680: 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d sult]} {...# Som
a690: 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 e errors are nor
a6a0: 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 mal... } else
a6b0: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
a6c0: 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b } {...# Handshak
a6d0: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c e complete...fil
a6e0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
a6f0: 6c 65 20 22 22 0a 09 09 70 75 74 73 20 24 73 20 le ""...puts $s
a700: 24 6d 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 $mp...close $s..
a710: 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 }..}..proc a
a720: 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d ccept {mp s a p}
a730: 20 7b 0a 09 20 20 20 20 23 20 54 68 65 73 65 20 {.. # These
a740: 68 61 76 65 20 74 6f 20 61 63 63 65 70 74 20 6e have to accept n
a750: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 on-blocking, bec
a760: 61 75 73 65 20 74 68 65 20 68 61 6e 64 73 68 61 ause the handsha
a770: 6b 69 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 65 king.. # orde
a780: 72 20 69 73 6e 27 74 20 64 65 74 65 72 6d 69 6e r isn't determin
a790: 69 73 74 69 63 0a 09 20 20 20 20 66 63 6f 6e 66 istic.. fconf
a7a0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
a7b0: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
a7c0: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
a7d0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
a7e0: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
a7f0: 24 73 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d $s $mp]..}. }
a800: 0a 20 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 2d . tls::init -
a810: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
a820: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a830: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
a840: 6c 69 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 74 lientKey. set
a850: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
a860: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a870: 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 4003]. set s
a880: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 2 [tls::socket $
a890: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
a8a0: 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 004]. set s3
a8b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a8c0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a8d0: 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 5]. set l "".
a8e0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 lappend l [g
a8f0: 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 ets $s1] [gets $
a900: 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 s1] [eof $s1] [g
a910: 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 ets $s2] [gets $
a920: 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a s2] [eof $s2] \.
a930: 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 .[gets $s3] [get
a940: 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d s $s3] [eof $s3]
a950: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
a960: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
a970: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
a980: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c endCommand {..cl
a990: 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 ose $s1..close $
a9a0: 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 s2..close $s3.
a9b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 }. set l.}
a9c0: 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 {4003 {} 1 4004
a9d0: 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a {} 1 4005 {} 1}.
a9e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 .test tlsIO-11.9
a9f0: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
aa00: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
aa10: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
aa20: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
aa30: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
aa40: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
aa50: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
aa60: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
aa70: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
aa80: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
aa90: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
aaa0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
aab0: 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 {s a p} {expr 10
aac0: 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 / 0}. proc b
aad0: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
aae0: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
aaf0: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 args. }. s
ab00: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
ab10: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
ab20: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 ndCommand {..
ab30: 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 set peername [f
ab40: 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 configure $calle
ab50: 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d rSocket -peernam
ab60: 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 e].. set s [t
ab70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 ls::socket \...
ab80: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
ab90: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
aba0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
abb0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
abc0: 09 20 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 65 . [lindex $pe
abd0: 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a ername 0] 8836].
abe0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
abf0: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
ac00: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
ac10: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
ac20: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
ac30: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
ac40: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
ac50: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
ac60: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
ac70: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
ac80: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
ac90: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
aca0: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
acb0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
acc0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
acd0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
ace0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
acf0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
ad00: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
ad10: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
ad20: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
ad30: 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 socket10_12_test
ad40: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
ad50: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
ad60: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
ad70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ad80: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
ad90: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
ada0: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
adb0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
adc0: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
add0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
ade0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
adf0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
ae00: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
ae10: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
ae20: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
ae30: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
ae40: 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 8836]. set p
ae50: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
ae60: 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 -peername]. s
ae70: 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 et n [fconfigure
ae80: 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 $s -sockname].
ae90: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
aea0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
aeb0: 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $p 2] [llength
aec0: 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 $p] [llength $p
aed0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
aee0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
aef0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
af00: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 12_test_server}.
af10: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 set l.} {883
af20: 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 6 3 3}..test tls
af30: 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e IO-11.11 {testin
af40: 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 g spurious event
af50: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
af60: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
af70: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f er} {. # remo
af80: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 te equivalent of
af90: 20 39 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 9.1. sendCer
afa0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
afb0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
afc0: 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 ocket_test_serve
afd0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
afe0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
aff0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b000: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
b010: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
b020: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
b030: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
b040: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 20 e {s} {.. if
b050: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
b060: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
b070: 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 lseif {[catch {t
b080: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
b090: 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 } result]} {...#
b0a0: 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 Some errors are
b0b0: 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 normal... }
b0c0: 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 elseif {$result
b0d0: 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 == 1} {...# Hand
b0e0: 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 shake complete..
b0f0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 .fileevent $s wr
b100: 69 74 61 62 6c 65 20 22 22 0a 09 09 61 66 74 65 itable ""...afte
b110: 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 r 100 writesome
b120: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 $s.. }..}..pr
b130: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b140: 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 } {.. fconfig
b150: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 ure $s -translat
b160: 69 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 ion "auto lf"..
b170: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
b180: 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 68 writable [list h
b190: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d 0a andshake $s]..}.
b1a0: 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 .proc writesome
b1b0: 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b {s} {.. for {
b1c0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
b1d0: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
b1e0: 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 .puts $s "line $
b1f0: 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 i from remote se
b200: 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 rver".. }..
b210: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
b220: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 }. set len
b230: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
b240: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
b250: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
b260: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
b270: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
b280: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
b290: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
b2a0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
b2b0: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
b2c0: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
b2d0: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
b2e0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
b2f0: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
b300: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
b310: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
b320: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
b330: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
b340: 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 }. set c [tls
b350: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
b360: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
b370: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
b380: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
b390: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
b3a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
b3b0: 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 74 8836]. # Get
b3c0: 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 63 the buffering c
b3d0: 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 6f orrected. fco
b3e0: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 66 nfigure $c -buff
b3f0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 23 ering line. #
b400: 20 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f Put a byte into
b410: 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 65 the client pipe
b420: 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 20 to trigger TLS
b430: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 20 handshaking.
b440: 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 69 puts $c a. fi
b450: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
b460: 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 ble [list readli
b470: 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 74 ttle $c]. set
b480: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
b490: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
b4a0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
b4b0: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
b4c0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
b4d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b4e0: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 5f {close $socket_
b4f0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
b500: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
b510: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
b520: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b530: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
b540: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
b550: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
b560: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
b570: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
b580: 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 . # remote eq
b590: 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 0a uivalent of 9.3.
b5a0: 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 # HOBBS: nev
b5b0: 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 er worked correc
b5c0: 74 6c 79 0a 20 20 20 20 73 65 74 20 63 6f 75 6e tly. set coun
b5d0: 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f ter 0. set do
b5e0: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f ne 0. proc co
b5f0: 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c unt_up {s} {..gl
b600: 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e obal counter don
b610: 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 e after_id..set
b620: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
b630: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
b640: 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 incr counter..
b650: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 if {$counter
b660: 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f > 9} {...set do
b670: 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b ne {EOF is stick
b680: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
b690: 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c l $after_id...cl
b6a0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
b6b0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
b6c0: 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 timed_out {} {..
b6d0: 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 global c done..s
b6e0: 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f et done {timed_o
b6f0: 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 ut, EOF is not s
b700: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
b710: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
b720: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
b730: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
b740: 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 socket10_14_tes
b750: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
b760: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
b770: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
b780: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b790: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
b7a0: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
b7b0: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
b7c0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b7d0: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
b7e0: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
b7f0: 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 after 100 close
b800: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
b810: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
b820: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b830: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b840: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b850: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b860: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
b870: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
b880: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b890: 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e c readable "coun
b8a0: 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 t_up $c". set
b8b0: 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 after_id [after
b8c0: 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 1000 timed_out]
b8d0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b8e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b8f0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
b900: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _14_test_server}
b910: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
b920: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
b930: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b940: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
b950: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
b960: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
b970: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b980: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b990: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
b9a0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
b9b0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
b9c0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b9d0: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
b9e0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
b9f0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
ba00: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
ba10: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
ba20: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
ba30: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
ba40: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
ba50: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
ba60: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
ba70: 31 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 1]..set secondbl
ba80: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
ba90: 61 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 at b 65535]..set
baa0: 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 l [tls::socket
bab0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
bac0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
bad0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
bae0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
baf0: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
bb00: 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 8845]..proc acc
bb10: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
bb20: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
bb30: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
bb40: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
bb50: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
bb60: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
bb70: 31 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 16384 \... -b
bb80: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
bb90: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
bba0: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 readable "readab
bbb0: 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 le $s"..}..proc
bbc0: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
bbd0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
bbe0: 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s].. fileeve
bbf0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b nt $s readable {
bc00: 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 }.. after 100
bc10: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 0 respond $s..}.
bc20: 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 .proc respond {s
bc30: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
bc40: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
bc50: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
bc60: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
bc70: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 after 1000 w
bc80: 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 ritedata $s..}..
bc90: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
bca0: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
bcb0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 secondblock..
bcc0: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
bcd0: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
bce0: 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a k.. close $s.
bcf0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
bd00: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
bd10: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
bd20: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
bd30: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
bd40: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
bd50: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
bd60: 65 72 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 erverIP 8845].
bd70: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
bd80: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
bd90: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
bda0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
bdb0: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
bdc0: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 puts $s hello.
bdd0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
bde0: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
bdf0: 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $s". set time
be00: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
be10: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
be20: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
be30: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
be40: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
be50: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
be60: 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 se $l}. set c
be70: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 70 72 ount.} 65566..pr
be80: 6f 63 20 67 65 74 64 61 74 61 20 7b 74 79 70 65 oc getdata {type
be90: 20 66 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 52 file} {. # R
bea0: 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 ead handler on t
beb0: 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b he accepted sock
bec0: 65 74 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 78 et.. global x
bed0: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 6c . global fail
bee0: 65 64 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 ed. set statu
bef0: 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 s [catch {read $
bf00: 66 69 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 20 file} data].
bf10: 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 if {$status != 0
bf20: 7d 20 7b 0a 09 73 65 74 20 78 20 22 72 65 61 64 } {..set x "read
bf30: 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 failed, error w
bf40: 61 73 20 24 64 61 74 61 22 0a 09 63 61 74 63 68 as $data"..catch
bf50: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
bf60: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
bf70: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b string compare {
bf80: 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 20 20 20 20 } $data]} {.
bf90: 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 } elseif {[fbloc
bfa0: 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 20 20 ked $file]} {.
bfb0: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 } elseif {[eof
bfc0: 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 69 66 20 7b $file]} {..if {
bfd0: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 20 20 20 20 $failed} {..
bfe0: 73 65 74 20 78 20 22 24 74 79 70 65 20 73 6f 63 set x "$type soc
bff0: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
c000: 64 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 d"..} else {..
c010: 20 20 73 65 74 20 78 20 22 24 74 79 70 65 20 73 set x "$type s
c020: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
c030: 68 65 72 69 74 65 64 22 0a 09 7d 0a 09 63 61 74 herited"..}..cat
c040: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
c050: 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }. } else {.
c060: 09 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 .set x {impossib
c070: 6c 65 20 63 61 73 65 7d 0a 09 63 61 74 63 68 20 le case}..catch
c080: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
c090: 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e }. return
c0a0: 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 .}..test tlsIO-1
c0b0: 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.1 {testing inh
c0c0: 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 76 eritance of serv
c0d0: 65 72 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 er sockets} {soc
c0e0: 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 ket exec} {.
c0f0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
c100: 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 pt1. makeFile
c110: 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 {} script2..
c120: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
c130: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
c140: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
c150: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
c160: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
c170: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
c180: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
c190: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
c1a0: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
c1b0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
c1c0: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
c1d0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c1e0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c1f0: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
c200: 20 63 72 65 61 74 65 73 20 74 68 65 20 73 65 72 creates the ser
c210: 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e ver socket, laun
c220: 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 20 ches script1,.
c230: 20 20 23 20 77 61 69 74 73 20 61 20 73 65 63 6f # waits a seco
c240: 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 20 nd, and exits.
c250: 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 The server socke
c260: 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 t will now. #
c270: 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 be closed unles
c280: 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 69 s script1 inheri
c290: 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 ted it... set
c2a0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
c2b0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
c2c0: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 [list set tclsh
c2d0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
c2e0: 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 est]. puts $f
c2f0: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
c300: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
c310: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
c320: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
c330: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 ) ";:"] 0]]..pac
c340: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
c350: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
c360: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
c370: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
c380: 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 accept \.. -c
c390: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
c3a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c3b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
c3c0: 72 76 65 72 4b 65 79 20 38 38 32 38 5c 5d 22 0a rverKey 8828\]".
c3d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
c3e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
c3f0: 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a e addr port } {.
c400: 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 . close $file
c410: 0a 09 7d 0a 09 65 78 65 63 20 24 74 63 6c 73 68 ..}..exec $tclsh
c420: 20 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 script1 &..clos
c430: 65 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 e $f..after 1000
c440: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
c450: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
c460: 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 lose $f... #
c470: 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 Launch script2 a
c480: 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 nd wait 5 second
c490: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
c4a0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
c4b0: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 script2 &. af
c4c0: 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f ter 5000 { set o
c4d0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d k_to_proceed 1 }
c4e0: 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f . vwait ok_to
c4f0: 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 _proceed.. #
c500: 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 If we can still
c510: 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 connect to the s
c520: 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 erver, the socke
c530: 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e t got inherited.
c540: 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 .. if {[catch
c550: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a {tls::socket \.
c560: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
c570: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
c580: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
c590: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
c5a0: 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 . 127.0.0.1 8828
c5b0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
c5c0: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c5d0: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c5e0: 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a d}. } else {.
c5f0: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 .close $msg..set
c600: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
c610: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
c620: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
c630: 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b x.} {server sock
c640: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
c650: 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ited}..test tlsI
c660: 4f 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 O-12.2 {testing
c670: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 inheritance of c
c680: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b lient sockets} {
c690: 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 socket exec} {.
c6a0: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
c6b0: 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 cript1. makeF
c6c0: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a ile {} script2..
c6d0: 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 # Script1 is
c6e0: 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e just a 10 secon
c6f0: 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 d delay. If the
c700: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 server socket.
c710: 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 # is inherite
c720: 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 d, it will be he
c730: 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 ld open for 10 s
c740: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 econds.. set
c750: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
c760: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
c770: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
c780: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
c790: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c7a0: 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 e $f.. # Scri
c7b0: 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c pt2 opens the cl
c7c0: 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 ient socket and
c7d0: 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 writes to it. I
c7e0: 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 t then. # lau
c7f0: 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 61 6e nches script1 an
c800: 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 d exits. If the
c810: 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 child process i
c820: 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 nherited the.
c830: 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 # client socket
c840: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c , the socket wil
c850: 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e l still be open.
c860: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c870: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
c880: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
c890: 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 et tclsh $::tclt
c8a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
c8b0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 puts $f {..set
c8c0: 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 auto_path [lins
c8d0: 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 ert $auto_path 0
c8e0: 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 [lindex [split
c8f0: 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d $env(PATH) ";:"]
c900: 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 0]]..package re
c910: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
c920: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
c930: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
c940: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
c950: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
c960: 63 61 43 65 72 74 20 5c 0a 09 20 20 20 20 2d 6b caCert \.. -k
c970: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
c980: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
c990: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
c9a0: 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 {..exec $tclsh s
c9b0: 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 cript1 &..puts $
c9c0: 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 f testing..flush
c9d0: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
c9e0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c9f0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
ca00: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 ose $f.. # Cr
ca10: 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 20 eate the server
ca20: 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 socket.. set
ca30: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
ca40: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
ca50: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
ca60: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
ca70: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
ca80: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
ca90: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 39 5d ver accept 8829]
caa0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
cab0: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
cac0: 74 20 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 68 t } {..# When th
cad0: 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 e client connect
cae0: 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 s, establish the
caf0: 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 read handler..g
cb00: 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c lobal server..cl
cb10: 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 63 6f ose $server..fco
cb20: 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 nfigure $file -b
cb30: 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 locking 0..filee
cb40: 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 vent $file reada
cb50: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
cb60: 64 73 68 61 6b 65 20 24 66 69 6c 65 20 72 65 61 dshake $file rea
cb70: 64 61 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 20 dable \...[list
cb80: 67 65 74 64 61 74 61 20 63 6c 69 65 6e 74 5d 20 getdata client]
cb90: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d -buffering line]
cba0: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a ..return. }..
cbb0: 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 # If the soc
cbc0: 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 ket doesn't hit
cbd0: 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 end-of-file in 5
cbe0: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 seconds, the.
cbf0: 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 # script1 proc
cc00: 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e ess must have in
cc10: 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 herited the clie
cc20: 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 nt... set fai
cc30: 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 led 0. after
cc40: 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 5000 [list set f
cc50: 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 ailed 1].. #
cc60: 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 Launch the scrip
cc70: 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 t2 process..
cc80: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
cc90: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
cca0: 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a &.. vwait x.
ccb0: 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 if {!$failed
ccc0: 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 } {..vwait faile
ccd0: 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 d. }. set
cce0: 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b x.} {client sock
ccf0: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
cd00: 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ited}..test tlsI
cd10: 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 O-12.3 {testing
cd20: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 inheritance of a
cd30: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d ccepted sockets}
cd40: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 63 \..{socket exec
cd50: 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 unixOnly} {.
cd60: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
cd70: 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c ipt1. makeFil
cd80: 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 e {} script2..
cd90: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
cda0: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
cdb0: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
cdc0: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
cdd0: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
cde0: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
cdf0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
ce00: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
ce10: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
ce20: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
ce30: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
ce40: 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f $f {..set auto_
ce50: 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 path [linsert $a
ce60: 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 uto_path 0 [lind
ce70: 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 ex [split $env(P
ce80: 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 ATH) ";:"] 0]]..
ce90: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
cea0: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
ceb0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
cec0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
ced0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 er accept \..
cee0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
cef0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
cf00: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
cf10: 24 73 65 72 76 65 72 4b 65 79 20 38 39 33 30 5c $serverKey 8930\
cf20: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
cf30: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
cf40: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
cf50: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 {.. global t
cf60: 63 6c 73 68 0a 09 20 20 20 20 66 63 6f 6e 66 69 clsh.. fconfi
cf70: 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 gure $file -buff
cf80: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 ering line..
cf90: 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 puts $file {test
cfa0: 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d data on socket}
cfb0: 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 6c 73 .. exec $tcls
cfc0: 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 20 h script1 &..
cfd0: 20 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 after 1000 exit
cfe0: 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 76 ..}..vwait forev
cff0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
d000: 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 se $f.. # Lau
d010: 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 nch the script2
d020: 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e process and conn
d030: 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 20 ect to it. See
d040: 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 how long. # t
d050: 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 20 he socket stays
d060: 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 open.. exec $
d070: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
d080: 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 st script2 &..
d090: 20 20 61 66 74 65 72 20 32 30 30 30 20 73 65 74 after 2000 set
d0a0: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 ok_to_proceed 1
d0b0: 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f . vwait ok_to
d0c0: 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 _proceed.. se
d0d0: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
d0e0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
d0f0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
d100: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
d110: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
d120: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
d130: 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 6f .1 8930]. fco
d140: 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 nfigure $f -buff
d150: 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 ering full -bloc
d160: 6b 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 20 king 0. # We
d170: 6e 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 79 need to put a by
d180: 74 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 64 te into the read
d190: 20 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 73 queue, otherwis
d1a0: 65 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 20 e the. # TLS
d1b0: 68 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e 27 handshake doesn'
d1c0: 74 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 74 t finish. put
d1d0: 73 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 66 s $f a; flush $f
d1e0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
d1f0: 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 f readable [list
d200: 20 67 65 74 64 61 74 61 20 61 63 63 65 70 74 65 getdata accepte
d210: 64 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 d $f].. # If
d220: 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 the socket is st
d230: 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 ill open after 5
d240: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 seconds, the sc
d250: 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 ript1 process.
d260: 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e # must have in
d270: 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 herited the acce
d280: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 pted socket...
d290: 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 set failed 0.
d2a0: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 after 5000 se
d2b0: 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 t failed 1..
d2c0: 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 20 vwait x. set
d2d0: 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 6f x.} {accepted so
d2e0: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
d2f0: 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c erited}..test tl
d300: 73 49 4f 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e sIO-13.1 {Testin
d310: 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 20 g use of shared
d320: 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 74 socket between t
d330: 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b wo threads} \..{
d340: 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 61 socket testthrea
d350: 64 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 d} {. # HOBBS
d360: 3a 20 6e 65 76 65 72 20 74 65 73 74 65 64 0a 20 : never tested.
d370: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
d380: 72 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 ript. threadR
d390: 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c eap.. makeFil
d3a0: 65 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 e {..set auto_pa
d3b0: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
d3c0: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
d3d0: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
d3e0: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 20 20 20 H) ";:"] 0]].
d3f0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
d400: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
d410: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
d420: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
d430: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
d440: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
d450: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
d460: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
d470: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
d480: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
d490: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
d4a0: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
d4b0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
d4c0: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
d4d0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
d4e0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
d4f0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
d500: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
d510: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
d520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d530: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
d540: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
d550: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
d560: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
d570: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
d580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
d590: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
d5a0: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
d5b0: 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c i 0..vwait x..cl
d5c0: 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 ose $f...# threa
d5d0: 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 d cleans itself
d5e0: 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 up...testthread
d5f0: 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 exit. } scrip
d600: 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 t. . # cre
d610: 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 ate a thread.
d620: 20 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 set serverthrea
d630: 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 d [testthread cr
d640: 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 eate { source sc
d650: 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 ript } ]. upd
d660: 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 ate. . aft
d670: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
d680: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 s [tls::socket 1
d690: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 27.0.0.1 8828].
d6a0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
d6b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
d6c0: 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 .. catch {..p
d6d0: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 uts $s "hello"..
d6e0: 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 gets $s result.
d6f0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
d700: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 s. update..
d710: 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 after 2000.
d720: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
d730: 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 [threadReap].
d740: 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 . set result
d750: 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 ..} {hello 1}..#
d760: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
d770: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
d780: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
d790: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
d7a0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
d7b0: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
d7c0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
d7d0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
d7e0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
d7f0: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
d800: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
d810: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
d820: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
d830: 65 74 75 72 6e 0a eturn.