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 30 20 32 30 30 33 2f 31 32 2f 31 35 20 31 .20 2003/12/15 1
0210: 38 3a 34 36 3a 32 30 20 72 61 7a 7a 65 6c 6c 20 8:46:20 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 61 65 72 65 64 3a 20 24 6d 73 disappaered: $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 6b 65 79 2e $certsDir skey.
2130: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c pem].. set cl
2140: 69 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f ientKey.[file jo
2150: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 in $certsDir cke
2160: 79 2e 70 65 6d 5d 0a 09 7d 0a 20 20 20 20 7d 0a y.pem]..}. }.
2170: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2180: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
2190: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
21a0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
21b0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
21c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
21d0: 65 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 er} msg] $msg.}
21e0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
21f0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2200: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2210: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
2220: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
2230: 20 74 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 tlsIO-1.2 {arg
2240: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2250: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2260: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2270: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2280: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d ket -server foo}
2290: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
22a0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
22b0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
22c0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
22d0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
22e0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
22f0: 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 sIO-1.3 {arg par
2300: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2310: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2320: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2330: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2340: 20 2d 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 -myaddr} msg] $
2350: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2360: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2370: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2380: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2390: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
23a0: 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 O-1.4 {arg parsi
23b0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
23c0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
23d0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
23e0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
23f0: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
2400: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2410: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2420: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2430: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2440: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2450: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 est tlsIO-1.5 {a
2460: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2470: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2480: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2490: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
24a0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 socket -myport}
24b0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
24c0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
24d0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
24e0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
24f0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2500: 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 t tlsIO-1.6 {arg
2510: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2520: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2530: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2540: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2550: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 cket -myport xxx
2560: 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b x} msg] $msg.} {
2570: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2580: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2590: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
25a0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
25b0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b test tlsIO-1.7 {
25c0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
25d0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
25e0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
25f0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2600: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
2610: 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 2522} msg] $msg.
2620: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2630: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2640: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2650: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2660: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2670: 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 8 {arg parsing f
2680: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2690: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
26a0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
26b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 ls::socket -frob
26c0: 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 oz} msg] $msg.}
26d0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
26e0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
26f0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2700: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2710: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 .test tlsIO-1.9
2720: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2730: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2740: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2750: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2760: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2770: 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 foo -myport 252
2780: 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 1 3333} msg] $ms
2790: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
27a0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
27b0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
27c0: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
27d0: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
27e0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 test tlsIO-1.10
27f0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2800: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2810: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2820: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2830: 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 ::socket host 25
2840: 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 28 -junk} msg] $
2850: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2860: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2870: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2880: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2890: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
28a0: 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 O-1.11 {arg pars
28b0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
28c0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
28d0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
28e0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
28f0: 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b -server callback
2900: 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 2520 --} msg] $
2910: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2920: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2930: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2940: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2950: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
2960: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2970: 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 2 {arg parsing f
2980: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2990: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
29a0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
29b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 ls::socket foo b
29c0: 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 adport} msg] $ms
29d0: 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 g.} {1 {expected
29e0: 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 integer but got
29f0: 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 "badport"}}..te
2a00: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 st tlsIO-2.1 {tc
2a10: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
2a20: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2a30: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2a40: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2a50: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2a60: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
2a70: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
2a80: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
2a90: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
2aa0: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
2ab0: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
2ac0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
2ad0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
2ae0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
2af0: 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ut"]. }. p
2b00: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
2b10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2b20: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
2b30: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
2b40: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
2b50: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
2b60: 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 rKey 8828 \]".
2b70: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
2b80: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
2b90: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 ddr port} {..
2ba0: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
2bb0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
2bc0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c close $fil
2bd0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
2be0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
2bf0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
2c00: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 close $f..puts $
2c10: 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 x. }. clos
2c20: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
2c30: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
2c40: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
2c50: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
2c60: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
2c70: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
2c80: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
2c90: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
2ca0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
2cb0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
2cc0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
2cd0: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 28} msg]} {.
2ce0: 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 set x $msg.
2cf0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
2d00: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
2d10: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
2d20: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
2d30: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
2d40: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
2d50: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
2d60: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d } {ready done {}
2d70: 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 }..if [info exis
2d80: 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 ts port] {. i
2d90: 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 ncr port.} else
2da0: 7b 20 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 { . set port
2db0: 5b 65 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 [expr $tlsServer
2dc0: 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 Port + [pid]%102
2dd0: 34 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 4].}..test tlsIO
2de0: 2d 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.2 {tcp connec
2df0: 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 tion with client
2e00: 20 70 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d port specified}
2e10: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
2e20: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
2e30: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
2e40: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
2e50: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2e60: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
2e70: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
2e80: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
2e90: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
2ea0: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
2eb0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2ec0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2ed0: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
2ee0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2ef0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2f00: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2f10: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2f20: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2f30: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2f40: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2f50: 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 ey 8829 \]".
2f60: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2f70: 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 accept {sock add
2f80: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
2f90: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
2fa0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
2fb0: 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 "[gets $sock] $p
2fc0: 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 ort".
2fd0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
2fe0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
2ff0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3000: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3010: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3020: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3030: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3040: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3050: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3060: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3070: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3080: 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 f x. global p
3090: 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 ort. if {[cat
30a0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
30b0: 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a -myport $port \.
30c0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
30d0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
30e0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
30f0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
3100: 37 2e 30 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 7.0.0.1 8829} so
3110: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
3120: 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 et x $sock..catc
3130: 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 h {close [tls::s
3140: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
3150: 38 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 8829]}. } els
3160: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
3170: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
3180: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
3190: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
31a0: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
31b0: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
31c0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
31d0: 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 set x.} [list r
31e0: 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 eady "hello $por
31f0: 74 22 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d t"]..test tlsIO-
3200: 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.3 {tcp connect
3210: 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 ion with client
3220: 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 interface specif
3230: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
3240: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3250: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3260: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3270: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3280: 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 f {..set auto_pa
3290: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
32a0: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
32b0: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
32c0: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 H) ";:"] 0]]..pa
32d0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
32e0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
32f0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3300: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3310: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3320: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3330: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3340: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3350: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3360: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3370: 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a verKey 8830 \]".
3380: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3390: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
33a0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
33b0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
33c0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
33d0: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
33e0: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 ] $addr".
33f0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
3410: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
3420: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3430: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3440: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3450: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3460: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3470: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3480: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3490: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
34a0: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
34b0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
34c0: 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e ket -myaddr 127.
34d0: 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 0.0.1 \..-certfi
34e0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
34f0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
3500: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
3510: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
3520: 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 8830} sock]} {.
3530: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
3540: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
3550: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
3560: 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 ck hello..catch
3570: 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 {flush $sock}.
3580: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
3590: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
35a0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
35b0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
35c0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
35d0: 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 ady {hello 127.0
35e0: 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 .0.1}}..test tls
35f0: 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e IO-2.4 {tcp conn
3600: 65 63 74 69 6f 6e 20 77 69 74 68 20 73 65 72 76 ection with serv
3610: 65 72 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 er interface spe
3620: 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 cified} {socket
3630: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3640: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3650: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3660: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3670: 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f s $f {..set auto
3680: 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 _path [linsert $
3690: 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e auto_path 0 [lin
36a0: 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 dex [split $env(
36b0: 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a PATH) ";:"] 0]].
36c0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
36d0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
36e0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
36f0: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3700: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3710: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3720: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3730: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3740: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3750: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3760: 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 serverKey -myadd
3770: 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 r [info hostname
3780: 5d 20 38 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 ] 8831 \]". p
3790: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
37a0: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
37b0: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
37c0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
37d0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
37e0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 [gets $sock]".
37f0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3800: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 $sock.
3810: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
3820: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3830: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3840: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3850: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
3860: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3870: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3880: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3890: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
38a0: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
38b0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
38c0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
38d0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
38e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
38f0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
3900: 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 ntKey [info host
3910: 6e 61 6d 65 5d 20 38 38 33 31 7d 20 73 6f 63 6b name] 8831} sock
3920: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
3930: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
3940: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
3950: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
3960: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 flush $sock.
3970: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
3980: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
3990: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
39a0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
39b0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
39c0: 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 y hello}..test t
39d0: 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f lsIO-2.5 {tcp co
39e0: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 nnection with re
39f0: 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 dundant server p
3a00: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ort} {socket std
3a10: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3a20: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3a30: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3a40: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3a50: 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 f {..set auto_pa
3a60: 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 th [linsert $aut
3a70: 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 o_path 0 [lindex
3a80: 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 [split $env(PAT
3a90: 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 H) ";:"] 0]]..pa
3aa0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3ab0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3ac0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3ad0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3ae0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3af0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3b00: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3b10: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3b20: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3b30: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3b40: 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a verKey 8832 \]".
3b50: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3b60: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
3b70: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
3b80: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3b90: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
3ba0: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3bb0: 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 ]". c
3bc0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3bd0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3be0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3bf0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3c00: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3c10: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3c20: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3c30: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3c40: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3c50: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3c60: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
3c70: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
3c80: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 {tls::socket -c
3c90: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
3ca0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3cb0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
3cc0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
3cd0: 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d .0.1 8832} sock]
3ce0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
3cf0: 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c x $sock. } el
3d00: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
3d10: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
3d20: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
3d30: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
3d40: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
3d50: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3d60: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3d70: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3d80: 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 hello}.test tls
3d90: 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e IO-2.6 {tcp conn
3da0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d ection} {socket}
3db0: 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 {. set statu
3dc0: 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 s ok. if {![c
3dd0: 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b atch {set sock [
3de0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
3df0: 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0.0.1 8833]}]} {
3e00: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 ..if {![catch {g
3e10: 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 ets $sock}]} {..
3e20: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 set status b
3e30: 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 roken..}..close
3e40: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3e50: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
3e60: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 .test tlsIO-2.7
3e70: 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e {echo server, on
3e80: 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 e line} {socket
3e90: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3ea0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3eb0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3ec0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3ed0: 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f s $f {..set auto
3ee0: 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 _path [linsert $
3ef0: 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e auto_path 0 [lin
3f00: 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 dex [split $env(
3f10: 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a PATH) ";:"] 0]].
3f20: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3f30: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3f40: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3f50: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3f60: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3f70: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3f80: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3f90: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3fa0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3fb0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3fc0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c serverKey 8834 \
3fd0: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
3fe0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
3ff0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
4000: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
4010: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
4020: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
4030: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
4040: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
4050: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
4060: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
4070: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
4080: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
4090: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
40a0: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
40b0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
40c0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
40d0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
40f0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
4100: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4120: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
4130: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
4140: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
4150: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
4160: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
4170: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
4180: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
4190: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
41a0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
41b0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
41c0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
41d0: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
41e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
41f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4200: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4210: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
4220: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
4230: 31 20 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 1 8834]. fcon
4240: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4250: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
4260: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 lation lf. pu
4270: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
4280: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 defghijklmnop".
4290: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
42a0: 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 set x [gets $s
42b0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
42c0: 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 set y [gets $
42d0: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
42e0: 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d list $x $y.}
42f0: 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 {{hello abcdefg
4300: 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d hijklmnop} done}
4310: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 ..test tlsIO-2.8
4320: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c {echo server, l
4330: 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 oop 50 times, si
4340: 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d ngle connection}
4350: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
4360: 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 {. set f [ope
4370: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4380: 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 puts $f {..set a
4390: 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 uto_path [linser
43a0: 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b t $auto_path 0 [
43b0: 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 lindex [split $e
43c0: 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 nv(PATH) ";:"] 0
43d0: 5d 5d 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 ]]. .package
43e0: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
43f0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4400: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
4410: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4420: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4430: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4440: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4450: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 $serverKey 8835
4460: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
4470: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
4480: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
4490: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
44a0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
44b0: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
44c0: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
44d0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
44e0: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
44f0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
4500: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
4510: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
4520: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
4530: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
4540: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
4550: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
4560: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
4570: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
4590: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
45a0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
45b0: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
45c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
45d0: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
45e0: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
45f0: 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 set i 0..puts re
4600: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
4610: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
4620: 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 x done"]..vwait
4630: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
4640: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
4650: 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 f..puts "done $i
4660: 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 ". }. clos
4670: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
4680: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4690: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
46a0: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
46b0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
46c0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
46d0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
46e0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
46f0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
4700: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
4710: 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 .0.0.1 8835].
4720: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
4730: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
4740: 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 catch {..for
4750: 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 {set x 0} {$x <
4760: 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 50} {incr x} {..
4770: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
4780: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
4790: 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 nop".. gets $
47a0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 s..}. }. c
47b0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 lose $s. catc
47c0: 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 h {set x [gets $
47d0: 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 f]}. close $f
47e0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f . set x.} {do
47f0: 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 ne 50}..test tls
4800: 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 IO-2.9 {socket c
4810: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
4820: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 stdio} {. se
4830: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4840: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4850: 38 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 8828]. remove
4860: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
4870: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
4880: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 2d pt w]. puts -
4890: 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 0a 09 nonewline $f {..
48a0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c set auto_path [l
48b0: 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 insert $auto_pat
48c0: 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c h 0 [lindex [spl
48d0: 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b it $env(PATH) ";
48e0: 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 :"] 0]]..package
48f0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c require tls..tl
4900: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4910: 72 20 61 63 63 65 70 74 20 38 38 32 38 0a 20 20 r accept 8828.
4920: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4930: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4940: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4950: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4960: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
4970: 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 s $f. after 1
4980: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 00. set x [li
4990: 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 st [catch {close
49a0: 20 24 66 7d 20 6d 73 67 5d 20 5b 73 74 72 69 6e $f} msg] [strin
49b0: 67 20 72 61 6e 67 65 20 24 6d 73 67 20 30 20 34 g range $msg 0 4
49c0: 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 3]]. close $s
49d0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
49e0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
49f0: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
4a00: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
4a10: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 .test tlsIO-2.10
4a20: 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 {close on accep
4a30: 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b t, accepted sock
4a40: 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 et lives} {socke
4a50: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e t} {. set don
4a60: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
4a70: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
4a80: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
4a90: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 ut"]. set ss
4aa0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
4ab0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4ac0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4ad0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4ae0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 t \..-keyfile $s
4af0: 65 72 76 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 erverKey 8830].
4b00: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
4b10: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
4b20: 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 ss..close $ss..
4b30: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4b40: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
4b50: 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 "..fconfigure $s
4b60: 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d -trans lf. }
4b70: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
4b80: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 {s} {..global d
4b90: 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c one..gets $s..cl
4ba0: 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 ose $s..set done
4bb0: 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 1. }. set
4bc0: 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 cs [tls::socket
4bd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4be0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4bf0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4c00: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 le $clientKey [i
4c10: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
4c20: 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 30]. close $c
4c30: 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e s.. vwait don
4c40: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
4c50: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
4c60: 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 t done.} 1..test
4c70: 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 tlsIO-2.11 {det
4c80: 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d ecting new data}
4c90: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
4ca0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
4cb0: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f p} {..global so
4cc0: 63 6b 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 ck..# when doing
4cd0: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
4ce0: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
4cf0: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
4d00: 65 64 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d ed..# to be non-
4d10: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
4d20: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 TLS handshake.
4d30: 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a Also make sure.
4d40: 09 23 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 .# to return the
4d50: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 channel to line
4d60: 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e buffering mode.
4d70: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
4d80: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
4d90: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 fering line..set
4da0: 20 73 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 sock $s..fileev
4db0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
4dc0: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
4dd0: 6b 65 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 ke $s]. }..
4de0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
4df0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4e00: 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ept \.. -cert
4e10: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4e20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4e30: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4e40: 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 rKey 8400]. s
4e50: 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 et sock "". s
4e60: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
4e70: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4e80: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4e90: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4ea0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4eb0: 31 32 37 2e 30 2e 30 2e 31 20 38 34 30 30 5d 0a 127.0.0.1 8400].
4ec0: 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 # when doing
4ed0: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
4ee0: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
4ef0: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
4f00: 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e ed. # to be n
4f10: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
4f20: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
4f30: 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 e Also make sur
4f40: 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 e to. # retur
4f50: 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f n the channel to
4f60: 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 line buffering
4f70: 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 mode (TLS sets i
4f80: 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 t to 'none')..
4f90: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
4fa0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
4fb0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
4fc0: 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 vwait sock.
4fd0: 70 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 puts $s2 one.
4fe0: 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 23 flush $s2. #
4ff0: 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 need update to
5000: 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e complete TLS han
5010: 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 dshake in-proces
5020: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 s. update.
5030: 20 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 after 500. f
5040: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
5050: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
5060: 73 65 74 20 72 65 73 75 6c 74 20 61 3a 5b 67 65 set result a:[ge
5070: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 ts $sock]. la
5080: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 62 3a 5b ppend result b:[
5090: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
50a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
50b0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
50c0: 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 puts $s2 two.
50d0: 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 flush $s2.
50e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
50f0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
5100: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
5110: 63 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 c:[gets $sock].
5120: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5130: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a ock -blocking 1.
5140: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
5150: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
5160: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 lose $sock. s
5170: 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f et result.} {a:o
5180: 6e 65 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 ne b: c:two}..te
5190: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 st tlsIO-2.12 {t
51a0: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e cp connection; n
51b0: 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 20 73 o certificates s
51c0: 70 65 63 69 66 69 65 64 7d 20 5c 0a 09 7b 73 6f pecified} \..{so
51d0: 63 6b 65 74 20 73 74 64 69 6f 20 75 6e 69 78 4f cket stdio unixO
51e0: 6e 6c 79 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 nly} {. # The
51f0: 72 65 20 69 73 20 61 20 64 65 62 75 67 20 61 73 re is a debug as
5200: 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f sertion on Windo
5210: 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 ws/SSL that caus
5220: 65 73 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 es a crash when
5230: 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 the. # certif
5240: 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 icate isn't spec
5250: 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 ified.. remov
5260: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5270: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5280: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
5290: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
52a0: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
52b0: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
52c0: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
52d0: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 TH) ";:"] 0]]..p
52e0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
52f0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
5300: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
5310: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
5320: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
5330: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
5340: 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 8828]..proc acce
5350: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
5360: 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rt} {.. globa
5370: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
5380: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
5390: 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 close $file..}..
53a0: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
53b0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
53c0: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
53d0: 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 $f..puts $x.
53e0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
53f0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
5400: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
5410: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
5420: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
5430: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
5440: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
5450: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
5460: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
5470: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
5480: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
5490: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
54a0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
54b0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
54c0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
54d0: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
54e0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
54f0: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
5500: 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b test tlsIO-3.1 {
5510: 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d socket conflict}
5520: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5530: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
5540: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5550: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
5560: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5570: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
5580: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
5590: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
55a0: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
55b0: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
55c0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
55d0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
55e0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
55f0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
5600: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
5610: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
5620: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5630: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
5640: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
5650: 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 $f {..puts ready
5660: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c ..gets stdin..cl
5670: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
5680: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5690: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
56a0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
56b0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
56c0: 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 +]. gets $f.
56d0: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
56e0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
56f0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
5700: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5710: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5720: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5730: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
5740: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 er accept 8828}
5750: 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 msg] \...$msg].
5760: 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 puts $f bye.
5770: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5780: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
5790: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
57a0: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
57b0: 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 y in use}}..test
57c0: 20 74 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 tlsIO-3.2 {serv
57d0: 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 er with several
57e0: 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 clients} {socket
57f0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
5800: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
5810: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5820: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
5830: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
5840: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
5850: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
5860: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
5870: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
5880: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
5890: 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 e tls..set t1 [a
58a0: 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 fter 30000 "set
58b0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
58c0: 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 et t2 [after 310
58d0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
58e0: 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 out"]..set t3 [a
58f0: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
5900: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
5910: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
5920: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
5930: 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set s \[tls::soc
5940: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5950: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
5960: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
5970: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5980: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
5990: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
59a0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
59b0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
59c0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
59d0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
59e0: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
59f0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
5a00: 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 ng line..}..proc
5a10: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
5a20: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
5a30: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
5a40: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
5a50: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
5a60: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
5a70: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
5aa0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
5ab0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5ac0: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
5ad0: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
5ae0: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
5af0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
5b00: 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 l $t1..vwait x..
5b10: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
5b20: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
5b30: 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f cancel $t3..clo
5b40: 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 se $s..puts $x.
5b50: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5b60: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
5b70: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5b80: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5b90: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 ript]" r+]. s
5ba0: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 et x [gets $f].
5bb0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
5bc0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5bd0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5be0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5bf0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5c00: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
5c10: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 27.0.0.1 8828].
5c20: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5c30: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
5c40: 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c e. set s2 [tl
5c50: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
5c60: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5c70: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5c80: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5c90: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
5ca0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 127.0.0.1 8828
5cb0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
5cc0: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
5cd0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
5ce0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5cf0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
5d00: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5d10: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5d20: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5d30: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
5d40: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
5d50: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
5d60: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
5d70: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
5d80: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
5d90: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
5da0: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
5db0: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a ts $s2 hello,s2.
5dc0: 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 .gets $s2..puts
5dd0: 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 $s3 hello,s3..ge
5de0: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
5df0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
5e00: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
5e10: 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 se $s3. lappe
5e20: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
5e30: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5e40: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
5e50: 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f one}..test tlsIO
5e60: 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 -4.1 {server wit
5e70: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
5e80: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
5e90: 7d 20 7b 0a 20 20 20 20 23 20 68 61 76 65 20 73 } {. # have s
5ea0: 65 65 6e 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 een intermittent
5eb0: 20 68 61 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 hangs on Window
5ec0: 73 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 s. removeFile
5ed0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5ee0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
5ef0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5f00: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
5f10: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
5f20: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
5f30: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
5f40: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
5f50: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
5f60: 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a ets stdin. }.
5f70: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5f80: 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s \[tls::socket
5f90: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5fa0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5fb0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5fc0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
5fd0: 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 .0.1 8828 \]".
5fe0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f puts $f {..fco
5ff0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
6000: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 ering line..for
6010: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
6020: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
6030: 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
6040: 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a lo.. gets $s.
6050: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 .}..close $s..pu
6060: 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 ts bye..gets std
6070: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f in. }. clo
6080: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 se $f. set p1
6090: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
60a0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
60b0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
60c0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
60d0: 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p1 -buffering li
60e0: 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f ne. set p2 [o
60f0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6100: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6110: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6120: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 fconfigure $p2
6130: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
6140: 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e set p3 [open
6150: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6160: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6170: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
6180: 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 onfigure $p3 -bu
6190: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
61a0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
61b0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
61c0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
61d0: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
61e0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
61f0: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
6200: 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 }. proc echo
6210: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a {s} {..global x.
6220: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
6230: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
6240: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
6250: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
6260: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
6270: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
6280: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
6290: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
62a0: 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 $l. }.
62b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b }. set t1 [
62c0: 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 after 30000 "set
62d0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
62e0: 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 set t2 [after
62f0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
6300: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
6310: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
6320: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6330: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b ut"]. set s [
6340: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6350: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
6360: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6370: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6380: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
6390: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
63a0: 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 pt 8828]. put
63b0: 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 s $p1 open. p
63c0: 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 uts $p2 open.
63d0: 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 puts $p3 open.
63e0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 vwait x. v
63f0: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
6400: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
6410: 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 cel $t1. afte
6420: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 r cancel $t2.
6430: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
6440: 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 3. close $s.
6450: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
6460: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
6470: 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 p1 [gets $p1] $x
6480: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6490: 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 [list p2 [gets $
64a0: 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 p2] $x]. lapp
64b0: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b end l [list p3 [
64c0: 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 gets $p3] $x].
64d0: 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 puts $p1 bye.
64e0: 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 0a puts $p2 bye.
64f0: 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 65 puts $p3 bye
6500: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 . close $p1.
6510: 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 close $p2.
6520: 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 close $p3. s
6530: 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 et l.} {{p1 bye
6540: 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f done} {p2 bye do
6550: 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 ne} {p3 bye done
6560: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 }}..test tlsIO-4
6570: 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .2 {byte order p
6580: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
6590: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
65a0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
65b0: 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b et x ok. if {
65c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
65d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
65e0: 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0x3000} msg]} {
65f0: 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 ..set x $msg.
6600: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
6610: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6620: 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 set x.} ok..test
6630: 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 tlsIO-5.1 {byte
6640: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
6650: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
6660: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
6670: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
6680: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
6690: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
66a0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
66b0: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
66c0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
66d0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
66e0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
66f0: 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 set x {htons p
6700: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
6710: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
6720: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
6730: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
6740: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6750: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
6760: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6770: 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f wner}.test tlsIO
6780: 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.2 {byte order
6790: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
67a0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
67b0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
67c0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
67d0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
67e0: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
67f0: 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 gh}. if {![ca
6800: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
6810: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
6820: 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 10000} msg]} {..
6830: 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f set x {port reso
6840: 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 lution problem,
6850: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
6860: 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 owed}..close $ms
6870: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6880: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
6890: 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 en socket: port
68a0: 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d number too high}
68b0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 .test tlsIO-5.3
68c0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
68d0: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
68e0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 bers, htons} \..
68f0: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 {socket unixOnly
6900: 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 notRoot} {.
6910: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
6920: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
6930: 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b owner}. if {
6940: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
6950: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
6960: 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 o 21} msg]} {..s
6970: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
6980: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
6990: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
69a0: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
69b0: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
69c0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
69d0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
69e0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
69f0: 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 r}..test tlsIO-6
6a00: 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 .1 {accept callb
6a10: 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b ack error} {sock
6a20: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
6a30: 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 # There is a deb
6a40: 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 ug assertion on
6a50: 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 Windows/SSL that
6a60: 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 causes a crash
6a70: 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 when the. # c
6a80: 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 ertificate isn't
6a90: 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 specified..
6aa0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
6ab0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
6ac0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
6ad0: 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 puts $f {..set a
6ae0: 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 uto_path [linser
6af0: 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b t $auto_path 0 [
6b00: 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 lindex [split $e
6b10: 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 nv(PATH) ";:"] 0
6b20: 5d 5d 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 ]]. .package
6b30: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 require tls..get
6b40: 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 s stdin. }.
6b50: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
6b60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 tls::socket -caf
6b70: 69 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 2e ile $caCert 127.
6b80: 30 2e 30 2e 31 20 38 38 34 38 5d 0a 20 20 20 20 0.0.1 8848].
6b90: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6ba0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6bb0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6bc0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
6bd0: 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 ]. proc bgerr
6be0: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
6bf0: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
6c00: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
6c10: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
6c20: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
6c30: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6c40: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
6c50: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
6c60: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6c70: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6c80: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6c90: 4b 65 79 20 38 38 34 38 5d 0a 20 20 20 20 70 75 Key 8848]. pu
6ca0: 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $f hello.
6cb0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6cc0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
6cd0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6ce0: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
6cf0: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
6d00: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
6d10: 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 lose $s. rena
6d20: 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 me bgerror {}.
6d30: 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 set x.} {{divi
6d40: 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 de by zero}}..te
6d50: 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 st tlsIO-7.1 {te
6d60: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
6d70: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
6d80: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
6d90: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
6da0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
6db0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
6dc0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
6dd0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
6de0: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
6df0: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
6e00: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
6e10: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
6e20: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
6e30: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c }. puts $f [l
6e40: 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ist tls::socket
6e50: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
6e60: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
6e70: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6e80: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6e90: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6ea0: 38 38 32 30 5d 0a 20 20 20 20 70 75 74 73 20 24 8820]. puts $
6eb0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
6ec0: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
6ed0: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
6ee0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
6ef0: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
6f00: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
6f10: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
6f20: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
6f30: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6f40: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
6f50: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6f60: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6f70: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6f80: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
6f90: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
6fa0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6fb0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
6fc0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6fd0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6fe0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
6ff0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
7000: 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 20]. set p [f
7010: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
7020: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ername]. clos
7030: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
7040: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
7050: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
7060: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
7070: 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 ndex $p 0] 127.0
7080: 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e .0.1]. lappen
7090: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
70a0: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 are [lindex $p 2
70b0: 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 ] 8820]. lapp
70c0: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
70d0: 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 p].} {0 0 3}..te
70e0: 73 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 st tlsIO-7.2 {te
70f0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7100: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
7110: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
7120: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
7130: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
7140: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
7150: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
7160: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
7170: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
7180: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
7190: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
71a0: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
71b0: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
71c0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 74 }. puts $f "t
71d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
71e0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
71f0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
7200: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7210: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7220: 4b 65 79 20 38 38 32 31 22 0a 20 20 20 20 70 75 Key 8821". pu
7230: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
7240: 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 cept args {..
7250: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
7260: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
7270: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
7280: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
7290: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
72a0: 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t"]..vwait x..af
72b0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
72c0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
72d0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
72e0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
72f0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
7300: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
7310: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
7320: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
7330: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
7340: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
7350: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7360: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
7370: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
7380: 31 20 38 38 32 31 5d 0a 20 20 20 20 73 65 74 20 1 8821]. set
7390: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
73a0: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 -sockname].
73b0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
73c0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
73d0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
73e0: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 [llength $p].
73f0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
7400: 64 65 78 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 dex $p 0]. la
7410: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
7420: 65 71 75 61 6c 20 5b 6c 69 6e 64 65 78 20 24 70 equal [lindex $p
7430: 20 32 5d 20 38 38 32 31 5d 0a 7d 20 7b 33 20 31 2] 8821].} {3 1
7440: 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 27.0.0.1 0}..tes
7450: 74 20 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 65 73 t tlsIO-7.3 {tes
7460: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
7470: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
7480: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
7490: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
74a0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 \..-certfile $se
74b0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
74c0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
74d0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 e $serverKey \.
74e0: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
74f0: 70 74 20 38 38 32 32 5d 0a 20 20 20 20 73 65 74 pt 8822]. set
7500: 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 5b 66 63 6f l [llength [fco
7510: 6e 66 69 67 75 72 65 20 24 73 5d 5d 0a 20 20 20 nfigure $s]].
7520: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 close $s. up
7530: 64 61 74 65 0a 20 20 20 20 23 20 41 20 62 75 67 date. # A bug
7540: 20 66 69 78 65 64 20 69 6e 20 66 63 6f 6e 66 69 fixed in fconfi
7550: 67 75 72 65 20 66 6f 72 20 38 2e 33 2e 34 2b 20 gure for 8.3.4+
7560: 6d 61 6b 65 20 74 68 69 73 20 72 65 74 75 72 6e make this return
7570: 20 31 34 20 6e 6f 72 6d 61 6c 6c 79 2c 0a 20 20 14 normally,.
7580: 20 20 23 20 62 75 74 20 31 32 20 69 6e 20 6f 6c # but 12 in ol
7590: 64 65 72 20 76 65 72 73 69 6f 6e 73 2e 0a 20 20 der versions..
75a0: 20 20 65 78 70 72 20 7b 24 6c 20 3e 3d 20 31 32 expr {$l >= 12
75b0: 20 26 26 20 28 28 24 6c 20 25 20 32 29 20 3d 3d && (($l % 2) ==
75c0: 20 30 29 7d 0a 7d 20 31 0a 0a 23 20 62 75 67 20 0)}.} 1..# bug
75d0: 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f report #5812 fco
75e0: 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 nfigure doesn't
75f0: 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 return value for
7600: 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 '-sockname'..te
7610: 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 st tlsIO-7.4 {te
7620: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7630: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
7640: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
7650: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7660: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
7670: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7680: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7690: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
76a0: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
76b0: 65 70 74 20 38 38 32 33 5d 0a 20 20 20 20 70 72 ept 8823]. pr
76c0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
76d0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 } {..global x..s
76e0: 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 et x [fconfigure
76f0: 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 $s -sockname]..
7700: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
7710: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
7720: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
7730: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
7740: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7750: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
7760: 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f Key \. .[info
7770: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 32 33 5d hostname] 8823]
7780: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
7790: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
77a0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
77b0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
77c0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
77d0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
77e0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
77f0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
7800: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
7810: 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 $x 2] [llength
7820: 24 78 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a $x].} {8823 3}..
7830: 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 # bug report #58
7840: 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 12 fconfigure do
7850: 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c esn't return val
7860: 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d ue for '-socknam
7870: 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 e'..test tlsIO-7
7880: 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .5 {testing sock
7890: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
78a0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 ons} {socket uni
78b0: 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 xOrPc} {. set
78c0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
78d0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
78e0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
78f0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7900: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7910: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
7920: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 accept 8829].
7930: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
7940: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
7950: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
7960: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
7970: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
7980: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
7990: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
79a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
79b0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
79c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
79d0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
79e0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 127.0.0.1 8829
79f0: 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ]. set timer
7a00: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
7a10: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
7a20: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
7a30: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
7a40: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
7a50: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
7a60: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
7a70: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
7a80: 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 x $x 0] [lindex
7a90: 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $x 2] [llength $
7aa0: 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 x].} {127.0.0.1
7ab0: 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 8829 3}..test tl
7ac0: 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 sIO-8.1 {testing
7ad0: 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 -async flag on
7ae0: 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 sockets} {socket
7af0: 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 } {. # NOTE:
7b00: 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 This test may fa
7b10: 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 il on some Solar
7b20: 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a is 2.4 systems..
7b30: 20 20 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 # See notes
7b40: 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e in Tcl's socket.
7b50: 74 65 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 test.. set s
7b60: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7b70: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
7b80: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7b90: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7ba0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
7bb0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
7bc0: 65 70 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 ept 8830]. pr
7bd0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
7be0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 } {..global x..#
7bf0: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
7c00: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
7c10: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
7c20: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 th sides need..#
7c30: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
7c40: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
7c50: 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f handshake. Also
7c60: 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f make sure..# to
7c70: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
7c80: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
7c90: 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f ering mode...fco
7ca0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7cb0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
7cc0: 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 g line..puts $s
7cd0: 62 79 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 6e bye..# Only Open
7ce0: 53 53 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 69 SSL 0.9.5a on Wi
7cf0: 6e 64 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 6e ndows seems to n
7d00: 65 65 64 20 74 68 65 20 61 66 74 65 72 20 28 64 eed the after (d
7d10: 65 6c 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 65 elayed)..# close
7d20: 2c 20 62 75 74 20 69 74 20 77 6f 72 6b 73 20 6a , but it works j
7d30: 75 73 74 20 74 68 65 20 73 61 6d 65 20 66 6f 72 ust the same for
7d40: 20 61 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 6f all others. -ho
7d50: 62 62 73 0a 09 61 66 74 65 72 20 35 30 30 20 63 bbs..after 500 c
7d60: 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 lose $s..set x d
7d70: 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 one. }. se
7d80: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
7d90: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
7da0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7db0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7dc0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7dd0: 65 79 20 5c 0a 09 20 20 20 20 2d 61 73 79 6e 63 ey \.. -async
7de0: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
7df0: 20 38 38 33 30 5d 0a 20 20 20 20 23 20 77 68 65 8830]. # whe
7e00: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
7e10: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
7e20: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
7e30: 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 ides need. #
7e40: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
7e50: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
7e60: 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d andshake Also m
7e70: 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 ake sure to.
7e80: 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 # return the cha
7e90: 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 nnel to line buf
7ea0: 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 fering mode (TLS
7eb0: 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e sets it to 'non
7ec0: 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 e').. fconfig
7ed0: 75 72 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e ure $s1 -blockin
7ee0: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
7ef0: 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 78 0a ine. vwait x.
7f00: 20 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 # TLS handsh
7f10: 61 6b 69 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 aking needs one
7f20: 62 79 74 65 20 66 72 6f 6d 20 74 68 65 20 63 6c byte from the cl
7f30: 69 65 6e 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 ient.... puts
7f40: 20 24 73 31 20 61 0a 20 20 20 20 23 20 6e 65 65 $s1 a. # nee
7f50: 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 d update to comp
7f60: 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 lete TLS handsha
7f70: 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 ke in-process.
7f80: 20 20 75 70 64 61 74 65 0a 20 20 20 20 73 65 74 update. set
7f90: 20 7a 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 z [gets $s1].
7fa0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7fb0: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7fc0: 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 74 z.} bye..test t
7fd0: 6c 73 49 4f 2d 39 2e 31 20 7b 74 65 73 74 69 6e lsIO-9.1 {testin
7fe0: 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 g spurious event
7ff0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
8000: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
8010: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
8020: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
8030: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
8040: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
8050: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
8060: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
8070: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
8080: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
8090: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
80a0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
80b0: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
80c0: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
80d0: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
80e0: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
80f0: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
8100: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
8110: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
8120: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8130: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
8140: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
8150: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
8160: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
8170: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 _handshake $s re
8180: 61 64 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c adable readlittl
8190: 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 e \...-buffering
81a0: 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 none]. }.
81b0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
81c0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
81d0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
81e0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
81f0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
8200: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
8210: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 31 5d ver accept 8831]
8220: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8230: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
8240: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
8250: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8260: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
8270: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
8280: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
8290: 38 38 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 8831]. # This
82a0: 20 64 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f differs from so
82b0: 63 6b 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 cket-9.1 in that
82c0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
82d0: 20 74 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e to be. # non
82e0: 2d 62 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 -blocking becaus
82f0: 65 20 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 e of TLS' requir
8300: 65 64 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 ed handshake.
8310: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
8320: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 blocking 0. p
8330: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
8340: 63 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 c 01234567890123
8350: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
8360: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
8370: 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 6789. close $
8380: 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 c. set timer
8390: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
83a0: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
83b0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
83c0: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
83d0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
83e0: 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 ose $s. list
83f0: 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d $spurious $len.}
8400: 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c {0 50}..test tl
8410: 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 sIO-9.2 {testing
8420: 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 async write, fi
8430: 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 leevents, flush
8440: 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 on close} {socke
8450: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 t} {. set fir
8460: 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 stblock [string
8470: 72 65 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 repeat a 31].
8480: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
8490: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
84a0: 62 20 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f b 65535]. pro
84b0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
84c0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
84d0: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 s -blocking 0..f
84e0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
84f0: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
8500: 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 ndshake $s reada
8510: 62 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 ble readable \..
8520: 09 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 .-translation lf
8530: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
8540: 38 34 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 84 -buffering li
8550: 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ne]. }. pr
8560: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
8570: 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 {..set l [gets $
8580: 73 5d 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c s]..dputs "got \
8590: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
85a0: 20 24 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e $l 10 end-3 ...
85b0: 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 ]\" \...([string
85c0: 20 6c 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f length $l]) fro
85d0: 6d 20 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 m $s"..fileevent
85e0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a $s readable {}.
85f0: 09 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 .after 1000 resp
8600: 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ond $s. }.
8610: 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 proc respond {s
8620: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 } {..global firs
8630: 74 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 tblock..dputs "s
8640: 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 end \"[string re
8650: 70 6c 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 place $firstbloc
8660: 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c k 10 end-3 ...]\
8670: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
8680: 65 6e 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 ength $firstbloc
8690: 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 k]) down $s"..pu
86a0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
86b0: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 $firstblock..af
86c0: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
86d0: 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 ta $s. }.
86e0: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
86f0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 s} {..global sec
8700: 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 ondblock..dputs
8710: 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 "send \"[string
8720: 72 65 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 replace $secondb
8730: 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e lock 10 end-3 ..
8740: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e .]\" \...([strin
8750: 67 20 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 g length $second
8760: 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 block]) down $s"
8770: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
8780: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
8790: 6b 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 k..close $s.
87a0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
87b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
87c0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
87d0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
87e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
87f0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
8800: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8810: 38 38 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 8832]. set c
8820: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8830: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8840: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8850: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8860: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8870: 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e . [info hostn
8880: 61 6d 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 ame] 8832]. f
8890: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
88a0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
88b0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
88c0: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
88d0: 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 0. puts $c h
88e0: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
88f0: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
8900: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
8910: 65 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 et data [read $s
8920: 5d 0a 09 64 70 75 74 73 20 22 72 65 61 64 20 5c ]..dputs "read \
8930: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8940: 20 24 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 $data 10 end-3
8950: 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 ...]\" \...([str
8960: 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 ing length $data
8970: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 ]) from $s"..inc
8980: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
8990: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 length $data]..i
89a0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
89b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
89c0: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
89d0: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
89e0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
89f0: 22 72 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 "readit $c".
8a00: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
8a10: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
8a20: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
8a30: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
8a40: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
8a50: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
8a60: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
8a70: 20 20 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 list $count
8a80: 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 $done.} {65566 1
8a90: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e }..test tlsIO-9.
8aa0: 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 3 {testing EOF s
8ab0: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
8ac0: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
8ad0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 ocket} {. # H
8ae0: 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b OBBS: never work
8af0: 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 ed correctly.
8b00: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 proc count_to_e
8b10: 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c of {s} {..global
8b20: 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 count done time
8b30: 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 r..set l [gets $
8b40: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
8b50: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
8b60: 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f unt.. if {$co
8b70: 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f unt > 9} {...clo
8b80: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
8b90: 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e true...set coun
8ba0: 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 t {eof is sticky
8bb0: 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c }...after cancel
8bc0: 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 $timer.. }..
8bd0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
8be0: 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a timerproc {} {.
8bf0: 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 .global done cou
8c00: 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 nt c..set done t
8c10: 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b rue..set count {
8c20: 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 timer went off,
8c30: 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b eof is not stick
8c40: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
8c50: 20 7d 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e }.. set coun
8c60: 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 t 0. set done
8c70: 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 false. proc
8c80: 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 write_then_close
8c90: 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 {s} {..puts $s
8ca0: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 bye..close $s.
8cb0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
8cc0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
8cd0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
8ce0: 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 ocking 0 -buffer
8cf0: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
8d00: 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 ation lf..fileev
8d10: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
8d20: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
8d30: 6b 65 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 ke $s writable w
8d40: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
8d50: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c \...-buffering l
8d60: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8d70: 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 lf]. }. s
8d80: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
8d90: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
8da0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8db0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8dc0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8dd0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
8de0: 72 20 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 r accept 8833].
8df0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
8e00: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8e10: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8e20: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8e30: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8e40: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 entKey \.. [i
8e50: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
8e60: 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 33]. fconfigu
8e70: 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $c -blocking
8e80: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
8e90: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
8ea0: 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 f. fileevent
8eb0: 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 $c readable "cou
8ec0: 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 nt_to_eof $c".
8ed0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
8ee0: 65 72 20 32 30 30 30 20 74 69 6d 65 72 70 72 6f er 2000 timerpro
8ef0: 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e c]. vwait don
8f00: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 e. close $s.
8f10: 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b set count.} {
8f20: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a eof is sticky}..
8f30: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
8f40: 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 30 t..test tlsIO-10
8f50: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .1 {testing sock
8f60: 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 et accept callba
8f70: 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e ck error handlin
8f80: 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 g} {socket} {.
8f90: 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 30 set goterror 0
8fa0: 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f . proc bgerro
8fb0: 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 r args {global g
8fc0: 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 oterror; set got
8fd0: 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 error 1}. set
8fe0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8ff0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9000: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
9010: 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 898]. proc ac
9020: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c cept {s a p} {cl
9030: 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 ose $s; error}.
9040: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
9050: 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 ocket -cafile $c
9060: 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 aCert 127.0.0.1
9070: 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 74 20 8898]. vwait
9080: 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f goterror. clo
9090: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
90a0: 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 $c. set goter
90b0: 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c ror.} 1..test tl
90c0: 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f sIO-11.1 {tcp co
90d0: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
90e0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
90f0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
9100: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
9110: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9120: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 {..set socket9_1
9130: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
9140: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
9150: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
9160: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9170: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9180: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9190: 76 65 72 4b 65 79 20 38 38 33 34 5d 0a 09 70 72 verKey 8834]..pr
91a0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
91b0: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
91c0: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
91d0: 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 puts $s done..
91e0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
91f0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
9200: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9210: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9220: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9230: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9240: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9250: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9260: 49 50 20 38 38 33 34 5d 0a 20 20 20 20 73 65 74 IP 8834]. set
9270: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
9280: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
9290: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
92a0: 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 $socket9_1_test
92b0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
92c0: 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 r.} done..test
92d0: 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 tlsIO-11.2 {clie
92e0: 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 74 73 nt specifies its
92f0: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 port} {socket d
9300: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9310: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 69 66 Server} {. if
9320: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 {[info exists p
9330: 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f ort]} {..incr po
9340: 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a rt. } else {.
9350: 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 .set port [expr
9360: 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 {$tlsServerPort
9370: 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a 20 + [pid]%1024}].
9380: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
9390: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
93a0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
93b0: 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 ocket9_2_test_se
93c0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
93d0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
93e0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
93f0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9400: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9410: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
9420: 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 835]..proc accep
9430: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9440: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9450: 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 $s.. puts $s
9460: 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 $p.. close $s
9470: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
9480: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
9490: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
94a0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
94b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
94c0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
94d0: 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 y \.. -myport
94e0: 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 $port $remoteSe
94f0: 72 76 65 72 49 50 20 38 38 33 35 5d 0a 20 20 20 rverIP 8835].
9500: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d set r [gets $s]
9510: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
9520: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
9530: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f lose $socket9_2_
9540: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
9550: 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 if {$r == $port
9560: 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 } {..set result
9570: 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ok. } else {.
9580: 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b .set result brok
9590: 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 en. }. set
95a0: 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 result.} ok..te
95b0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 st tlsIO-11.3 {t
95c0: 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 rying to connect
95d0: 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f , no server} {so
95e0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
95f0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
9600: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f set status o
9610: 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 k. if {![catc
9620: 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 h {set s [tls::s
9630: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9640: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9650: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9660: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9670: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9680: 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 38 38 emoteServerIp 88
9690: 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 36]}]} {..if {![
96a0: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d catch {gets $s}]
96b0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
96c0: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
96d0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
96e0: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
96f0: 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 k..test tlsIO-11
9700: 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c .4 {remote echo,
9710: 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b one line} {sock
9720: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9730: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9740: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
9750: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9760: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
9770: 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _6_test_server [
9780: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
9790: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
97a0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
97b0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
97c0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
97d0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
97e0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
97f0: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9800: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9810: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
9820: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
9830: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
9840: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
9850: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
9860: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
9870: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9880: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
9890: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
98a0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
98b0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
98c0: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
98d0: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
98e0: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
98f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9900: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9910: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9920: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9930: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9940: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9950: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
9960: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
9970: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
9980: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9990: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
99a0: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
99b0: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
99c0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
99d0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
99e0: 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _6_test_server}.
99f0: 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c set r.} hell
9a00: 6f 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 o..test tlsIO-11
9a10: 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c .5 {remote echo,
9a20: 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 50 lines} {sock
9a30: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9a40: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9a50: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
9a60: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9a70: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
9a80: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _7_test_server [
9a90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
9aa0: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d ver accept \...-
9ab0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9ac0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9ad0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9ae0: 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 erverKey 8836]..
9af0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
9b00: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
9b10: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
9b20: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
9b30: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
9b40: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
9b50: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
9b60: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
9b70: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
9b80: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
9b90: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
9ba0: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
9bb0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
9bc0: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
9bd0: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
9be0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
9bf0: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
9c00: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9c10: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9c20: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9c30: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9c40: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9c50: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9c60: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9c70: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
9c80: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
9c90: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
9ca0: 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 {set cnt 0} {$c
9cb0: 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 nt < 50} {incr c
9cc0: 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 nt} {..puts $f "
9cd0: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 hello, $cnt"..if
9ce0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
9cf0: 65 20 5b 67 65 74 73 20 24 66 5d 20 22 68 65 6c e [gets $f] "hel
9d00: 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d 20 30 7d lo, $cnt"] != 0}
9d10: 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d {.. break..}
9d20: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
9d30: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
9d40: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
9d50: 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 et10_7_test_serv
9d60: 65 72 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a er}. set cnt.
9d70: 7d 20 35 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 } 50..# Macintos
9d80: 68 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 h sockets can ha
9d90: 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 ve more than one
9da0: 20 73 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 server per port
9db0: 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f .if {$tcl_platfo
9dc0: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 rm(platform) ==
9dd0: 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 "macintosh"} {.
9de0: 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 set conflictR
9df0: 65 73 75 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d esult {0 8836}.}
9e00: 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 else {. set
9e10: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
9e20: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
9e30: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
9e40: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d already in use}
9e50: 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d }.}..test tlsIO-
9e60: 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 11.6 {socket con
9e70: 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 flict} {socket d
9e80: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9e90: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
9ea0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
9eb0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9ec0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9ed0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9ee0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9ef0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
9f00: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 r accept 8836].
9f10: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 if {[catch {s
9f20: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
9f30: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9f40: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
9f50: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9f60: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
9f70: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
9f80: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 7d er accept 8836]}
9f90: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 msg]} {..set re
9fa0: 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 sult [list 1 $ms
9fb0: 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a g]. } else {.
9fc0: 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 .set result [lis
9fd0: 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f t 0 [lindex [fco
9fe0: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 nfigure $s2 -soc
9ff0: 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 kname] 2]]..clos
a000: 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 e $s2. }.
a010: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
a020: 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 t result.} $conf
a030: 6c 69 63 74 52 65 73 75 6c 74 0a 0a 74 65 73 74 lictResult..test
a040: 20 74 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 65 72 tlsIO-11.7 {ser
a050: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
a060: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
a070: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
a080: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
a090: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
a0a0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a0b0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
a0c0: 39 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 9_test_server [t
a0d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
a0e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a0f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a100: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
a110: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
a120: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
a130: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
a140: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 s a p} {.. fc
a150: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
a160: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
a170: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
a180: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
a190: 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 o $s]..}..proc e
a1a0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
a1b0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
a1c0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
a1d0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
a1e0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
a1f0: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
a200: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
a210: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
a220: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a230: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a240: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a250: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a260: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
a270: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
a280: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
a290: 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s1 -buffering li
a2a0: 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 ne. set s2 [t
a2b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a2c0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a2d0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a2e0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a2f0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
a300: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
a310: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
a320: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 nfigure $s2 -buf
a330: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
a340: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a350: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
a360: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a370: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a380: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a390: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
a3a0: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
a3b0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
a3c0: 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 $s3 -buffering
a3d0: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
a3e0: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 t i 0} {$i < 100
a3f0: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 } {incr i} {..pu
a400: 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a ts $s1 hello,s1.
a410: 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 .gets $s1..puts
a420: 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 $s2 hello,s2..ge
a430: 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 ts $s2..puts $s3
a440: 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 hello,s3..gets
a450: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s3. }. cl
a460: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
a470: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
a480: 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s3. sendComm
a490: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
a4a0: 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 et10_9_test_serv
a4b0: 65 72 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 er}. set i.}
a4c0: 31 30 30 20 20 20 20 0a 0a 74 65 73 74 20 74 6c 100 ..test tl
a4d0: 73 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 sIO-11.8 {client
a4e0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 with several se
a4f0: 72 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 rvers} {socket d
a500: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
a510: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
a520: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
a530: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
a540: 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 tls::init -certf
a550: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
a560: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a570: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a580: 4b 65 79 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 Key..set s1 [tls
a590: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
a5a0: 20 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 "accept 4003" 4
a5b0: 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 003]..set s2 [tl
a5c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
a5d0: 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 r "accept 4004"
a5e0: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
a5f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
a600: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 er "accept 4005"
a610: 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 68 61 6e 4005]..proc han
a620: 64 73 68 61 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a dshake {s mp} {.
a630: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
a640: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
a650: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
a660: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 catch {tls::hand
a670: 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 shake $s} result
a680: 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 ]} {...# Some er
a690: 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e rors are normal.
a6a0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b .. } elseif {
a6b0: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a $result == 1} {.
a6c0: 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f ..# Handshake co
a6d0: 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 mplete...fileeve
a6e0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
a6f0: 22 0a 09 09 70 75 74 73 20 24 73 20 24 6d 70 0a "...puts $s $mp.
a700: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a710: 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 }..}..proc accep
a720: 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 t {mp s a p} {..
a730: 20 20 20 20 23 20 54 68 65 73 65 20 68 61 76 65 # These have
a740: 20 74 6f 20 61 63 63 65 70 74 20 6e 6f 6e 2d 62 to accept non-b
a750: 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 61 75 73 65 locking, because
a760: 20 74 68 65 20 68 61 6e 64 73 68 61 6b 69 6e 67 the handshaking
a770: 0a 09 20 20 20 20 23 20 6f 72 64 65 72 20 69 73 .. # order is
a780: 6e 27 74 20 64 65 74 65 72 6d 69 6e 69 73 74 69 n't deterministi
a790: 63 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 c.. fconfigur
a7a0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
a7b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a7c0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
a7d0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
a7e0: 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73 20 24 t handshake $s $
a7f0: 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 mp]..}. }.
a800: 20 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 tls::init -cert
a810: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a820: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a830: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a840: 74 4b 65 79 0a 20 20 20 20 73 65 74 20 73 31 20 tKey. set s1
a850: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a860: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a870: 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 3]. set s2 [t
a880: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
a890: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 5d teServerIP 4004]
a8a0: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
a8b0: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
a8c0: 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 ServerIP 4005].
a8d0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
a8e0: 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 lappend l [gets
a8f0: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 $s1] [gets $s1]
a900: 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 [eof $s1] [gets
a910: 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s2] [gets $s2]
a920: 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 [eof $s2] \..[ge
a930: 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 ts $s3] [gets $s
a940: 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 3] [eof $s3].
a950: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
a960: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
a970: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
a980: 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 ommand {..close
a990: 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 $s1..close $s2..
a9a0: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a close $s3. }.
a9b0: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 set l.} {400
a9c0: 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 3 {} 1 4004 {} 1
a9d0: 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 4005 {} 1}..tes
a9e0: 74 20 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 t tlsIO-11.9 {ac
a9f0: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
aa00: 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ror} {socket doT
aa10: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
aa20: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
aa30: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
aa40: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
aa50: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
aa60: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
aa70: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
aa80: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
aa90: 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 ccept 8836].
aaa0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
aab0: 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 p} {expr 10 / 0
aac0: 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 }. proc bgerr
aad0: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
aae0: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
aaf0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
ab00: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 69 66 ertValues. if
ab10: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
ab20: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
ab30: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
ab40: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
ab50: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
ab60: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
ab70: 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d socket \... -
ab80: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
ab90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
aba0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
abb0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 20 20 20 lientKey \...
abc0: 20 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 [lindex $peerna
abd0: 6d 65 20 30 5d 20 38 38 33 36 5d 0a 09 20 20 20 me 0] 8836]..
abe0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 close $s. .
abf0: 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 }} msg]} {..clos
ac00: 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 e $s..error $msg
ac10: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
ac20: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
ac30: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
ac40: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
ac50: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
ac60: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
ac70: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
ac80: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
ac90: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
aca0: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
acb0: 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 tlsIO-11.10 {te
acc0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
acd0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
ace0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
acf0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
ad00: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
ad10: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
ad20: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
ad30: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
ad40: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
ad50: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
ad60: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
ad70: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ad80: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
ad90: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
ada0: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
adb0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c cept {s a p} {cl
adc0: 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 ose $s}. }.
add0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
ade0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
adf0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
ae00: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
ae10: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
ae20: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
ae30: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
ae40: 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6]. set p [fc
ae50: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 onfigure $s -pee
ae60: 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e rname]. set n
ae70: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
ae80: 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 -sockname]. s
ae90: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
aea0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 end l [lindex $p
aeb0: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 2] [llength $p]
aec0: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 [llength $p].
aed0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
aee0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
aef0: 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 e $socket10_12_t
af00: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
af10: 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 set l.} {8836 3
af20: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 3}..test tlsIO-1
af30: 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 1.11 {testing sp
af40: 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b urious events} {
af50: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
af60: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
af70: 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 {. # remote e
af80: 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 quivalent of 9.1
af90: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
afa0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
afb0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
afc0: 74 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 t_test_server [t
afd0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
afe0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
aff0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
b000: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
b010: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
b020: 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 rverKey 8836]..p
b030: 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 roc handshake {s
b040: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f } {.. if {[eo
b050: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
b060: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 $s.. } elsei
b070: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
b080: 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 handshake $s} re
b090: 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d sult]} {...# Som
b0a0: 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 e errors are nor
b0b0: 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 mal... } else
b0c0: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
b0d0: 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b } {...# Handshak
b0e0: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c e complete...fil
b0f0: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
b100: 6c 65 20 22 22 0a 09 09 61 66 74 65 72 20 31 30 le ""...after 10
b110: 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 0 writesome $s..
b120: 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 }..}..proc a
b130: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
b140: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
b150: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
b160: 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 "auto lf".. f
b170: 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 ileevent $s writ
b180: 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 able [list hands
b190: 68 61 6b 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f hake $s]..}..pro
b1a0: 63 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 c writesome {s}
b1b0: 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 {.. for {set
b1c0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
b1d0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 {incr i} {...put
b1e0: 73 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 s $s "line $i fr
b1f0: 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 om remote server
b200: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c ".. }.. cl
b210: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
b220: 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 set len 0.
b230: 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 set spurious 0
b240: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
b250: 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 proc readlit
b260: 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 tle {s} {..globa
b270: 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 l spurious done
b280: 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 len..set l [read
b290: 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 $s 1]..if {[str
b2a0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d ing length $l] =
b2b0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b = 0} {.. if {
b2c0: 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 ![eof $s]} {...i
b2d0: 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 ncr spurious..
b2e0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f } else {...clo
b2f0: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
b300: 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 1.. }..} els
b310: 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 e {.. incr le
b320: 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 n [string length
b330: 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 $l]..}. }.
b340: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
b350: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
b360: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
b370: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
b380: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
b390: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
b3a0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
b3b0: 36 5d 0a 20 20 20 20 23 20 47 65 74 20 74 68 65 6]. # Get the
b3c0: 20 62 75 66 66 65 72 69 6e 67 20 63 6f 72 72 65 buffering corre
b3d0: 63 74 65 64 0a 20 20 20 20 66 63 6f 6e 66 69 67 cted. fconfig
b3e0: 75 72 65 20 24 63 20 2d 62 75 66 66 65 72 69 6e ure $c -bufferin
b3f0: 67 20 6c 69 6e 65 0a 20 20 20 20 23 20 50 75 74 g line. # Put
b400: 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 a byte into the
b410: 20 63 6c 69 65 6e 74 20 70 69 70 65 20 74 6f 20 client pipe to
b420: 74 72 69 67 67 65 72 20 54 4c 53 20 68 61 6e 64 trigger TLS hand
b430: 73 68 61 6b 69 6e 67 0a 20 20 20 20 70 75 74 73 shaking. puts
b440: 20 24 63 20 61 0a 20 20 20 20 66 69 6c 65 65 76 $c a. fileev
b450: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b460: 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 [list readlittle
b470: 20 24 63 5d 0a 20 20 20 20 73 65 74 20 74 69 6d $c]. set tim
b480: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
b490: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
b4a0: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
b4b0: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
b4c0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
b4d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
b4e0: 6f 73 65 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 ose $socket_test
b4f0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 _server}. lis
b500: 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e t $spurious $len
b510: 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 .} {0 2690}..tes
b520: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 t tlsIO-11.12 {t
b530: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
b540: 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 yness} {unexplai
b550: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
b560: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b570: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b580: 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 # remote equiva
b590: 6c 65 6e 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 lent of 9.3.
b5a0: 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 # HOBBS: never w
b5b0: 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a orked correctly.
b5c0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 set counter
b5d0: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0. set done 0
b5e0: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
b5f0: 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c up {s} {..global
b600: 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 counter done af
b610: 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 ter_id..set l [g
b620: 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f ets $s]..if {[eo
b630: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e f $s]} {.. in
b640: 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 cr counter..
b650: 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 if {$counter > 9
b660: 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b } {...set done {
b670: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 EOF is sticky}..
b680: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 .after cancel $a
b690: 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 fter_id...close
b6a0: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $s.. }..}.
b6b0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
b6c0: 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 d_out {} {..glob
b6d0: 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 al c done..set d
b6e0: 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 one {timed_out,
b6f0: 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b EOF is not stick
b700: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
b710: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
b720: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
b730: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
b740: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b750: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
b760: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
b770: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
b780: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b790: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
b7a0: 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 \...-server acce
b7b0: 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 8836]..proc a
b7c0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
b7d0: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
b7e0: 61 6b 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 ake $s.. afte
b7f0: 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 r 100 close $s..
b800: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
b810: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
b820: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
b830: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
b840: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b850: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
b860: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
b870: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
b880: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
b890: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 adable "count_up
b8a0: 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 $c". set aft
b8b0: 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 er_id [after 100
b8c0: 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 0 timed_out].
b8d0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
b8e0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
b8f0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f se $socket10_14_
b900: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
b910: 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 set done.} {EOF
b920: 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 is sticky}..tes
b930: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 t tlsIO-11.13 {t
b940: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
b950: 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c te, async flush,
b960: 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a async close} \.
b970: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
b980: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
b990: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 } {. proc rea
b9a0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
b9b0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
b9c0: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
b9d0: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
b9e0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
b9f0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
ba00: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
ba10: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
ba20: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
ba30: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
ba40: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 Command {..set f
ba50: 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e irstblock [strin
ba60: 67 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a 09 g repeat a 31]..
ba70: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
ba80: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 [string repeat b
ba90: 20 36 35 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 65535]..set l [
baa0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
bab0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
bac0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
bad0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
bae0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
baf0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 34 erver accept 884
bb00: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
bb10: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
bb20: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
bb30: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
bb40: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
bb50: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
bb60: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
bb70: 34 20 5c 0a 09 09 20 20 20 20 2d 62 75 66 66 65 4 \... -buffe
bb80: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
bb90: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
bba0: 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 able "readable $
bbb0: 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 s"..}..proc read
bbc0: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 able {s} {..
bbd0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
bbe0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
bbf0: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 s readable {}..
bc00: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 65 after 1000 re
bc10: 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f spond $s..}..pro
bc20: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
bc30: 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 . global firs
bc40: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 tblock.. puts
bc50: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
bc60: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
bc70: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
bc80: 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 data $s..}..proc
bc90: 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b writedata {s} {
bca0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 .. global sec
bcb0: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 ondblock.. pu
bcc0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
bcd0: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 $secondblock..
bce0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
bcf0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
bd00: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
bd10: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
bd20: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
bd30: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
bd40: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
bd50: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
bd60: 72 49 50 20 38 38 34 35 5d 0a 20 20 20 20 66 63 rIP 8845]. fc
bd70: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
bd80: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 cking 0 -transla
bd90: 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 tion lf -bufferi
bda0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
bdb0: 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 count 0. puts
bdc0: 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 $s hello. fi
bdd0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
bde0: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
bdf0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
be00: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
be10: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
be20: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
be30: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
be40: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
be50: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
be60: 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 l}. set count
be70: 0a 7d 20 36 35 35 36 36 0a 0a 70 72 6f 63 20 67 .} 65566..proc g
be80: 65 74 64 61 74 61 20 7b 74 79 70 65 20 66 69 6c etdata {type fil
be90: 65 7d 20 7b 0a 20 20 20 20 23 20 52 65 61 64 20 e} {. # Read
bea0: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 handler on the a
beb0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
bec0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
bed0: 20 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 20 global failed.
bee0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 5b 63 set status [c
bef0: 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 atch {read $file
bf00: 7d 20 64 61 74 61 5d 0a 20 20 20 20 69 66 20 7b } data]. if {
bf10: 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a $status != 0} {.
bf20: 09 73 65 74 20 78 20 22 72 65 61 64 20 66 61 69 .set x "read fai
bf30: 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 led, error was $
bf40: 64 61 74 61 22 0a 09 63 61 74 63 68 20 7b 20 63 data"..catch { c
bf50: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 lose $file }.
bf60: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 } elseif {[stri
bf70: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
bf80: 61 74 61 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c ata]} {. } el
bf90: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
bfa0: 24 66 69 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 $file]} {. }
bfb0: 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 elseif {[eof $fi
bfc0: 6c 65 5d 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 le]} {..if {$fai
bfd0: 6c 65 64 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 led} {.. set
bfe0: 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 x "$type socket
bff0: 77 61 73 20 69 6e 68 65 72 69 74 65 64 22 0a 09 was inherited"..
c000: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
c010: 74 20 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 t x "$type socke
c020: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
c030: 74 65 64 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b ted"..}..catch {
c040: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 close $file }.
c050: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
c060: 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 x {impossible c
c070: 61 73 65 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c ase}..catch { cl
c080: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 ose $file }.
c090: 7d 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a }. return.}..
c0a0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 test tlsIO-12.1
c0b0: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
c0c0: 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 ance of server s
c0d0: 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 ockets} {socket
c0e0: 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 exec} {. make
c0f0: 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a File {} script1.
c100: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 makeFile {}
c110: 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 script2.. # S
c120: 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 cript1 is just a
c130: 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 10 second delay
c140: 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 . If the server
c150: 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 socket. # is
c160: 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 inherited, it w
c170: 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e ill be held open
c180: 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a for 10 seconds.
c190: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
c1a0: 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 script1 w].
c1b0: 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 puts $f {..after
c1c0: 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 10000 exit..vwa
c1d0: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c1e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c1f0: 20 20 20 23 20 53 63 72 69 70 74 32 20 63 72 65 # Script2 cre
c200: 61 74 65 73 20 74 68 65 20 73 65 72 76 65 72 20 ates the server
c210: 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 socket, launches
c220: 20 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 script1,. #
c230: 77 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 waits a second,
c240: 61 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 and exits. The
c250: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 server socket wi
c260: 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 ll now. # be
c270: 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 closed unless sc
c280: 72 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 ript1 inherited
c290: 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b it... set f [
c2a0: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
c2b0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c2c0: 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 t set tclsh $::t
c2d0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
c2e0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c2f0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c set auto_path [l
c300: 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 insert $auto_pat
c310: 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c h 0 [lindex [spl
c320: 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b it $env(PATH) ";
c330: 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 :"] 0]]..package
c340: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
c350: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
c360: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c370: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
c380: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
c390: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
c3a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c3b0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
c3c0: 4b 65 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 Key 8828\]".
c3d0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
c3e0: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 accept { file ad
c3f0: 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 dr port } {..
c400: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
c410: 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 .exec $tclsh scr
c420: 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 ipt1 &..close $f
c430: 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 ..after 1000 exi
c440: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
c450: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c460: 20 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e $f... # Laun
c470: 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 ch script2 and w
c480: 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 ait 5 seconds..
c490: 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 exec $::tclte
c4a0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
c4b0: 70 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 pt2 &. after
c4c0: 35 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5000 { set ok_to
c4d0: 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 _proceed 1 }.
c4e0: 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f vwait ok_to_pro
c4f0: 63 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 ceed.. # If w
c500: 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e e can still conn
c510: 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 ect to the serve
c520: 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f r, the socket go
c530: 74 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 t inherited...
c540: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
c550: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
c560: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
c570: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c580: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
c590: 65 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 entKey \. . 12
c5a0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 7.0.0.1 8828} ms
c5b0: 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 g]} {..set x {se
c5c0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
c5d0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 not inherited}.
c5e0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f } else {..clo
c5f0: 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b se $msg..set x {
c600: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
c610: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 s inherited}.
c620: 20 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }.. set x.}
c630: 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 {server socket w
c640: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
c650: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 }..test tlsIO-12
c660: 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .2 {testing inhe
c670: 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e ritance of clien
c680: 74 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b t sockets} {sock
c690: 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d et exec} {. m
c6a0: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
c6b0: 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 t1. makeFile
c6c0: 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 {} script2..
c6d0: 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 # Script1 is jus
c6e0: 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 t a 10 second de
c6f0: 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 lay. If the ser
c700: 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 ver socket. #
c710: 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 is inherited, i
c720: 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f t will be held o
c730: 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e pen for 10 secon
c740: 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ds.. set f [o
c750: 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 pen script1 w].
c760: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 puts $f {..af
c770: 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 ter 10000 exit..
c780: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c790: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
c7a0: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 .. # Script2
c7b0: 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 opens the client
c7c0: 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 socket and writ
c7d0: 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 es to it. It th
c7e0: 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 en. # launche
c7f0: 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 s script1 and ex
c800: 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 its. If the chi
c810: 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 ld process inher
c820: 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 ited the. # c
c830: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 lient socket, th
c840: 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 e socket will st
c850: 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 ill be open...
c860: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c870: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c880: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c890: 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a clsh $::tcltest:
c8a0: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
c8b0: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
c8c0: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
c8d0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
c8e0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
c8f0: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
c900: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
c910: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
c920: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
c930: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
c940: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
c950: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c960: 72 74 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 rt \.. -keyfi
c970: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
c980: 37 2e 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 7.0.0.1 8829\]".
c990: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 puts $f {..e
c9a0: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c9b0: 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 t1 &..puts $f te
c9c0: 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a sting..flush $f.
c9d0: 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 .after 1000 exit
c9e0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c9f0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
ca00: 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 $f.. # Create
ca10: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
ca20: 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 et.. set serv
ca30: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
ca40: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ca50: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
ca60: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ca70: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
ca80: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
ca90: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 accept 8829].
caa0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 proc accept { f
cab0: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
cac0: 7b 0a 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c {..# When the cl
cad0: 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 ient connects, e
cae0: 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 stablish the rea
caf0: 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 d handler..globa
cb00: 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 l server..close
cb10: 24 73 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 $server..fconfig
cb20: 75 72 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b ure $file -block
cb30: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
cb40: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
cb50: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
cb60: 6b 65 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c ke $file readabl
cb70: 65 20 5c 0a 09 09 5b 6c 69 73 74 20 67 65 74 64 e \...[list getd
cb80: 61 74 61 20 63 6c 69 65 6e 74 5d 20 2d 62 75 66 ata client] -buf
cb90: 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 fering line]..re
cba0: 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 turn. }..
cbb0: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
cbc0: 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d doesn't hit end-
cbd0: 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 of-file in 5 sec
cbe0: 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 onds, the. #
cbf0: 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 script1 process
cc00: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
cc10: 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a ted the client..
cc20: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
cc30: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
cc40: 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 [list set faile
cc50: 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e d 1].. # Laun
cc60: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
cc70: 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 rocess.. exec
cc80: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
cc90: 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a test script2 &..
cca0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
ccb0: 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a if {!$failed} {.
ccc0: 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 .vwait failed.
ccd0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
cce0: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
ccf0: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
cd00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 }..test tlsIO-12
cd10: 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .3 {testing inhe
cd20: 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 ritance of accep
cd30: 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ted sockets} \..
cd40: 7b 73 6f 63 6b 65 74 20 65 78 65 63 20 75 6e 69 {socket exec uni
cd50: 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b xOnly} {. mak
cd60: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 eFile {} script1
cd70: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
cd80: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 script2.. se
cd90: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
cda0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
cdb0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
cdc0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
cdd0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
cde0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 ose $f.. set
cdf0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
ce00: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
ce10: 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 list set tclsh $
ce20: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
ce30: 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 st]. puts $f
ce40: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
ce50: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
ce60: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
ce70: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
ce80: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
ce90: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
cea0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
ceb0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
cec0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
ced0: 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 ccept \.. -ce
cee0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
cef0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
cf00: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
cf10: 76 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 verKey 8930\]".
cf20: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
cf30: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
cf40: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 host port } {..
cf50: 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 global tclsh
cf60: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
cf70: 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e $file -bufferin
cf80: 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 73 g line.. puts
cf90: 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 $file {test dat
cfa0: 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 a on socket}..
cfb0: 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 exec $tclsh sc
cfc0: 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 ript1 &.. aft
cfd0: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a er 1000 exit..}.
cfe0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
cff0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
d000: 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 f.. # Launch
d010: 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 the script2 proc
d020: 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 ess and connect
d030: 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 to it. See how
d040: 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 long. # the s
d050: 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e ocket stays open
d060: 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 .. exec $::tc
d070: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
d080: 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 cript2 &.. af
d090: 74 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b 5f ter 2000 set ok_
d0a0: 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 to_proceed 1.
d0b0: 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f vwait ok_to_pro
d0c0: 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 ceed.. set f
d0d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
d0e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
d0f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
d100: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
d110: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
d120: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
d130: 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 930]. fconfig
d140: 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e ure $f -bufferin
d150: 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 g full -blocking
d160: 20 30 0a 20 20 20 20 23 20 57 65 20 6e 65 65 64 0. # We need
d170: 20 74 6f 20 70 75 74 20 61 20 62 79 74 65 20 69 to put a byte i
d180: 6e 74 6f 20 74 68 65 20 72 65 61 64 20 71 75 65 nto the read que
d190: 75 65 2c 20 6f 74 68 65 72 77 69 73 65 20 74 68 ue, otherwise th
d1a0: 65 0a 20 20 20 20 23 20 54 4c 53 20 68 61 6e 64 e. # TLS hand
d1b0: 73 68 61 6b 65 20 64 6f 65 73 6e 27 74 20 66 69 shake doesn't fi
d1c0: 6e 69 73 68 0a 20 20 20 20 70 75 74 73 20 24 66 nish. puts $f
d1d0: 20 61 3b 20 66 6c 75 73 68 20 24 66 0a 20 20 20 a; flush $f.
d1e0: 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 fileevent $f re
d1f0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 adable [list get
d200: 64 61 74 61 20 61 63 63 65 70 74 65 64 20 24 66 data accepted $f
d210: 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 ].. # If the
d220: 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 socket is still
d230: 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 open after 5 sec
d240: 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 onds, the script
d250: 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 1 process. #
d260: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
d270: 74 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 ted the accepted
d280: 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 socket... se
d290: 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 t failed 0. a
d2a0: 66 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 fter 5000 set fa
d2b0: 69 6c 65 64 20 31 0a 0a 20 20 20 20 76 77 61 69 iled 1.. vwai
d2c0: 74 20 78 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 t x. set x.}
d2d0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
d2e0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
d2f0: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
d300: 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 13.1 {Testing us
d310: 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b e of shared sock
d320: 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 et between two t
d330: 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b hreads} \..{sock
d340: 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b et testthread} {
d350: 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 . # HOBBS: ne
d360: 76 65 72 20 74 65 73 74 65 64 0a 20 20 20 20 72 ver tested. r
d370: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
d380: 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a . threadReap.
d390: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a . makeFile {.
d3a0: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
d3b0: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
d3c0: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
d3d0: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
d3e0: 3b 3a 22 5d 20 30 5d 5d 0a 20 20 20 20 09 70 61 ;:"] 0]]. .pa
d3f0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
d400: 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 s..set f [tls::s
d410: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
d420: 63 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 cept 8828]..proc
d430: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
d440: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 {. fi
d450: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
d460: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
d470: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 s]. f
d480: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
d490: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
d4a0: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
d4b0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c o {s} {.. gl
d4c0: 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 obal i.
d4d0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
d4e0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
d4f0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
d500: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d510: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
d520: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
d530: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
d540: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
d550: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
d560: 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 else { ..
d570: 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 incr i.
d580: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
d590: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
d5a0: 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a }..}..set i 0.
d5b0: 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 .vwait x..close
d5c0: 24 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c $f...# thread cl
d5d0: 65 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a eans itself up..
d5e0: 09 74 65 73 74 74 68 72 65 61 64 20 65 78 69 74 .testthread exit
d5f0: 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 . } script.
d600: 20 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 . # create
d610: 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 a thread. set
d620: 20 73 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 serverthread [t
d630: 65 73 74 74 68 72 65 61 64 20 63 72 65 61 74 65 estthread create
d640: 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 { source script
d650: 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a } ]. update.
d660: 20 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 . after 1
d670: 30 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 000. set s [t
d680: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
d690: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
d6a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
d6b0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 ffering line..
d6c0: 20 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 catch {..puts
d6d0: 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 $s "hello"..gets
d6e0: 20 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d $s result. }
d6f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
d700: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 update.. af
d710: 74 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 ter 2000. lap
d720: 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 pend result [thr
d730: 65 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 eadReap]. .
d740: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 set result..}
d750: 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 {hello 1}..# cle
d760: 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 anup.if {[string
d770: 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f match sock* $co
d780: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 mmandSocket] ==
d790: 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 1} {. puts $co
d7a0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 mmandSocket exit
d7b0: 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 . flush $comma
d7c0: 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 ndSocket.}.catch
d7d0: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
d7e0: 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 Socket}.catch {c
d7f0: 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 lose $remoteProc
d800: 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a Chan}.::tcltest:
d810: 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c :cleanupTests.fl
d820: 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 ush stdout.retur
d830: 6e 0a n.