0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65 # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20 d in this file:
0020: 73 6f 63 6b 65 74 2e 20 20 20 20 20 20 20 20 20 socket.
0030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0040: 20 2d 2a 2d 20 74 63 6c 20 2d 2a 2d 0a 23 0a 23 -*- tcl -*-.#.#
0050: 20 54 68 69 73 20 66 69 6c 65 20 63 6f 6e 74 61 This file conta
0060: 69 6e 73 20 61 20 63 6f 6c 6c 65 63 74 69 6f 6e ins a collection
0070: 20 6f 66 20 74 65 73 74 73 20 66 6f 72 20 6f 6e of tests for on
0080: 65 20 6f 72 20 6d 6f 72 65 20 6f 66 20 74 68 65 e or more of the
0090: 20 54 63 6c 0a 23 20 62 75 69 6c 74 2d 69 6e 20 Tcl.# built-in
00a0: 63 6f 6d 6d 61 6e 64 73 2e 20 20 53 6f 75 72 63 commands. Sourc
00b0: 69 6e 67 20 74 68 69 73 20 66 69 6c 65 20 69 6e ing this file in
00c0: 74 6f 20 54 63 6c 20 72 75 6e 73 20 74 68 65 20 to Tcl runs the
00d0: 74 65 73 74 73 20 61 6e 64 0a 23 20 67 65 6e 65 tests and.# gene
00e0: 72 61 74 65 73 20 6f 75 74 70 75 74 20 66 6f 72 rates output for
00f0: 20 65 72 72 6f 72 73 2e 20 20 4e 6f 20 6f 75 74 errors. No out
0100: 70 75 74 20 6d 65 61 6e 73 20 6e 6f 20 65 72 72 put means no err
0110: 6f 72 73 20 77 65 72 65 20 66 6f 75 6e 64 2e 0a ors were found..
0120: 23 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 #.# Copyright (c
0130: 29 20 31 39 39 34 2d 31 39 39 36 20 53 75 6e 20 ) 1994-1996 Sun
0140: 4d 69 63 72 6f 73 79 73 74 65 6d 73 2c 20 49 6e Microsystems, In
0150: 63 2e 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 c..# Copyright (
0160: 63 29 20 31 39 39 38 2d 32 30 30 30 20 41 6a 75 c) 1998-2000 Aju
0170: 62 61 20 53 6f 6c 75 74 69 6f 6e 73 2e 0a 23 0a ba Solutions..#.
0180: 23 20 53 65 65 20 74 68 65 20 66 69 6c 65 20 22 # See the file "
0190: 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 22 20 66 license.terms" f
01a0: 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f or information o
01b0: 6e 20 75 73 61 67 65 20 61 6e 64 20 72 65 64 69 n usage and redi
01c0: 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66 20 stribution.# of
01d0: 74 68 69 73 20 66 69 6c 65 2c 20 61 6e 64 20 66 this file, and f
01e0: 6f 72 20 61 20 44 49 53 43 4c 41 49 4d 45 52 20 or a DISCLAIMER
01f0: 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e 54 49 45 OF ALL WARRANTIE
0200: 53 2e 0a 23 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 S..#..# Running
0210: 73 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 socket tests wit
0220: 68 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 h a remote serve
0230: 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d r:.# -----------
0240: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0250: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a ---------------.
0260: 23 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 #.# Some tests i
0270: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 n socket.test de
0280: 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 pend on the exis
0290: 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 tence of a remot
02a0: 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 e server to.# wh
02b0: 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 ich they connect
02c0: 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 . The remote ser
02d0: 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 ver must be an i
02e0: 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 nstance of tclte
02f0: 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 st and it.# must
0300: 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 run the script
0310: 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c found in the fil
0320: 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 e "remote.tcl" i
0330: 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 n this directory
0340: 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 . You.# can star
0350: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
0360: 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 ver on any machi
0370: 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f ne reachable fro
0380: 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e m the machine on
0390: 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e .# which you wan
03a0: 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 t to run the soc
03b0: 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 ket tests, by is
03c0: 73 75 69 6e 67 3a 0a 23 0a 23 20 20 20 20 20 74 suing:.#.# t
03d0: 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 cltest remote.tc
03e0: 6c 20 2d 70 6f 72 74 20 38 30 34 38 09 23 20 4f l -port 8048.# O
03f0: 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 72 r choose another
0400: 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 0a port number..#.
0410: 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 6e 65 # If the machine
0420: 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 6e 67 you are running
0430: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0440: 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 72 61 er on has severa
0450: 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 63 65 l IP.# interface
0460: 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f 6f 73 s, you can choos
0470: 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 61 63 e which interfac
0480: 65 20 74 68 65 20 73 65 72 76 65 72 20 6c 69 73 e the server lis
0490: 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 63 6f tens on for.# co
04a0: 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 70 65 nnections by spe
04b0: 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 64 64 cifying the -add
04c0: 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e ress command lin
04d0: 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 0a 23 20 e flag, so:.#.#
04e0: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
04f0: 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 73 73 20 te.tcl -address
0500: 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d your.machine.com
0510: 0a 23 0a 23 20 54 68 65 73 65 20 6f 70 74 69 6f .#.# These optio
0520: 6e 73 20 63 61 6e 20 61 6c 73 6f 20 62 65 20 73 ns can also be s
0530: 65 74 20 62 79 20 65 6e 76 69 72 6f 6e 6d 65 6e et by environmen
0540: 74 20 76 61 72 69 61 62 6c 65 73 2e 20 4f 6e 20 t variables. On
0550: 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 0a 23 20 Unix, you can.#
0560: 74 79 70 65 20 74 68 65 73 65 20 63 6f 6d 6d 61 type these comma
0570: 6e 64 73 20 74 6f 20 74 68 65 20 73 68 65 6c 6c nds to the shell
0580: 20 66 72 6f 6d 20 77 68 69 63 68 20 74 68 65 20 from which the
0590: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 73 remote server is
05a0: 20 73 74 61 72 74 65 64 3a 0a 23 0a 23 20 20 20 started:.#.#
05b0: 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 shell% setenv
05c0: 73 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a serverPort 8048.
05d0: 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 # shell% set
05e0: 65 6e 76 20 73 65 72 76 65 72 41 64 64 72 65 73 env serverAddres
05f0: 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 s your.machine.c
0600: 6f 6d 0a 23 0a 23 20 61 6e 64 20 73 75 62 73 65 om.#.# and subse
0610: 71 75 65 6e 74 6c 79 20 79 6f 75 20 63 61 6e 20 quently you can
0620: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0630: 20 73 65 72 76 65 72 20 77 69 74 68 3a 0a 23 0a server with:.#.
0640: 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 # tcltest re
0650: 6d 6f 74 65 2e 74 63 6c 0a 23 0a 23 20 74 6f 20 mote.tcl.#.# to
0660: 68 61 76 65 20 69 74 20 6c 69 73 74 65 6e 20 6f have it listen o
0670: 6e 20 70 6f 72 74 20 38 30 34 38 20 6f 6e 20 74 n port 8048 on t
0680: 68 65 20 69 6e 74 65 72 66 61 63 65 20 79 6f 75 he interface you
0690: 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 r.machine.com..#
06a0: 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 76 .# When the serv
06b0: 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 72 er starts, it pr
06c0: 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 69 ints out a detai
06d0: 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 led message cont
06e0: 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e aining its.# con
06f0: 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 figuration infor
0700: 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 mation, and it w
0710: 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 ill block until
0720: 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 74 killed with a Ct
0730: 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 rl-C..# Once the
0740: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 65 remote server e
0750: 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 xists, you can r
0760: 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e 20 un the tests in
0770: 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 68 socket.test with
0780: 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 62 79 .# the server by
0790: 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 6c setting two Tcl
07a0: 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 0a 23 20 variables:.#.#
07b0: 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 % set remote
07c0: 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f ServerIP <name o
07d0: 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 r address of mac
07e0: 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 hine on which se
07f0: 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 rver runs>.#
0800: 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 % set remoteSer
0810: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 0a 23 verPort 8048.#.#
0820: 20 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 These variables
0830: 20 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 are also settab
0840: 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 le from the envi
0850: 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 ronment. On Unix
0860: 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 0a 23 20 20 , you can:.#.#
0870: 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 shell% setenv
0880: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0890: 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 machine.where.se
08a0: 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 rver.runs.#
08b0: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 shell% setenv re
08c0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 38 moteServerPort 8
08d0: 30 34 38 0a 23 0a 23 20 54 68 65 20 70 72 65 61 048.#.# The prea
08e0: 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 6b mble of the sock
08f0: 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 65 et.test file che
0900: 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 68 cks to see if th
0910: 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 e variables are
0920: 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e 20 set.# either in
0930: 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 6e Tcl or in the en
0940: 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 68 vironment; if th
0950: 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 6d ey are, it attem
0960: 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 pts to connect t
0970: 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e 20 o.# the server.
0980: 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f If the connectio
0990: 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c n is successful,
09a0: 20 74 68 65 20 74 65 73 74 73 20 75 73 69 6e 67 the tests using
09b0: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
09c0: 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 72 rver will be per
09d0: 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 73 formed; otherwis
09e0: 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 6d e, it will attem
09f0: 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 pt to start the
0a00: 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 remote.# server
0a10: 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 6c (via exec) on pl
0a20: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 atforms that sup
0a30: 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 68 port this, on th
0a40: 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 20 e local host,.#
0a50: 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f 72 listening at por
0a60: 74 20 38 30 34 38 2e 20 49 66 20 61 6c 6c 20 66 t 8048. If all f
0a70: 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 20 ails, a message
0a80: 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 74 is printed and t
0a90: 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e 67 he tests.# using
0aa0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0ab0: 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 6f er are not perfo
0ac0: 72 6d 65 64 2e 0a 0a 70 72 6f 63 20 64 70 75 74 rmed...proc dput
0ad0: 73 20 7b 6d 73 67 7d 20 7b 20 72 65 74 75 72 6e s {msg} { return
0ae0: 20 3b 20 70 75 74 73 20 73 74 64 65 72 72 20 24 ; puts stderr $
0af0: 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 74 64 65 msg ; flush stde
0b00: 72 72 20 7d 0a 0a 69 66 20 7b 5b 6c 73 65 61 72 rr }..if {[lsear
0b10: 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 68 ch [namespace ch
0b20: 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 73 ildren] ::tcltes
0b30: 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 t] == -1} {.
0b40: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0b50: 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d 65 tcltest. name
0b60: 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 6f space import -fo
0b70: 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 2a rce ::tcltest::*
0b80: 0a 7d 0a 0a 23 20 54 68 65 20 62 75 69 6c 64 20 .}..# The build
0b90: 64 69 72 20 69 73 20 61 64 64 65 64 20 61 73 20 dir is added as
0ba0: 74 68 65 20 66 69 72 73 74 20 65 6c 65 6d 65 6e the first elemen
0bb0: 74 20 6f 66 20 24 50 41 54 48 0a 23 20 4c 6f 61 t of $PATH.# Loa
0bc0: 64 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 d the tls packag
0bd0: 65 0a 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 e.package prefer
0be0: 20 6c 61 74 65 73 74 0a 70 61 63 6b 61 67 65 20 latest.package
0bf0: 72 65 71 75 69 72 65 20 74 6c 73 0a 0a 73 65 74 require tls..set
0c00: 20 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 38 tlsServerPort 8
0c10: 30 34 38 0a 0a 23 20 53 70 65 63 69 66 79 20 77 048..# Specify w
0c20: 68 65 72 65 20 74 68 65 20 63 65 72 74 69 66 69 here the certifi
0c30: 63 61 74 65 73 20 61 72 65 0a 0a 73 65 74 20 63 cates are..set c
0c40: 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f ertsDir.[file jo
0c50: 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 in [file dirname
0c60: 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 [info script]]
0c70: 63 65 72 74 73 5d 0a 73 65 74 20 73 65 72 76 65 certs].set serve
0c80: 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e rCert.[file join
0c90: 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 65 $certsDir serve
0ca0: 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e r.pem].set clien
0cb0: 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e tCert.[file join
0cc0: 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e $certsDir clien
0cd0: 74 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 t.pem].set caCer
0ce0: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
0cf0: 72 74 73 44 69 72 20 63 61 2e 70 65 6d 5d 0a 73 rtsDir ca.pem].s
0d00: 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 et serverKey.[fi
0d10: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
0d20: 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a 73 65 r server.key].se
0d30: 74 20 63 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c t clientKey.[fil
0d40: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0d50: 20 63 6c 69 65 6e 74 2e 6b 65 79 5d 0a 0a 23 20 client.key]..#
0d60: 53 6f 6d 65 20 74 65 73 74 73 20 72 65 71 75 69 Some tests requi
0d70: 72 65 20 74 68 65 20 74 65 73 74 74 68 72 65 61 re the testthrea
0d80: 64 20 61 6e 64 20 65 78 65 63 20 63 6f 6d 6d 61 d and exec comma
0d90: 6e 64 73 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 nds..set ::tclte
0da0: 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 st::testConstrai
0db0: 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 29 20 nts(testthread)
0dc0: 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 \..[expr {[info
0dd0: 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 commands testthr
0de0: 65 61 64 5d 20 6e 65 20 7b 7d 7d 5d 0a 73 65 74 ead] ne {}}].set
0df0: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
0e00: 43 6f 6e 73 74 72 61 69 6e 74 73 28 65 78 65 63 Constraints(exec
0e10: 29 20 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 ) [expr {[info c
0e20: 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 6e 65 ommands exec] ne
0e30: 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 72 65 {}}]..#.# If re
0e40: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6f 72 20 moteServerIP or
0e50: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0e60: 20 61 72 65 20 6e 6f 74 20 73 65 74 2c 20 63 68 are not set, ch
0e70: 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 65 6e 76 eck in the.# env
0e80: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
0e90: 65 73 20 66 6f 72 20 65 78 74 65 72 6e 61 6c 6c es for externall
0ea0: 79 20 73 65 74 20 76 61 6c 75 65 73 2e 0a 23 0a y set values..#.
0eb0: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0ec0: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ts remoteServerI
0ed0: 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 P]} {. if {[i
0ee0: 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 nfo exists env(r
0ef0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d emoteServerIP)]}
0f00: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0f10: 72 76 65 72 49 50 20 24 65 6e 76 28 72 65 6d 6f rverIP $env(remo
0f20: 74 65 53 65 72 76 65 72 49 50 29 0a 20 20 20 20 teServerIP).
0f30: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
0f40: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0f50: 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 erPort]} {. i
0f60: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0f70: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0f80: 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 74 20 72 Port)]} {..set r
0f90: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0fa0: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
0fb0: 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 65 6c 73 rPort). } els
0fc0: 65 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 e {..if {[info e
0fd0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0fe0: 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 erIP]} {.. se
0ff0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
1000: 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 rt $tlsServerPor
1010: 74 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 t..}. }.}..pr
1020: 6f 63 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 oc do_handshake
1030: 7b 73 20 7b 74 79 70 65 20 72 65 61 64 61 62 6c {s {type readabl
1040: 65 7d 20 7b 63 6d 64 20 7b 7d 7d 20 61 72 67 73 e} {cmd {}} args
1050: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 65 6f 66 } {. if {[eof
1060: 20 24 73 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 $s]} {..close $
1070: 73 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 s..dputs "handsh
1080: 61 6b 65 3a 20 65 6f 66 22 0a 09 73 65 74 20 3a ake: eof"..set :
1090: 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 22 65 :do_handshake "e
10a0: 6f 66 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 of". } elseif
10b0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 {[catch {tls::h
10c0: 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 andshake $s} res
10d0: 75 6c 74 5d 7d 20 7b 0a 09 23 20 53 6f 6d 65 20 ult]} {..# Some
10e0: 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 errors are norma
10f0: 6c 2e 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 l...dputs "hands
1100: 68 61 6b 65 3a 20 24 72 65 73 75 6c 74 22 0a 20 hake: $result".
1110: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 } elseif {$re
1120: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 23 20 sult == 1} {..#
1130: 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 Handshake comple
1140: 74 65 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 te..if {[llength
1150: 20 24 61 72 67 73 5d 7d 20 7b 20 65 76 61 6c 20 $args]} { eval
1160: 5b 6c 69 73 74 20 66 63 6f 6e 66 69 67 75 72 65 [list fconfigure
1170: 20 24 73 5d 20 24 61 72 67 73 20 7d 0a 09 69 66 $s] $args }..if
1180: 20 7b 24 63 6d 64 20 65 71 20 22 22 7d 20 7b 0a {$cmd eq ""} {.
1190: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
11a0: 73 20 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c s $type ""..} el
11b0: 73 65 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 se {.. fileev
11c0: 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 24 63 ent $s $type "$c
11d0: 6d 64 20 5b 6c 69 73 74 20 24 73 5d 22 0a 09 7d md [list $s]"..}
11e0: 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 ..dputs "handsha
11f0: 6b 65 3a 20 63 6f 6d 70 6c 65 74 65 22 0a 09 73 ke: complete"..s
1200: 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b et ::do_handshak
1210: 65 20 22 63 6f 6d 70 6c 65 74 65 22 0a 20 20 20 e "complete".
1220: 20 7d 20 65 6c 73 65 20 7b 0a 09 64 70 75 74 73 } else {..dputs
1230: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 69 6e 20 "handshake: in
1240: 70 72 6f 67 72 65 73 73 22 0a 20 20 20 20 7d 0a progress". }.
1250: 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 69 66 20 }..#.# Check if
1260: 77 65 27 72 65 20 73 75 70 70 6f 73 65 64 20 74 we're supposed t
1270: 6f 20 64 6f 20 74 65 73 74 73 20 61 67 61 69 6e o do tests again
1280: 73 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 st the remote se
1290: 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 6f 54 65 rver.#..set doTe
12a0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
12b0: 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f ver 1.if {![info
12c0: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
12d0: 72 76 65 72 49 50 5d 20 26 26 20 28 24 74 63 6c rverIP] && ($tcl
12e0: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
12f0: 72 6d 29 20 6e 65 20 22 6d 61 63 69 6e 74 6f 73 rm) ne "macintos
1300: 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 h")} {. set r
1310: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
1320: 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 7.0.0.1.}.if {($
1330: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1340: 65 53 65 72 76 65 72 20 3d 3d 20 31 29 20 26 26 eServer == 1) &&
1350: 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 (![info exists
1360: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1370: 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 ])} {. set re
1380: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 moteServerPort $
1390: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a 7d 0a tlsServerPort.}.
13a0: 0a 23 20 41 74 74 65 6d 70 74 20 74 6f 20 63 6f .# Attempt to co
13b0: 6e 6e 65 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 nnect to a remot
13c0: 65 20 73 65 72 76 65 72 20 69 66 20 6f 6e 65 20 e server if one
13d0: 69 73 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 is already runni
13e0: 6e 67 2e 20 49 66 20 69 74 0a 23 20 69 73 20 6e ng. If it.# is n
13f0: 6f 74 20 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f ot running or fo
1400: 72 20 73 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 r some other rea
1410: 73 6f 6e 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 son the connect
1420: 66 61 69 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 fails, attempt t
1430: 6f 0a 23 20 73 74 61 72 74 20 74 68 65 20 72 65 o.# start the re
1440: 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 74 mote server on t
1450: 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 he local host li
1460: 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 stening on port
1470: 38 30 34 38 2e 20 54 68 69 73 0a 23 20 69 73 20 8048. This.# is
1480: 6f 6e 6c 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 only done on pla
1490: 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 tforms that supp
14a0: 6f 72 74 20 65 78 65 63 20 28 69 2e 65 2e 20 6e ort exec (i.e. n
14b0: 6f 74 20 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 ot on the Mac).
14c0: 4f 6e 0a 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 On.# platforms t
14d0: 68 61 74 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f hat do not suppo
14e0: 72 74 20 65 78 65 63 2c 20 74 68 65 20 72 65 6d rt exec, the rem
14f0: 6f 74 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 ote server must
1500: 62 65 20 73 74 61 72 74 65 64 0a 23 20 62 79 20 be started.# by
1510: 74 68 65 20 75 73 65 72 20 62 65 66 6f 72 65 20 the user before
1520: 72 75 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 running the test
1530: 73 2e 0a 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 s...set remotePr
1540: 6f 63 43 68 61 6e 20 22 22 0a 73 65 74 20 63 6f ocChan "".set co
1550: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 mmandSocket "".i
1560: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
1570: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
1580: 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 catch {close
1590: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a $commandSocket}.
15a0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
15b0: 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 set commandSocke
15c0: 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d t [tls::socket -
15d0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
15e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
15f0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
1600: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
1610: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
1620: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
1630: 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 P $remoteServerP
1640: 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 ort]}] != 0} {..
1650: 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e if {[info comman
1660: 64 73 20 65 78 65 63 5d 20 65 71 20 22 22 7d 20 ds exec] eq ""}
1670: 7b 0a 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d {.. set noRem
1680: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 oteTestReason "c
1690: 61 6e 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 an't exec"..
16a0: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
16b0: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d emoteServer 0..}
16c0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
16d0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
16e0: 31 32 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 127.0.0.1.. s
16f0: 65 74 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 et remoteFile [f
1700: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 ile join [pwd] r
1710: 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 emote.tcl]..
1720: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
1730: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c remoteProcChan \
1740: 0a 09 09 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b ... [open "|[
1750: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
1760: 3a 74 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 :tcltest $remote
1770: 46 69 6c 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 File \... -se
1780: 72 76 65 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f rverIsSilent -po
1790: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
17a0: 50 6f 72 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 Port \... -ad
17b0: 64 72 65 73 73 20 24 72 65 6d 6f 74 65 53 65 72 dress $remoteSer
17c0: 76 65 72 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 verIP]" w+]} msg
17d0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 ] == 0} {...afte
17e0: 72 20 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 r 1000...if {[ca
17f0: 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 tch {set command
1800: 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 Socket [tls::soc
1810: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
1820: 0a 09 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 ....-cafile $caC
1830: 65 72 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ert -certfile $c
1840: 6c 69 65 6e 74 43 65 72 74 20 2d 6b 65 79 66 69 lientCert -keyfi
1850: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
1860: 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 ...$remoteServer
1870: 49 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 IP $remoteServer
1880: 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 Port]} msg] == 0
1890: 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 69 } {... fconfi
18a0: 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gure $commandSoc
18b0: 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ket -translation
18c0: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
18d0: 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 7b line...} else {
18e0: 0a 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d ... set noRem
18f0: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 6d oteTestReason $m
1900: 73 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f 54 sg... set doT
1910: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1920: 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 20 rver 0...}..
1930: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 6e } else {...set n
1940: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
1950: 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 65 n "$msg $::tclte
1960: 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 73 st::tcltest"...s
1970: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1980: 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 20 moteServer 0..
1990: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 }..}. } els
19a0: 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 e {..fconfigure
19b0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d $commandSocket -
19c0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
19d0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
19e0: 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 . }.}..# Some
19f0: 20 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 6f tests are run o
1a00: 6e 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 6f nly if we are do
1a10: 69 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 69 ing testing agai
1a20: 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 72 nst a remote ser
1a30: 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 65 ver..set ::tclte
1a40: 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 st::testConstrai
1a50: 6e 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 52 nts(doTestsWithR
1a60: 65 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 6f emoteServer) $do
1a70: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1a80: 65 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 73 erver.if {$doTes
1a90: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1aa0: 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 69 er == 0} {. i
1ab0: 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 f {[string first
1ac0: 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 s $::tcltest::v
1ad0: 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 7b erbose] != -1} {
1ae0: 0a 09 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 ..puts "Skipping
1af0: 20 74 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f tests with remo
1b00: 74 65 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 te server. See t
1b10: 65 73 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 ests/socket.test
1b20: 20 66 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 for"..puts "inf
1b30: 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 ormation on how
1b40: 74 6f 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 to run remote se
1b50: 72 76 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 rver."..puts "Re
1b60: 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 ason for not doi
1b70: 6e 67 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a ng remote tests:
1b80: 20 24 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 $noRemoteTestRe
1b90: 61 73 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 ason". }.}..#
1ba0: 0a 23 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 .# If we do the
1bb0: 74 65 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 tests, define a
1bc0: 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 command to send
1bd0: 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 a command to the
1be0: 0a 23 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 .# remote server
1bf0: 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 ..#..if {$doTest
1c00: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1c10: 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 r == 1} {. pr
1c20: 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b oc sendCommand {
1c30: 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d c} {..global com
1c40: 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 mandSocket...if
1c50: 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f {[eof $commandSo
1c60: 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 cket]} {.. er
1c70: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
1c80: 65 72 20 64 69 73 61 70 70 65 61 72 65 64 22 0a er disappeared".
1c90: 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 .}...if {[catch
1ca0: 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f {puts $commandSo
1cb0: 63 6b 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b cket $c} msg]} {
1cc0: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d .. error "rem
1cd0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1ce0: 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d peared: $msg"..}
1cf0: 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 ..if {[catch {pu
1d00: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1d10: 74 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 t "--Marker--Mar
1d20: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 ker--Marker--"}
1d30: 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 msg]} {.. err
1d40: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1d50: 72 20 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 r disappeared: $
1d60: 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 msg"..}...set re
1d70: 73 70 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d sp ""..while {1}
1d80: 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 {.. set line
1d90: 20 5b 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 [gets $commandS
1da0: 6f 63 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b ocket].. if {
1db0: 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 [eof $commandSoc
1dc0: 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 ket]} {...error
1dd0: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1de0: 69 73 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 isappeared"..
1df0: 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6c 69 6e }.. if {$lin
1e00: 65 20 65 71 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d e eq "--Marker--
1e10: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1e20: 22 7d 20 7b 0a 09 09 69 66 20 7b 5b 6c 69 6e 64 "} {...if {[lind
1e30: 65 78 20 24 72 65 73 70 20 30 5d 20 65 71 20 22 ex $resp 0] eq "
1e40: 65 72 72 6f 72 22 7d 20 7b 0a 09 09 20 20 20 20 error"} {...
1e50: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1e60: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1e70: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1e80: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1e90: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1ea0: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1eb0: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1ec0: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 }..}. }..
1ed0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c 69 73 sendCommand [lis
1ee0: 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b 69 6e t proc dputs [in
1ef0: 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d 20 5b fo args dputs] [
1f00: 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74 73 5d info body dputs]
1f10: 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 ].. proc send
1f20: 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20 7b 0a CertValues {} {.
1f30: 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20 62 65 .# We need to be
1f40: 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20 63 65 able to send ce
1f50: 72 74 69 66 69 63 61 74 65 20 76 61 6c 75 65 73 rtificate values
1f60: 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a 65 0a that normalize.
1f70: 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61 63 72 .# filenames acr
1f80: 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a 09 73 oss platforms..s
1f90: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
1fa0: 20 20 73 65 74 20 63 65 72 74 73 44 69 72 09 5b set certsDir.[
1fb0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
1fc0: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 dirname [info sc
1fd0: 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a 09 20 ript]] certs]..
1fe0: 20 20 20 73 65 74 20 73 65 72 76 65 72 43 65 72 set serverCer
1ff0: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
2000: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 rtsDir server.pe
2010: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 m].. set clie
2020: 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 ntCert.[file joi
2030: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 n $certsDir clie
2040: 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 nt.pem].. set
2050: 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65 20 6a caCert..[file j
2060: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 oin $certsDir ca
2070: 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 cert.pem].. s
2080: 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 et serverKey.[fi
2090: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
20a0: 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a 09 20 r server.key]..
20b0: 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 set clientKey
20c0: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 .[file join $cer
20d0: 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 tsDir client.key
20e0: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 ]..}. }.}..te
20f0: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 st tlsIO-1.1 {ar
2100: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2110: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2120: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2130: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2140: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
2150: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2160: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2170: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2180: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
2190: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
21a0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
21b0: 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 O-1.2 {arg parsi
21c0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
21d0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
21e0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
21f0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2200: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
2210: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2220: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2230: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2240: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2250: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
2260: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2270: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
2280: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2290: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
22a0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
22b0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
22c0: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
22d0: 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22 20 6f {1 {"-myaddr" o
22e0: 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20 66 6f ption must be fo
22f0: 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75 65 7d llowed by value}
2300: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2310: 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 4 {arg parsing f
2320: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2330: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2340: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2350: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 ls::socket -myad
2360: 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 dr 127.0.0.1} ms
2370: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2380: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2390: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
23a0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
23b0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
23c0: 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 tlsIO-1.5 {arg p
23d0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
23e0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
23f0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2400: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2410: 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d et -myport} msg]
2420: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d 6d 79 $msg.} {1 {"-my
2430: 70 6f 72 74 22 20 6f 70 74 69 6f 6e 20 6d 75 73 port" option mus
2440: 74 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 t be followed by
2450: 20 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 20 74 value}}..test t
2460: 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 lsIO-1.6 {arg pa
2470: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2480: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2490: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
24a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
24b0: 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 t -myport xxxx}
24c0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
24d0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
24e0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
24f0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2500: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2510: 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 t tlsIO-1.7 {arg
2520: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2530: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2540: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2550: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2560: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 cket -myport 252
2570: 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 2} msg] $msg.} {
2580: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2590: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
25a0: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
25b0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
25c0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b test tlsIO-1.8 {
25d0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
25e0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
25f0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
2600: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
2610: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2620: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 ls::socket -frob
2630: 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 oz} msg] $msg.}
2640: 2d 6d 61 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 -match glob -res
2650: 75 6c 74 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 ult {1 {bad opti
2660: 6f 6e 20 22 2d 66 72 6f 62 6f 7a 22 3a 20 6d 75 on "-froboz": mu
2670: 73 74 20 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d st be one of *}}
2680: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 ..test tlsIO-1.9
2690: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
26a0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
26b0: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
26c0: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
26d0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
26e0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
26f0: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2700: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
2710: 20 24 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 $msg.} -match g
2720: 6c 6f 62 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b lob -result {1 {
2730: 62 61 64 20 6f 70 74 69 6f 6e 20 22 2d 6d 79 70 bad option "-myp
2740: 6f 72 74 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e ort": must be on
2750: 65 20 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 e of *}}..test t
2760: 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 lsIO-1.10 {arg p
2770: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2780: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2790: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
27a0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
27b0: 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 et host 2528 -ju
27c0: 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 nk} msg] $msg.}
27d0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
27e0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
27f0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2800: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2810: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 .test tlsIO-1.11
2820: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2830: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2840: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2850: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2860: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2870: 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 r callback 2520
2880: 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 --} msg] $msg.}
2890: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
28a0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
28b0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
28c0: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
28d0: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
28e0: 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 tlsIO-1.12 {arg
28f0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2900: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2910: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2920: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2930: 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 cket foo badport
2940: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2950: 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 {expected integ
2960: 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 er but got "badp
2970: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
2980: 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e IO-2.1 {tcp conn
2990: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
29a0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
29b0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
29c0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
29d0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
29e0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
29f0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
2a00: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
2a10: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
2a20: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
2a30: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2a40: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2a50: 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 2000 [list set
2a60: 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 x timed_out]].
2a70: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
2a80: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
2a90: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
2aa0: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d ept -require 0 -
2ab0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2ac0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2ad0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2ae0: 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d erverKey 8828 \]
2af0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
2b00: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
2b10: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
2b20: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
2b30: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 20 set x done..
2b40: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
2b50: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
2b60: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
2b70: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
2b80: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
2b90: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2ba0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2bb0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2bc0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2bd0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2be0: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2bf0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2c00: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
2c10: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2c20: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2c30: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2c40: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
2c50: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 msg]} {..set x
2c60: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
2c70: 7b 0a 09 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 {..lappend x [ge
2c80: 74 73 20 24 66 5d 0a 09 63 6c 6f 73 65 20 24 6d ts $f]..close $m
2c90: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
2ca0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
2cb0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2cc0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
2cd0: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 done {}}..if [i
2ce0: 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d nfo exists port]
2cf0: 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 {. incr port
2d00: 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 .} else {. se
2d10: 74 20 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 t port [expr {$t
2d20: 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b lsServerPort + [
2d30: 70 69 64 5d 25 31 30 32 34 7d 5d 0a 7d 0a 0a 74 pid]%1024}].}..t
2d40: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 est tlsIO-2.2 {t
2d50: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
2d60: 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 th client port s
2d70: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
2d80: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2d90: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2da0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2db0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2dc0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
2dd0: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
2de0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
2df0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 $f {..package pr
2e00: 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 efer latest..pac
2e10: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2e20: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2e30: 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 er 2000 [list se
2e40: 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d t x done]]. }
2e50: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2e60: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2e70: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2e80: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 -require 0 -cer
2e90: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
2ea0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
2eb0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
2ec0: 65 72 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 erKey 8829 \]".
2ed0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
2ee0: 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc accept {sock
2ef0: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 addr port} {..
2f00: 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 global x..
2f10: 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 puts "[gets $soc
2f20: 6b 5d 20 24 70 6f 72 74 22 0a 09 20 20 20 20 63 k] $port".. c
2f30: 6c 6f 73 65 20 24 73 6f 63 6b 0a 09 20 20 20 20 lose $sock..
2f40: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
2f50: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
2f60: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
2f70: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
2f80: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
2f90: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
2fa0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
2fb0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
2fc0: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
2fd0: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 gets $f x. g
2fe0: 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 lobal port. i
2ff0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3000: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 socket -myport $
3010: 70 6f 72 74 20 2d 72 65 71 75 69 72 65 20 30 20 port -require 0
3020: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
3030: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3040: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3050: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
3060: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 7d 20 127.0.0.1 8829}
3070: 73 6f 63 6b 5d 7d 20 7b 0a 09 73 65 74 20 78 20 sock]} {..set x
3080: 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 6c $sock..catch {cl
3090: 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ose [tls::socket
30a0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 127.0.0.1 8829]
30b0: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 }. } else {..
30c0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
30d0: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 09 6c ..flush $sock..l
30e0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
30f0: 66 5d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a f]..close $sock.
3100: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3110: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b $f. set x.} [
3120: 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c list ready "hell
3130: 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 o $port"]..test
3140: 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 tlsIO-2.3 {tcp c
3150: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
3160: 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 lient interface
3170: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
3180: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
3190: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
31a0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
31b0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
31c0: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
31d0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
31e0: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
31f0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 $f {..package p
3200: 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 refer latest..pa
3210: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3220: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3230: 74 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 ter 2000 [list s
3240: 65 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 et x done]].
3250: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3260: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3270: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3280: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
3290: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
32a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
32b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
32c0: 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a verKey 8830 \]".
32d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
32e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
32f0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
3300: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
3310: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
3320: 63 6b 5d 20 24 61 64 64 72 22 0a 09 20 20 20 20 ck] $addr"..
3330: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 09 20 20 20 close $sock..
3340: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
3350: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3360: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3370: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3380: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
3390: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
33a0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
33b0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
33c0: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
33d0: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
33e0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
33f0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
3400: 31 32 37 2e 30 2e 30 2e 31 20 2d 72 65 71 75 69 127.0.0.1 -requi
3410: 72 65 20 30 20 5c 0a 09 2d 63 65 72 74 66 69 6c re 0 \..-certfil
3420: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3430: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3440: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3450: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
3460: 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 09 73 830} sock]} {..s
3470: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
3480: 20 65 6c 73 65 20 7b 0a 09 70 75 74 73 20 24 73 else {..puts $s
3490: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 ock hello..catch
34a0: 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 09 {flush $sock}..
34b0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
34c0: 24 66 5d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b $f]..close $sock
34d0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
34e0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
34f0: 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 {ready {hello 12
3500: 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 7.0.0.1}}..test
3510: 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 tlsIO-2.4 {tcp c
3520: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 73 onnection with s
3530: 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 20 erver interface
3540: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
3550: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
3560: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
3570: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
3580: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
3590: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
35a0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
35b0: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
35c0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 $f {..package p
35d0: 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 refer latest..pa
35e0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
35f0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3600: 74 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 ter 2000 [list s
3610: 65 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 et x done]].
3620: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3630: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3640: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3650: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
3660: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3670: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3680: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3690: 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 6c verKey -myaddr l
36a0: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 20 5c 5d ocalhost 8831 \]
36b0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
36c0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
36d0: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
36e0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
36f0: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3700: 73 6f 63 6b 5d 22 0a 09 20 20 20 20 63 6c 6f 73 sock]".. clos
3710: 65 20 24 73 6f 63 6b 0a 09 20 20 20 20 73 65 74 e $sock.. set
3720: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
3730: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3740: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3750: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3760: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3770: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3780: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3790: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
37a0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
37b0: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
37c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
37d0: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d ket -require 0 -
37e0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
37f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3800: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3810: 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 $clientKey loca
3820: 6c 68 6f 73 74 20 38 38 33 31 7d 20 73 6f 63 6b lhost 8831} sock
3830: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 73 6f 63 ]} {..set x $soc
3840: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 k. } else {..
3850: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
3860: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 09 6c ..flush $sock..l
3870: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3880: 66 5d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a f]..close $sock.
3890: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
38a0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
38b0: 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 ready hello}..te
38c0: 73 74 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 st tlsIO-2.5 {tc
38d0: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
38e0: 68 20 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 h redundant serv
38f0: 65 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 er port} {socket
3900: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3910: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3920: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3930: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3940: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
3950: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
3960: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
3970: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 f {..package pre
3980: 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b fer latest..pack
3990: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
39a0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
39b0: 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 r 2000 [list set
39c0: 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a x done]]. }.
39d0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
39e0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
39f0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3a00: 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 -require 0 -cert
3a10: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3a20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3a30: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3a40: 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 rKey 8832 \]".
3a50: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3a60: 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 c accept {sock a
3a70: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 ddr port} {..
3a80: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 70 global x.. p
3a90: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3aa0: 5d 22 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ]".. close $s
3ab0: 6f 63 6b 0a 09 20 20 20 20 73 65 74 20 78 20 64 ock.. set x d
3ac0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3ad0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3ae0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3af0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3b00: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3b10: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3b20: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3b30: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3b40: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3b50: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
3b60: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
3b70: 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 -require 0 -cert
3b80: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3b90: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3ba0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3bb0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3bc0: 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 1 8832} sock]} {
3bd0: 0a 09 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 ..set x $sock.
3be0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 70 75 74 73 } else {..puts
3bf0: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
3c00: 75 73 68 20 24 73 6f 63 6b 0a 09 6c 61 70 70 65 ush $sock..lappe
3c10: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 09 nd x [gets $f]..
3c20: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3c30: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3c40: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
3c50: 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 y hello}..test t
3c60: 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f lsIO-2.6 {tcp co
3c70: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
3c80: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 t} {. set sta
3c90: 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 tus ok. if {!
3ca0: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b [catch {set sock
3cb0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 [tls::socket -r
3cc0: 65 71 75 69 72 65 20 30 20 31 32 37 2e 30 2e 30 equire 0 127.0.0
3cd0: 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 .1 8833]}]} {..i
3ce0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 f {![catch {gets
3cf0: 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 $sock}]} {..
3d00: 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b set status brok
3d10: 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f en..}..close $so
3d20: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ck. }. set
3d30: 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 status.} ok..te
3d40: 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 st tlsIO-2.7 {ec
3d50: 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c ho server, one l
3d60: 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ine} {socket std
3d70: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3d80: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3d90: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3da0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3db0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
3dc0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
3dd0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3de0: 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 20 .package prefer
3df0: 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 latest..package
3e00: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
3e10: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3e20: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 64 00 [list set x d
3e30: 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one]]. }.
3e40: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
3e50: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3e60: 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 rver accept -req
3e70: 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 uire 0 -certfile
3e80: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
3e90: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
3ea0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3eb0: 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 8834 \]". pu
3ec0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
3ed0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
3ee0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
3ef0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3f00: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3f10: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3f20: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3f30: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
3f40: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3f50: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
3f60: 73 20 24 73 5d 0a 09 20 20 20 20 20 69 66 20 7b s $s].. if {
3f70: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 20 67 [eof $s]} {... g
3f80: 6c 6f 62 61 6c 20 78 0a 09 09 20 63 6c 6f 73 65 lobal x... close
3f90: 20 24 73 0a 09 09 20 73 65 74 20 78 20 64 6f 6e $s... set x don
3fa0: 65 0a 09 20 20 20 20 20 7d 20 65 6c 73 65 20 7b e.. } else {
3fb0: 0a 09 09 20 70 75 74 73 20 24 73 20 24 6c 0a 09 ... puts $s $l..
3fc0: 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 }..}..puts
3fd0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
3fe0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
3ff0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
4000: 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 uts done. }.
4010: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4020: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4030: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4040: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4050: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
4060: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4070: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
4080: 30 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 0 -certfile $cli
4090: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
40a0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
40b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
40c0: 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 27.0.0.1 8834].
40d0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
40e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
40f0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
4100: 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 . puts $s "he
4110: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
4120: 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 72 20 mnop". after
4130: 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 1000. set x [
4140: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
4150: 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 79 20 se $s. set y
4160: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c [gets $f]. cl
4170: 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 74 20 ose $f. list
4180: 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 $x $y.} {{hello
4190: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
41a0: 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c } done}..test tl
41b0: 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 sIO-2.8 {echo se
41c0: 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 rver, loop 50 ti
41d0: 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e mes, single conn
41e0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
41f0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 stdio} {. set
4200: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4210: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
4220: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
4230: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
4240: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
4250: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
4260: 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 est..package req
4270: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
4280: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
4290: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
42a0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
42b0: 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 require 0 -certf
42c0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
42d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
42e0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
42f0: 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 Key 8835 \]".
4300: 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e puts $f {..fcon
4310: 66 69 67 75 72 65 20 24 66 20 2d 62 6c 6f 63 6b figure $f -block
4320: 69 6e 67 20 31 20 2d 62 75 66 66 65 72 69 6e 67 ing 1 -buffering
4330: 20 6c 69 6e 65 0a 09 70 72 6f 63 20 61 63 63 65 line..proc acce
4340: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
4350: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
4360: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
4370: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
4380: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
4390: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
43a0: 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 line..}..proc e
43b0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 cho {s} {.. g
43c0: 6c 6f 62 61 6c 20 69 0a 09 20 20 20 20 73 65 74 lobal i.. set
43d0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
43e0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
43f0: 7b 0a 09 09 67 6c 6f 62 61 6c 20 78 0a 09 09 63 {...global x...c
4400: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 78 20 lose $s...set x
4410: 64 6f 6e 65 0a 09 20 20 20 20 7d 20 65 6c 73 65 done.. } else
4420: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
4430: 74 68 20 24 6c 5d 20 3e 20 30 7d 20 7b 0a 09 09 th $l] > 0} {...
4440: 69 6e 63 72 20 69 0a 09 09 70 75 74 73 20 24 73 incr i...puts $s
4450: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 73 $l.. }..}..s
4460: 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 61 et i 0..puts rea
4470: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
4480: 66 74 65 72 20 32 30 30 30 30 20 5b 6c 69 73 74 fter 20000 [list
4490: 20 73 65 74 20 78 20 74 69 6d 65 2d 6f 75 74 5d set x time-out]
44a0: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
44b0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
44c0: 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 .close $f..puts
44d0: 22 24 78 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 "$x $i". }.
44e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
44f0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4500: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4510: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4520: 72 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 r]. fconfigur
4530: 65 20 24 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 e $f -blocking 1
4540: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4550: 0a 20 20 20 20 67 65 74 73 20 24 66 20 76 61 72 . gets $f var
4560: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
4570: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
4580: 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 0 -certfile $cl
4590: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
45a0: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
45b0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
45c0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 127.0.0.1 8835].
45d0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
45e0: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 20 2d 62 s -blocking 1 -b
45f0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
4600: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
4610: 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b 0a $s. catch {.
4620: 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b .for {set x 0} {
4630: 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 $x < 50} {incr x
4640: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
4650: 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 "hello abcdefgh
4660: 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 ijklmnop".. g
4670: 65 74 73 20 24 73 20 76 61 72 0a 09 7d 0a 20 20 ets $s var..}.
4680: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
4690: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
46a0: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
46b0: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 catch {close $f
46c0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 }. set x.} {d
46d0: 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c one 50}..test tl
46e0: 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 sIO-2.9 {socket
46f0: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
4700: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
4710: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
4720: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4730: 20 2d 72 65 71 75 69 72 65 20 30 20 38 38 32 38 -require 0 8828
4740: 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 ]. removeFile
4750: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
4760: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
4770: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
4780: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
4790: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
47a0: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
47b0: 65 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 e $f {..package
47c0: 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 prefer latest..p
47d0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
47e0: 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ls..tls::socket
47f0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
4800: 72 65 71 75 69 72 65 20 30 20 38 38 32 38 0a 20 require 0 8828.
4810: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4820: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4830: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
4840: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
4850: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
4860: 74 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 ts $f. after
4870: 31 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 100. set x [l
4880: 69 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 ist [catch {clos
4890: 65 20 24 66 7d 20 6d 73 67 5d 20 5b 73 74 72 69 e $f} msg] [stri
48a0: 6e 67 20 72 61 6e 67 65 20 24 6d 73 67 20 30 20 ng range $msg 0
48b0: 34 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 43]]. close $
48c0: 73 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 s. set x.} {1
48d0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
48e0: 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 socket: address
48f0: 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d already in use}}
4900: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
4910: 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 0 {close on acce
4920: 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 pt, accepted soc
4930: 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b ket lives} {sock
4940: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f et} {. set do
4950: 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d ne 0. set tim
4960: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 er [after 20000
4970: 5b 6c 69 73 74 20 73 65 74 20 64 6f 6e 65 20 74 [list set done t
4980: 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 73 imed_out]]. s
4990: 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b et ss [tls::sock
49a0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
49b0: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
49c0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
49d0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
49e0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
49f0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 5d 0a serverKey 8830].
4a00: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
4a10: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
4a20: 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a l ss..close $ss.
4a30: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
4a40: 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 adable "readit $
4a50: 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 s"..fconfigure $
4a60: 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 s -trans lf.
4a70: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 }. proc readi
4a80: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
4a90: 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 done..gets $s..c
4aa0: 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e lose $s..set don
4ab0: 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 e 1. }. se
4ac0: 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t cs [tls::socke
4ad0: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
4ae0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4af0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4b00: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4b10: 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 clientKey localh
4b20: 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 20 63 6c ost 8830]. cl
4b30: 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 ose $cs.. vwa
4b40: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
4b50: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
4b60: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 set done.} 1
4b70: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
4b80: 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 1 {detecting new
4b90: 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 data} {socket}
4ba0: 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 {. proc accep
4bb0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
4bc0: 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e bal sock..# when
4bd0: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
4be0: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
4bf0: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
4c00: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
4c10: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
4c20: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
4c30: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
4c40: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
4c50: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
4c60: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
4c70: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
4c80: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
4c90: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
4ca0: 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 e..set sock $s..
4cb0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4cc0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
4cd0: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 andshake $s].
4ce0: 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }.. set s [t
4cf0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4d00: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
4d10: 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 re 0 \.. -cer
4d20: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4d30: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4d40: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
4d50: 65 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 20 20 erKey 8400].
4d60: 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 set sock "".
4d70: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
4d80: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d ket -require 0 -
4d90: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4da0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4db0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4dc0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
4dd0: 30 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 0.0.1 8400].
4de0: 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 # when doing an
4df0: 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e in-process clien
4e00: 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 t/server test, b
4e10: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 oth sides need.
4e20: 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 # to be non-b
4e30: 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 locking for the
4e40: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 TLS handshake A
4e50: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f lso make sure to
4e60: 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 . # return th
4e70: 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e e channel to lin
4e80: 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 e buffering mode
4e90: 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f (TLS sets it to
4ea0: 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 'none').. fc
4eb0: 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 6c onfigure $s2 -bl
4ec0: 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 ocking 0 -buffer
4ed0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 ing line. vwa
4ee0: 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 it sock. puts
4ef0: 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 $s2 one. flu
4f00: 73 68 20 24 73 32 0a 20 20 20 20 23 20 6e 65 65 sh $s2. # nee
4f10: 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 d update to comp
4f20: 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 lete TLS handsha
4f30: 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 ke in-process.
4f40: 20 20 75 70 64 61 74 65 0a 20 20 20 20 61 66 74 update. aft
4f50: 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 er 500. fconf
4f60: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4f70: 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 cking 0. set
4f80: 72 65 73 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 result a:[gets $
4f90: 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e sock]. lappen
4fa0: 64 20 72 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 d result b:[gets
4fb0: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e $sock]. fcon
4fc0: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
4fd0: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 ocking 1. put
4fe0: 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c s $s2 two. fl
4ff0: 75 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e ush $s2. fcon
5000: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
5010: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 6c 61 70 ocking 1. lap
5020: 70 65 6e 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 pend result c:[g
5030: 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 ets $sock]. 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 31 0a 20 20 20 20 -blocking 1.
5060: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
5070: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
5080: 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 $sock. set r
5090: 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 20 62 esult.} {a:one b
50a0: 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 73 74 20 74 : c:two}..test t
50b0: 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 lsIO-2.12 {tcp c
50c0: 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 onnection; no ce
50d0: 72 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 rtificates speci
50e0: 66 69 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 fied} \..{socket
50f0: 20 73 74 64 69 6f 20 75 6e 69 78 4f 6e 6c 79 7d stdio unixOnly}
5100: 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 69 {. # There i
5110: 73 20 61 20 64 65 62 75 67 20 61 73 73 65 72 74 s a debug assert
5120: 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 ion on Windows/S
5130: 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 61 SL that causes a
5140: 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 0a crash when the.
5150: 20 20 20 20 23 20 63 65 72 74 69 66 69 63 61 74 # certificat
5160: 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 65 e isn't specifie
5170: 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c d.. removeFil
5180: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5190: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
51a0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
51b0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
51c0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
51d0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
51e0: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
51f0: 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 est..package req
5200: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
5210: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
5220: 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 [list set x time
5230: 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 66 20 5b d_out]]..set f [
5240: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5250: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
5260: 69 72 65 20 30 20 38 38 32 38 5d 0a 09 70 72 6f ire 0 8828]..pro
5270: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
5280: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 ddr port} {..
5290: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
52a0: 65 74 20 78 20 64 6f 6e 65 0a 09 20 20 20 20 63 et x done.. c
52b0: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 lose $file..}..p
52c0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
52d0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
52e0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
52f0: 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d f..puts $x. }
5300: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5310: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
5320: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
5330: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
5340: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
5350: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
5360: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5370: 2d 72 65 71 75 69 72 65 20 30 20 31 32 37 2e 30 -require 0 127.0
5380: 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d .0.1 8828} msg]}
5390: 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 {..set x $msg.
53a0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 6c 61 70 } else {..lap
53b0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
53c0: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
53d0: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
53e0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
53f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5400: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
5410: 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d {}}..test tlsIO-
5420: 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 3.1 {socket conf
5430: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
5440: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
5450: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5460: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5470: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
5480: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
5490: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
54a0: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
54b0: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
54c0: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
54d0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
54e0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
54f0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
5500: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5510: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 pt -require 0 -c
5520: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
5530: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5540: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
5550: 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 rverKey 8828 \]"
5560: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5570: 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 puts ready..gets
5580: 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 stdin..close $f
5590: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
55a0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
55b0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
55c0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
55d0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
55e0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
55f0: 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 x [list [catch
5600: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
5610: 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 rver accept -req
5620: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
5630: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5640: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5650: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5660: 69 65 6e 74 4b 65 79 20 38 38 32 38 7d 20 6d 73 ientKey 8828} ms
5670: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
5680: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
5690: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
56a0: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
56b0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
56c0: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
56d0: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
56e0: 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 lsIO-3.2 {server
56f0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
5700: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
5710: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
5720: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5730: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5740: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5750: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
5760: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
5770: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
5780: 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 {..package prefe
5790: 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 r latest..packag
57a0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
57b0: 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 et t1 [after 300
57c0: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 00 [list set x t
57d0: 69 6d 65 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 imed_out]]..set
57e0: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
57f0: 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 [list set x time
5800: 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 74 33 20 d_out]]..set t3
5810: 5b 61 66 74 65 72 20 33 32 30 30 30 20 5b 6c 69 [after 32000 [li
5820: 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f st set x timed_o
5830: 75 74 5d 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 ut]]..set counte
5840: 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 r 0. }. pu
5850: 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 ts $f "set s \[t
5860: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5870: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
5880: 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 re 0 -certfile $
5890: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
58a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
58b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
58c0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
58d0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
58e0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
58f0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
5900: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
5910: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
5920: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
5930: 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 ring line..}..pr
5940: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
5950: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
5960: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
5970: 73 5d 0a 09 20 20 20 20 20 69 66 20 7b 5b 65 6f s].. if {[eo
5980: 66 20 24 73 5d 7d 20 7b 0a 09 09 20 63 6c 6f 73 f $s]} {... clos
5990: 65 20 24 73 0a 09 09 20 73 65 74 20 78 20 64 6f e $s... set x do
59a0: 6e 65 0a 09 20 20 20 20 20 7d 20 65 6c 73 65 20 ne.. } else
59b0: 7b 0a 09 09 20 70 75 74 73 20 24 73 20 24 6c 0a {... puts $s $l.
59c0: 09 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 . }..}..puts
59d0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
59e0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
59f0: 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 1..vwait x..afte
5a00: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 r cancel $t2..vw
5a10: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5a20: 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 cel $t3..close $
5a30: 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d s..puts $x. }
5a40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5a50: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
5a60: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
5a70: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
5a80: 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 ]" r+]. set x
5a90: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 [gets $f]. s
5aa0: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
5ab0: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
5ac0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5ad0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5ae0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5af0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5b00: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5b10: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
5b20: 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 gure $s1 -buffer
5b30: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5b40: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
5b50: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 -require 0 \..
5b60: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5b70: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5b80: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5b90: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
5ba0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
5bb0: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
5bc0: 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e re $s2 -bufferin
5bd0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
5be0: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 3 [tls::socket -
5bf0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
5c00: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5c10: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5c20: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5c30: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
5c40: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 127.0.0.1 8828
5c50: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
5c60: 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 $s3 -buffering
5c70: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
5c80: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 t i 0} {$i < 100
5c90: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 } {incr i} {..pu
5ca0: 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 ts $s1 hello,tls
5cb0: 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 74 73 20 IO-3.2,s1..gets
5cc0: 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 $s1..puts $s2 he
5cd0: 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 32 llo,tlsIO-3.2,s2
5ce0: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
5cf0: 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s3 hello,tlsIO
5d00: 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 20 24 73 -3.2,s3..gets $s
5d10: 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 3. }. clos
5d20: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
5d30: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
5d40: 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 3. lappend x
5d50: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c [gets $f]. cl
5d60: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
5d70: 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a .} {ready done}.
5d80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 .test tlsIO-4.1
5d90: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
5da0: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
5db0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
5dc0: 20 20 20 23 20 68 61 76 65 20 73 65 65 6e 20 69 # have seen i
5dd0: 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 ntermittent hang
5de0: 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 s on Windows.
5df0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5e00: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5e10: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5e20: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
5e30: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
5e40: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
5e50: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
5e60: 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 prefer latest..p
5e70: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
5e80: 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 ls..gets stdin.
5e90: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
5ea0: 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 "set s \[tls::s
5eb0: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
5ec0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5ed0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5ee0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5ef0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
5f00: 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 .0.1 8828 \]".
5f10: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f puts $f {..fco
5f20: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5f30: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 ering line..for
5f40: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
5f50: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
5f60: 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
5f70: 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a lo.. gets $s.
5f80: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 .}..close $s..pu
5f90: 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 ts bye..gets std
5fa0: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f in. }. clo
5fb0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 se $f. set p1
5fc0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5fd0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5fe0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5ff0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
6000: 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p1 -buffering li
6010: 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f ne. set p2 [o
6020: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6030: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6040: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6050: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 fconfigure $p2
6060: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
6070: 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e set p3 [open
6080: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6090: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
60a0: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
60b0: 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 onfigure $p3 -bu
60c0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
60d0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
60e0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
60f0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
6100: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
6110: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
6120: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
6130: 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 }. proc echo
6140: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a {s} {..global x.
6150: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
6160: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
6170: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
6180: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
6190: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 70 .} else {.. p
61a0: 75 74 73 20 24 73 20 24 6c 0a 09 7d 0a 20 20 20 uts $s $l..}.
61b0: 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 }. set t1 [a
61c0: 66 74 65 72 20 33 30 30 30 30 20 5b 6c 69 73 74 fter 30000 [list
61d0: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
61e0: 5d 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 ]]. set t2 [a
61f0: 66 74 65 72 20 33 31 30 30 30 20 5b 6c 69 73 74 fter 31000 [list
6200: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
6210: 5d 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 ]]. set t3 [a
6220: 66 74 65 72 20 33 32 30 30 30 20 5b 6c 69 73 74 fter 32000 [list
6230: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
6240: 5d 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c ]]. set s [tl
6250: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6260: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
6270: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
6280: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
6290: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
62a0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
62b0: 72 4b 65 79 20 38 38 32 38 5d 0a 20 20 20 20 70 rKey 8828]. p
62c0: 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 uts $p1 open.
62d0: 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 puts $p2 open.
62e0: 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e puts $p3 open
62f0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
6300: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
6310: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
6320: 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 ancel $t1. af
6330: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 ter cancel $t2.
6340: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6350: 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $t3. close $s
6360: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
6370: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
6380: 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 t p1 [gets $p1]
6390: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
63a0: 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 l [list p2 [gets
63b0: 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p2] $x]. la
63c0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 ppend l [list p3
63d0: 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a [gets $p3] $x].
63e0: 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 puts $p1 bye
63f0: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 . puts $p2 by
6400: 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 e. puts $p3 b
6410: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 ye. close $p1
6420: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 . close $p2.
6430: 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 close $p3.
6440: 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 set l.} {{p1 by
6450: 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 e done} {p2 bye
6460: 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f done} {p3 bye do
6470: 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ne}}..test tlsIO
6480: 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -4.2 {byte order
6490: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
64a0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
64b0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
64c0: 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 set x ok. if
64d0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
64e0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
64f0: 64 6f 20 2d 72 65 71 75 69 72 65 20 30 20 30 78 do -require 0 0x
6500: 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 3000} msg]} {..s
6510: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
6520: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
6530: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
6540: 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c x.} ok..test tl
6550: 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 sIO-5.1 {byte or
6560: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
6570: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
6580: 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ons} \..{socket
6590: 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 unixOnly notRoot
65a0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 } {. set x {c
65b0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
65c0: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
65d0: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
65e0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
65f0: 72 76 65 72 20 64 6f 64 6f 20 2d 72 65 71 75 69 rver dodo -requi
6600: 72 65 20 30 20 30 78 31 7d 20 6d 73 67 5d 7d 20 re 0 0x1} msg]}
6610: 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 {..set x {htons
6620: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
6630: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
6640: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
6650: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
6660: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
6670: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
6680: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
6690: 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 owner}.test tlsI
66a0: 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-5.2 {byte orde
66b0: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
66c0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
66d0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
66e0: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
66f0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
6700: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
6710: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
6720: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
6730: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 2d t -server dodo -
6740: 72 65 71 75 69 72 65 20 30 20 30 78 31 30 30 30 require 0 0x1000
6750: 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 0} msg]} {..set
6760: 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 x {port resoluti
6770: 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 on problem, shou
6780: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
6790: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
67a0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
67b0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
67c0: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
67d0: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 er too high}.tes
67e0: 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 t tlsIO-5.3 {byt
67f0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
6800: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
6810: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
6820: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
6830: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
6840: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
6850: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
6860: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
6870: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
6880: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 2d 72 -server dodo -r
6890: 65 71 75 69 72 65 20 30 20 32 31 7d 20 6d 73 67 equire 0 21} msg
68a0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f ]} {..set x {hto
68b0: 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 ns problem, shou
68c0: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
68d0: 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e , are you runnin
68e0: 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 g as SU?}..close
68f0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6900: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
6910: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
6920: 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 ot owner}..test
6930: 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 tlsIO-6.1 {accep
6940: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
6950: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
6960: 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 69 {. # There i
6970: 73 20 61 20 64 65 62 75 67 20 61 73 73 65 72 74 s a debug assert
6980: 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 ion on Windows/S
6990: 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 61 SL that causes a
69a0: 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 0a crash when the.
69b0: 20 20 20 20 23 20 63 65 72 74 69 66 69 63 61 74 # certificat
69c0: 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 65 e isn't specifie
69d0: 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c d.. removeFil
69e0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
69f0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
6a00: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
6a10: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
6a20: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
6a30: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
6a40: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
6a50: 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 est..package req
6a60: 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 uire tls..gets s
6a70: 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 tdin. }. p
6a80: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 uts $f [list tls
6a90: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
6aa0: 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 $caCert 127.0.0
6ab0: 2e 31 20 38 38 34 38 5d 0a 20 20 20 20 63 6c 6f .1 8848]. clo
6ac0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
6ad0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
6ae0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
6af0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
6b00: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
6b10: 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 args {..global x
6b20: 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 ..set x $args.
6b30: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
6b40: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 ept {s a p} {exp
6b50: 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 r 10 / 0}. se
6b60: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
6b70: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6b80: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
6b90: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
6ba0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
6bb0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6bc0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 34 38 $serverKey 8848
6bd0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 ]. puts $f he
6be0: 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 llo. close $f
6bf0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
6c00: 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 after 10000 [lis
6c10: 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 t set x timed_ou
6c20: 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t]]. vwait x.
6c30: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6c40: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
6c50: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
6c60: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
6c70: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
6c80: 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 by zero}}..test
6c90: 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 tlsIO-7.1 {testi
6ca0: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6cb0: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
6cc0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6cd0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6ce0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6cf0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6d00: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
6d10: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
6d20: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
6d30: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
6d40: 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 prefer latest..p
6d50: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
6d60: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
6d70: 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a s $f [list tls::
6d80: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6d90: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
6da0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
6db0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
6dc0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6dd0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6de0: 79 20 38 38 32 30 5d 0a 20 20 20 20 70 75 74 73 y 8820]. puts
6df0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
6e00: 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 pt args {.. g
6e10: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
6e20: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
6e30: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
6e40: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b r [after 10000 [
6e50: 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 list set x timed
6e60: 5f 6f 75 74 5d 5d 0a 09 76 77 61 69 74 20 78 0a _out]]..vwait x.
6e70: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
6e80: 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 imer. }. c
6e90: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6ea0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
6eb0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
6ec0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
6ed0: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
6ee0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
6ef0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
6f00: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
6f10: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6f20: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
6f30: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
6f40: 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 73 .0.1 8820]. s
6f50: 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 et p [fconfigure
6f60: 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 $s -peername].
6f70: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
6f80: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6f90: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6fa0: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
6fb0: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 are [lindex $p 0
6fc0: 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 ] 127.0.0.1].
6fd0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 lappend l [stri
6fe0: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
6ff0: 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 ex $p 2] 8820].
7000: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
7010: 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 ength $p].} {0 0
7020: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
7030: 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.2 {testing soc
7040: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
7050: 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 ions} {socket st
7060: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
7070: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
7080: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
7090: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
70a0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
70b0: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
70c0: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
70d0: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
70e0: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
70f0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
7100: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
7110: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7120: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
7130: 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 ire 0 -certfile
7140: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7150: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7160: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7170: 38 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 8821". puts $
7180: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
7190: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
71a0: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
71b0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
71c0: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
71d0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 [after 10000 [li
71e0: 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f st set x timed_o
71f0: 75 74 5d 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 ut]]..vwait x..a
7200: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
7210: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
7220: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
7230: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
7240: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
7250: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
7260: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
7270: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7280: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
7290: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
72a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
72b0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
72c0: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
72d0: 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 73 65 74 .1 8821]. set
72e0: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
72f0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
7300: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
7310: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c ose $f. set l
7320: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
7330: 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 l [llength $p].
7340: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
7350: 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 20 20 6c ndex $p 0]. l
7360: 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 append l [string
7370: 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 78 20 24 equal [lindex $
7380: 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 7b 33 20 p 2] 8821].} {3
7390: 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 127.0.0.1 0}..te
73a0: 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 65 st tlsIO-7.3 {te
73b0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
73c0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
73d0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
73e0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
73f0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7400: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 63 -require 0 \..-c
7410: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
7420: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7430: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7440: 72 76 65 72 4b 65 79 20 38 38 32 32 5d 0a 20 20 rverKey 8822].
7450: 20 20 73 65 74 20 6c 20 5b 6c 6c 65 6e 67 74 68 set l [llength
7460: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d [fconfigure $s]
7470: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
7480: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 23 20 update. #
7490: 41 20 62 75 67 20 66 69 78 65 64 20 69 6e 20 66 A bug fixed in f
74a0: 63 6f 6e 66 69 67 75 72 65 20 66 6f 72 20 38 2e configure for 8.
74b0: 33 2e 34 2b 20 6d 61 6b 65 20 74 68 69 73 20 72 3.4+ make this r
74c0: 65 74 75 72 6e 20 31 34 20 6e 6f 72 6d 61 6c 6c eturn 14 normall
74d0: 79 2c 0a 20 20 20 20 23 20 62 75 74 20 31 32 20 y,. # but 12
74e0: 69 6e 20 6f 6c 64 65 72 20 76 65 72 73 69 6f 6e in older version
74f0: 73 2e 0a 20 20 20 20 65 78 70 72 20 7b 24 6c 20 s.. expr {$l
7500: 3e 3d 20 31 32 20 26 26 20 28 28 24 6c 20 25 20 >= 12 && (($l %
7510: 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 31 0a 0a 23 2) == 0)}.} 1..#
7520: 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 bug report #581
7530: 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 2 fconfigure doe
7540: 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 sn't return valu
7550: 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 e for '-sockname
7560: 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e '..test tlsIO-7.
7570: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
7580: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
7590: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
75a0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
75b0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
75c0: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
75d0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 \..-certfile $se
75e0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
75f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7600: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
7610: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
7620: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7630: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
7640: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
7650: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
7660: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
7670: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
7680: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
7690: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
76a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
76b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
76c0: 6c 6f 63 61 6c 68 6f 73 74 20 38 38 32 33 5d 0a localhost 8823].
76d0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
76e0: 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 fter 10000 [list
76f0: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
7700: 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 ]]. vwait x.
7710: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
7720: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
7730: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
7740: 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 1. set l "".
7750: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
7760: 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e ndex $x 2] [llen
7770: 67 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 33 20 gth $x].} {8823
7780: 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 3}..# bug report
7790: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
77a0: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
77b0: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
77c0: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
77d0: 49 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 IO-7.5 {testing
77e0: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
77f0: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
7800: 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 unixOrPc} {.
7810: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7820: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7830: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
7840: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7850: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7860: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7870: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
7880: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
7890: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
78a0: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
78b0: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
78c0: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
78d0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
78e0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
78f0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
7900: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7910: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7920: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7930: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
7940: 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 73 65 0.1 8829]. se
7950: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7960: 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 0000 [list set x
7970: 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 timed_out]].
7980: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
7990: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
79a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
79b0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
79c0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
79d0: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
79e0: 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 x 0] [lindex $x
79f0: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 2] [llength $x].
7a00: 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 } {127.0.0.1 882
7a10: 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 9 3}..test tlsIO
7a20: 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 -8.1 {testing -a
7a30: 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 sync flag on soc
7a40: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b kets} {socket} {
7a50: 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 . # NOTE: Thi
7a60: 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 s test may fail
7a70: 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 on some Solaris
7a80: 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 20 2.4 systems..
7a90: 20 23 20 53 65 65 20 6e 6f 74 65 73 20 69 6e 20 # See notes in
7aa0: 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 73 Tcl's socket.tes
7ab0: 74 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c t.. set s [tl
7ac0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
7ad0: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
7ae0: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
7af0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
7b00: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7b10: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7b20: 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 20 70 rKey 8830]. p
7b30: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7b40: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
7b50: 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 # when doing an
7b60: 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e in-process clien
7b70: 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 t/server test, b
7b80: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 oth sides need..
7b90: 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 # to be non-bloc
7ba0: 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 king for the TLS
7bb0: 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 handshake. Als
7bc0: 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 o make sure..# t
7bd0: 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 o return the cha
7be0: 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 nnel to line buf
7bf0: 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 fering mode...fc
7c00: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
7c10: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
7c20: 6e 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 ng line..puts $s
7c30: 20 62 79 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 bye..# Only Ope
7c40: 6e 53 53 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 nSSL 0.9.5a on W
7c50: 69 6e 64 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 indows seems to
7c60: 6e 65 65 64 20 74 68 65 20 61 66 74 65 72 20 28 need the after (
7c70: 64 65 6c 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 delayed)..# clos
7c80: 65 2c 20 62 75 74 20 69 74 20 77 6f 72 6b 73 20 e, but it works
7c90: 6a 75 73 74 20 74 68 65 20 73 61 6d 65 20 66 6f just the same fo
7ca0: 72 20 61 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 r all others. -h
7cb0: 6f 62 62 73 0a 09 61 66 74 65 72 20 35 30 30 20 obbs..after 500
7cc0: 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 close $s..set x
7cd0: 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 done. }. s
7ce0: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
7cf0: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
7d00: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7d10: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7d20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7d30: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7d40: 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 6c 6f 63 .. -async loc
7d50: 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 alhost 8830].
7d60: 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e # when doing an
7d70: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
7d80: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
7d90: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
7da0: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
7db0: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
7dc0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 TLS handshake
7dd0: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 Also make sure t
7de0: 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 o. # return t
7df0: 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 he channel to li
7e00: 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 ne buffering mod
7e10: 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 e (TLS sets it t
7e20: 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 o 'none').. f
7e30: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
7e40: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7e50: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 ring line. vw
7e60: 61 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 ait x. # TLS
7e70: 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 handshaking need
7e80: 73 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 s one byte from
7e90: 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 the client....
7ea0: 20 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 puts $s1 a.
7eb0: 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 # need update t
7ec0: 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 o complete TLS h
7ed0: 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 andshake in-proc
7ee0: 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 ess. update.
7ef0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
7f00: 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 1 -blocking 1.
7f10: 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 set z [gets $s
7f20: 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 1]. close $s.
7f30: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
7f40: 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 0a set z.} bye...
7f50: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b test tlsIO-9.1 {
7f60: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
7f70: 20 28 30 20 62 79 74 65 20 72 65 61 64 29 20 65 (0 byte read) e
7f80: 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 vents} {socket}
7f90: 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a {. set len 0.
7fa0: 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 set spurious
7fb0: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
7fc0: 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 0. proc readl
7fd0: 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f ittle {s} {..glo
7fe0: 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e bal spurious don
7ff0: 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 e len..set l [re
8000: 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 ad $s 1]..if {[s
8010: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
8020: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
8030: 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 {![eof $s]} {..
8040: 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 .incr spurious..
8050: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 } else {...c
8060: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
8070: 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 ne 1.. }..} e
8080: 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 lse {.. incr
8090: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
80a0: 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a th $l]..}. }.
80b0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
80c0: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
80d0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
80e0: 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 ng 0..fileevent
80f0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
8100: 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 t do_handshake $
8110: 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 6c s readable readl
8120: 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 65 ittle \...-buffe
8130: 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d ring none]. }
8140: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
8150: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
8160: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
8170: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
8180: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8190: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
81a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
81b0: 65 79 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 ey 8831]. set
81c0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
81d0: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
81e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
81f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8200: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8210: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8220: 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 localhost 883
8230: 31 5d 0a 20 20 20 20 23 20 54 68 69 73 20 64 69 1]. # This di
8240: 66 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b 65 ffers from socke
8250: 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 62 6f t-9.1 in that bo
8260: 74 68 20 73 69 64 65 73 20 6e 65 65 64 20 74 6f th sides need to
8270: 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 6c be. # non-bl
8280: 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 65 20 6f ocking because o
8290: 66 20 54 4c 53 27 20 72 65 71 75 69 72 65 64 20 f TLS' required
82a0: 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 63 handshake. fc
82b0: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
82c0: 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 73 cking 0. puts
82d0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 -nonewline $c 0
82e0: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
82f0: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
8300: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
8310: 39 0a 20 20 20 20 66 6c 75 73 68 20 24 63 0a 20 9. flush $c.
8320: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
8330: 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 ter 10000 [list
8340: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
8350: 75 74 5d 5d 0a 20 20 20 20 61 66 74 65 72 20 31 ut]]. after 1
8360: 30 30 30 20 5b 6c 69 73 74 20 63 6c 6f 73 65 20 000 [list close
8370: 24 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f $c]. vwait do
8380: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
8390: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
83a0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 0a atch {close $s}.
83b0: 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f list $spurio
83c0: 75 73 20 24 6c 65 6e 0a 7d 20 7b 31 20 35 30 7d us $len.} {1 50}
83d0: 0a 23 20 57 61 73 20 30 20 35 30 0a 0a 74 65 73 .# Was 0 50..tes
83e0: 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 t tlsIO-9.2 {tes
83f0: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
8400: 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c , fileevents, fl
8410: 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 ush on close} {s
8420: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
8430: 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 firstblock [str
8440: 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 5d ing repeat a 31]
8450: 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 . set secondb
8460: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
8470: 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 20 20 eat b 65535].
8480: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
8490: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
84a0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
84b0: 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 0..fileevent $s
84c0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 readable [list d
84d0: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 o_handshake $s r
84e0: 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 6c 65 eadable readable
84f0: 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 69 6f \...-translatio
8500: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
8510: 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 69 6e 16384 -bufferin
8520: 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 g line]. }.
8530: 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 proc readable
8540: 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65 {s} {..set l [ge
8550: 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 22 67 ts $s]..dputs "g
8560: 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 ot \"[string rep
8570: 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 2d 33 lace $l 10 end-3
8580: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
8590: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 29 ring length $l])
85a0: 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c 65 65 from $s"..filee
85b0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
85c0: 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 {}..after 1000
85d0: 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d respond $s. }
85e0: 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e . proc respon
85f0: 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 d {s} {..global
8600: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 75 74 firstblock..dput
8610: 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e s "send \"[strin
8620: 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 73 74 g replace $first
8630: 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e block 10 end-3 .
8640: 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 ..]\" \...([stri
8650: 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 73 74 ng length $first
8660: 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 block]) down $s"
8670: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
8680: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
8690: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
86a0: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
86b0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
86c0: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
86d0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 secondblock..dp
86e0: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
86f0: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 65 63 ing replace $sec
8700: 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d ondblock 10 end-
8710: 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 3 ...]\" \...([s
8720: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 73 65 tring length $se
8730: 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e condblock]) down
8740: 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 $s"..puts -none
8750: 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 wline $s $second
8760: 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a block..close $s.
8770: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
8780: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8790: 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 rver accept -req
87a0: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
87b0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
87c0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
87d0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
87e0: 72 76 65 72 4b 65 79 20 38 38 33 39 5d 0a 20 20 rverKey 8839].
87f0: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
8800: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
8810: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8820: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8830: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8840: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
8850: 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 \.. localhos
8860: 74 20 38 38 33 39 5d 0a 20 20 20 20 66 63 6f 6e t 8839]. fcon
8870: 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b figure $c -block
8880: 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 ing 0 -trans lf
8890: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
88a0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a set count 0.
88b0: 20 20 20 20 70 75 74 73 20 24 63 20 68 65 6c 6c puts $c hell
88c0: 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 o. proc readi
88d0: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
88e0: 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 count done..set
88f0: 64 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 data [read $s]..
8900: 64 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b 73 dputs "read \"[s
8910: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 64 tring replace $d
8920: 61 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e ata 10 end-3 ...
8930: 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 ]\" \...([string
8940: 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 20 length $data])
8950: 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 from $s"..incr c
8960: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
8970: 67 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b gth $data]..if {
8980: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
8990: 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 close $s.. s
89a0: 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 et done 1..}.
89b0: 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 }. fileevent
89c0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $c readable [li
89d0: 73 74 20 72 65 61 64 69 74 20 24 63 5d 0a 20 20 st readit $c].
89e0: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
89f0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
8a00: 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 73 65 r 10000 [list se
8a10: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
8a20: 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e ]]. vwait don
8a30: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
8a40: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 61 el $timer. ca
8a50: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 0a 20 tch {close $c}.
8a60: 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 catch {close
8a70: 24 73 7d 0a 20 20 20 20 6c 69 73 74 20 24 63 6f $s}. list $co
8a80: 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 unt $done.} {655
8a90: 36 36 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 66 1}..test tlsI
8aa0: 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 O-9.3 {testing E
8ab0: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
8ac0: 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 unexplainedFailu
8ad0: 72 65 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 re socket} {.
8ae0: 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 # HOBBS: never
8af0: 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 worked correctly
8b00: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
8b10: 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c to_eof {s} {..gl
8b20: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 obal count done
8b30: 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 timer..set l [ge
8b40: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
8b50: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
8b60: 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 r count.. if
8b70: 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 {$count > 9} {..
8b80: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
8b90: 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 done true...set
8ba0: 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 count {eof is st
8bb0: 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 icky}...after ca
8bc0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 ncel $timer..
8bd0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
8be0: 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b proc timerproc {
8bf0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
8c00: 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f count c..set do
8c10: 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 ne true..set cou
8c20: 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f nt {timer went o
8c30: 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 ff, eof is not s
8c40: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
8c50: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
8c60: 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 ount 0. set d
8c70: 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 one false. pr
8c80: 6f 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c oc write_then_cl
8c90: 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 ose {s} {..puts
8ca0: 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 $s bye..close $s
8cb0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
8cc0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8cd0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
8ce0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
8cf0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
8d00: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c nslation lf..fil
8d10: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
8d20: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
8d30: 73 68 61 6b 65 20 24 73 20 77 72 69 74 61 62 6c shake $s writabl
8d40: 65 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f e write_then_clo
8d50: 73 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e se \...-bufferin
8d60: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
8d70: 69 6f 6e 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 ion lf]. }.
8d80: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8d90: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
8da0: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ept -require 0 \
8db0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8dc0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8dd0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8de0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8df0: 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 8833]. set c
8e00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
8e10: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
8e20: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
8e30: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8e40: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
8e50: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
8e60: 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a localhost 8833].
8e70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8e80: 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 c -blocking 0 -b
8e90: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
8ea0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
8eb0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
8ec0: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 eadable "count_t
8ed0: 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 o_eof $c". se
8ee0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
8ef0: 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 000 timerproc].
8f00: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
8f10: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
8f20: 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 et count.} {eof
8f30: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f is sticky}..remo
8f40: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 veFile script..t
8f50: 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b est tlsIO-10.1 {
8f60: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 testing socket a
8f70: 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 ccept callback e
8f80: 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b rror handling} {
8f90: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
8fa0: 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 t goterror 0.
8fb0: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
8fc0: 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 gs {global goter
8fd0: 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f ror; set goterro
8fe0: 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b r 1}. set s [
8ff0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
9000: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
9010: 69 72 65 20 30 20 2d 63 61 66 69 6c 65 20 24 63 ire 0 -cafile $c
9020: 61 43 65 72 74 20 38 38 39 38 5d 0a 20 20 20 20 aCert 8898].
9030: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
9040: 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 p} {close $s; e
9050: 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 rror}. set c
9060: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
9070: 71 75 69 72 65 20 30 20 2d 63 61 66 69 6c 65 20 quire 0 -cafile
9080: 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e $caCert 127.0.0.
9090: 31 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 8898]. vwai
90a0: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
90b0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
90c0: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
90d0: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
90e0: 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 tlsIO-11.1 {tcp
90f0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
9100: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9110: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9120: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
9130: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
9140: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 d {..set socket9
9150: 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _1_test_server [
9160: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
9170: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
9180: 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 ire 0 \...-certf
9190: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
91a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
91b0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
91c0: 4b 65 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 Key 8834]..proc
91d0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
91e0: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
91f0: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 hake $s.. put
9200: 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 s $s done.. c
9210: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
9220: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
9230: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
9240: 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 0 \.. -certf
9250: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9260: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9270: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9280: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9290: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 5d teServerIP 8834]
92a0: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
92b0: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
92c0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
92d0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
92e0: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_1_test_server}
92f0: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e . set r.} don
9300: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 e..test tlsIO-11
9310: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
9320: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
9330: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9340: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9350: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
9360: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a exists port]} {.
9370: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d .incr port. }
9380: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 else {..set por
9390: 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 t [expr {$tlsSer
93a0: 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 verPort + [pid]%
93b0: 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 1024}]. }.
93c0: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
93d0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
93e0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 {..set socket9_2
93f0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
9400: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
9410: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
9420: 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c e 0 \...-certfil
9430: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
9440: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9450: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
9460: 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 y 8835]..proc ac
9470: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9480: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9490: 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 ke $s.. puts
94a0: 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 $s $p.. close
94b0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
94c0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
94d0: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
94e0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
94f0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9500: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9510: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9520: 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 \.. -myport $
9530: 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 port $remoteServ
9540: 65 72 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 erIP 8835]. s
9550: 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 et r [gets $s].
9560: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
9570: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9580: 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 se $socket9_2_te
9590: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 st_server}. i
95a0: 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 f {$r == $port}
95b0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b {..set result ok
95c0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
95d0: 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e et result broken
95e0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 . }. set r
95f0: 65 73 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 esult.} ok..test
9600: 20 74 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 tlsIO-11.3 {try
9610: 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 ing to connect,
9620: 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b no server} {sock
9630: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9640: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9650: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
9660: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
9670: 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 {set s [tls::soc
9680: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
9690: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
96a0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
96b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
96c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
96d0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
96e0: 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 rverIp 8836]}]}
96f0: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
9700: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
9710: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
9720: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
9730: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
9740: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
9750: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
9760: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
9770: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
9780: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9790: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
97a0: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
97b0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
97c0: 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 socket10_6_test
97d0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
97e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
97f0: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ept -require 0 \
9800: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9810: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9820: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9830: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9840: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9850: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9860: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9870: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
9880: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
9890: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
98a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
98b0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
98c0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
98d0: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
98e0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
98f0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
9900: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
9910: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
9920: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
9930: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
9940: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
9950: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
9960: 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 ire 0 \.. -ce
9970: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9980: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9990: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
99a0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
99b0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
99c0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
99d0: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
99e0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
99f0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
9a00: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
9a10: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
9a20: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
9a30: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9a40: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
9a50: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9a60: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
9a70: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
9a80: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
9a90: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
9aa0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9ab0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9ac0: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9ad0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9ae0: 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 et socket10_7_te
9af0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9b00: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9b10: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
9b20: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
9b30: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9b40: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9b50: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
9b60: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
9b70: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9b80: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9b90: 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e $s.. fileeven
9ba0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9bb0: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
9bc0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9bd0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
9be0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
9bf0: 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 f..}..proc echo
9c00: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
9c10: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
9c20: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
9c30: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
9c40: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
9c50: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
9c60: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 }. set f
9c70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
9c80: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
9c90: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9ca0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9cb0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9cc0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9cd0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9ce0: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
9cf0: 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 gure $f -transla
9d00: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
9d10: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
9d20: 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 r {set cnt 0} {$
9d30: 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 cnt < 50} {incr
9d40: 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 cnt} {..puts $f
9d50: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 "hello, $cnt"..i
9d60: 66 20 7b 5b 67 65 74 73 20 24 66 5d 20 6e 65 20 f {[gets $f] ne
9d70: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 7d 20 7b "hello, $cnt"} {
9d80: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
9d90: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9da0: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
9db0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
9dc0: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
9dd0: 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 }. set cnt.}
9de0: 35 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 50..# Macintosh
9df0: 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 sockets can have
9e00: 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 more than one s
9e10: 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 erver per port.i
9e20: 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d f {$tcl_platform
9e30: 28 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 6d (platform) eq "m
9e40: 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 acintosh"} {.
9e50: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
9e60: 75 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 ult {0 8836}.} e
9e70: 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f lse {. set co
9e80: 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 nflictResult {1
9e90: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
9ea0: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
9eb0: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
9ec0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
9ed0: 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .6 {socket confl
9ee0: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ict} {socket doT
9ef0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9f00: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9f10: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
9f20: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
9f30: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
9f40: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
9f50: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9f60: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9f70: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d $serverKey 8836]
9f80: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
9f90: 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f {set s2 [tls::so
9fa0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9fb0: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ept -require 0 \
9fc0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9fd0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
9fe0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9ff0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
a000: 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 8836]} msg]} {..
a010: 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 set result [list
a020: 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 1 $msg]. } e
a030: 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c lse {..set resul
a040: 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 t [list 0 [linde
a050: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
a060: 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 2 -sockname] 2]]
a070: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 ..close $s2.
a080: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
a090: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d set result.}
a0a0: 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 $conflictResult
a0b0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a0c0: 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 7 {server with s
a0d0: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
a0e0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a0f0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a100: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
a110: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
a120: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
a130: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
a140: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
a150: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
a160: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d -require 0 \...-
a170: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a180: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a190: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
a1a0: 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 erverKey 8836]..
a1b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
a1c0: 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 p} {.. fconf
a1d0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
a1e0: 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 ing line.. fi
a1f0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
a200: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
a210: 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f s]..}..proc echo
a220: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
a230: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
a240: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
a250: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
a260: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 } else {...puts
a270: 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d $s $l.. }..}
a280: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
a290: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 1 [tls::socket -
a2a0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
a2b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a2c0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a2d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a2e0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a2f0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a300: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
a310: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
a320: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
a330: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
a340: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
a350: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a360: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
a370: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a380: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
a390: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
a3a0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
a3b0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
a3c0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
a3d0: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
a3e0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
a3f0: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
a400: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a410: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a420: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a430: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
a440: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
a450: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
a460: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
a470: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
a480: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
a490: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
a4a0: 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s1 hello,tlsIO
a4b0: 2d 31 31 2e 37 2c 73 31 0a 09 67 65 74 73 20 24 -11.7,s1..gets $
a4c0: 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c s1..puts $s2 hel
a4d0: 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 32 lo,tlsIO-11.7,s2
a4e0: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
a4f0: 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s3 hello,tlsIO
a500: 2d 31 31 2e 37 2c 73 33 0a 09 67 65 74 73 20 24 -11.7,s3..gets $
a510: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
a520: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
a530: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
a540: 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 s3. sendComma
a550: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
a560: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
a570: 72 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 r}. set i.} 1
a580: 30 30 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 00..test tlsIO-1
a590: 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 1.8 {client with
a5a0: 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 several servers
a5b0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
a5c0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
a5d0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
a5e0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
a5f0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a Command {..tls::
a600: 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 init -certfile $
a610: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a620: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a630: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 ile $serverKey..
a640: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a650: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a660: 65 70 74 20 34 30 30 33 22 20 2d 72 65 71 75 69 ept 4003" -requi
a670: 72 65 20 30 20 34 30 30 33 5d 0a 09 73 65 74 20 re 0 4003]..set
a680: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
a690: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
a6a0: 34 30 30 34 22 20 2d 72 65 71 75 69 72 65 20 30 4004" -require 0
a6b0: 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 4004]..set s3 [
a6c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
a6d0: 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 ver "accept 4005
a6e0: 22 20 2d 72 65 71 75 69 72 65 20 30 20 34 30 30 " -require 0 400
a6f0: 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 5]..proc handsha
a700: 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 ke {s mp} {..
a710: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
a720: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
a730: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 } elseif {[catc
a740: 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b h {tls::handshak
a750: 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b e $s} result]} {
a760: 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 ...# Some errors
a770: 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 are normal...
a780: 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 } elseif {$res
a790: 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 ult == 1} {...#
a7a0: 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 Handshake comple
a7b0: 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 te...fileevent $
a7c0: 73 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 s readable ""...
a7d0: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c puts $s $mp...cl
a7e0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
a7f0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d ..proc accept {m
a800: 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 p s a p} {..
a810: 23 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 # These have to
a820: 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b accept non-block
a830: 69 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 ing, because the
a840: 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 handshaking..
a850: 20 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 # order isn't
a860: 64 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 deterministic..
a870: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
a880: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
a890: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
a8a0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
a8b0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 eadable [list ha
a8c0: 6e 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a ndshake $s $mp].
a8d0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 .}. }. tls
a8e0: 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 ::init -certfile
a8f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a900: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a910: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a920: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
a930: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
a940: 65 20 30 20 24 72 65 6d 6f 74 65 53 65 72 76 65 e 0 $remoteServe
a950: 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 rIP 4003]. se
a960: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
a970: 74 20 2d 72 65 71 75 69 72 65 20 30 20 24 72 65 t -require 0 $re
a980: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a990: 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 4]. set s3 [t
a9a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
a9b0: 69 72 65 20 30 20 24 72 65 6d 6f 74 65 53 65 72 ire 0 $remoteSer
a9c0: 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 verIP 4005].
a9d0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
a9e0: 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 pend l [gets $s1
a9f0: 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f ] [gets $s1] [eo
aa00: 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 f $s1] [gets $s2
aa10: 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f ] [gets $s2] [eo
aa20: 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 f $s2] \..[gets
aa30: 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 $s3] [gets $s3]
aa40: 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c [eof $s3]. cl
aa50: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
aa60: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
aa70: 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s3. sendComm
aa80: 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 and {..close $s1
aa90: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f ..close $s2..clo
aaa0: 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 se $s3. }.
aab0: 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b set l.} {4003 {
aac0: 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 } 1 4004 {} 1 40
aad0: 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 05 {} 1}..test t
aae0: 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 lsIO-11.9 {accep
aaf0: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
ab00: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
ab10: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
ab20: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b r} {. set s [
ab30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
ab40: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
ab50: 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 ire 0 \.. -ce
ab60: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
ab70: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
ab80: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
ab90: 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 20 20 20 verKey 8836].
aba0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
abb0: 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 a p} {expr 10 /
abc0: 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 0}. proc bger
abd0: 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 ror args {..glob
abe0: 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 al x..set x $arg
abf0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 s. }. send
ac00: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 69 CertValues. i
ac10: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 f {[catch {sendC
ac20: 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 ommand {.. se
ac30: 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e t peername [fcon
ac40: 66 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f figure $callerSo
ac50: 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a cket -peername].
ac60: 09 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
ac70: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
ac80: 20 30 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 0 \... -cert
ac90: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
aca0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
acb0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
acc0: 74 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 tKey \... [li
acd0: 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 ndex $peername 0
ace0: 5d 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f ] 8836].. clo
acf0: 73 65 20 24 73 0a 09 20 7d 7d 20 6d 73 67 5d 7d se $s.. }} msg]}
ad00: 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 72 {..close $s..er
ad10: 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ror $msg. }.
ad20: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
ad30: 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 ter 10000 [list
ad40: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d set x timed_out]
ad50: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
ad60: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
ad70: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
ad80: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
ad90: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
ada0: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
adb0: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c zero}}..test tl
adc0: 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 sIO-11.10 {testi
add0: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
ade0: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
adf0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
ae00: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
ae10: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
ae20: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
ae30: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
ae40: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
ae50: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
ae60: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
ae70: 71 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 quire 0 \...-cer
ae80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
ae90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
aea0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
aeb0: 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f erKey 8836]..pro
aec0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
aed0: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
aee0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
aef0: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
af00: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
af10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
af20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
af30: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
af40: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
af50: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
af60: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
af70: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
af80: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 name]. set n
af90: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
afa0: 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 sockname]. se
afb0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
afc0: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
afd0: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 2] [llength $p]
afe0: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 [llength $p].
aff0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
b000: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
b010: 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 $socket10_12_te
b020: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
b030: 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 et l.} {8836 3 3
b040: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
b050: 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 .11 {testing spu
b060: 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 rious events} {s
b070: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
b080: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
b090: 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 . # remote eq
b0a0: 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 0a uivalent of 9.1.
b0b0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
b0c0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
b0d0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
b0e0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
b0f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
b100: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
b110: 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c e 0 \...-certfil
b120: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
b130: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
b140: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
b150: 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 61 y 8836]..proc ha
b160: 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 20 ndshake {s} {..
b170: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
b180: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
b190: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 } elseif {[ca
b1a0: 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 tch {tls::handsh
b1b0: 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d ake $s} result]}
b1c0: 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f {...# Some erro
b1d0: 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 rs are normal...
b1e0: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 } elseif {$r
b1f0: 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 esult == 1} {...
b200: 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 # Handshake comp
b210: 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 lete...fileevent
b220: 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 0a $s writable "".
b230: 09 09 61 66 74 65 72 20 31 30 30 20 77 72 69 74 ..after 100 writ
b240: 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d 0a esome $s.. }.
b250: 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 .}..proc accept
b260: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
b270: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
b280: 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 anslation "auto
b290: 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 65 lf".. fileeve
b2a0: 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b nt $s writable [
b2b0: 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 list handshake $
b2c0: 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 s]..}..proc writ
b2d0: 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 esome {s} {..
b2e0: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
b2f0: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
b300: 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 i} {...puts $s "
b310: 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d line $i from rem
b320: 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 ote server"..
b330: 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 }.. close $s
b340: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b350: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
b360: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
b370: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
b380: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
b390: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
b3a0: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
b3b0: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
b3c0: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
b3d0: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
b3e0: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
b3f0: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
b400: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
b410: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
b420: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
b430: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
b440: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
b450: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
b460: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
b470: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d c [tls::socket -
b480: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
b490: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b4a0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b4b0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b4c0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b4d0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b4e0: 50 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 P 8836]. # Ge
b4f0: 74 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 t the buffering
b500: 63 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 corrected. fc
b510: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 onfigure $c -buf
b520: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
b530: 23 20 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 # Put a byte int
b540: 6f 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 o the client pip
b550: 65 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 e to trigger TLS
b560: 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 handshaking.
b570: 20 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 puts $c a. f
b580: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
b590: 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c able [list readl
b5a0: 69 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 ittle $c]. se
b5b0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
b5c0: 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 64 0000 [list set d
b5d0: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a one timed_out]].
b5e0: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
b5f0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
b600: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 $timer. sendC
b610: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
b620: 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 ocket_test_serve
b630: 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 r}. list $spu
b640: 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 rious $len.} {0
b650: 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 2690}..test tlsI
b660: 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 O-11.12 {testing
b670: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
b680: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 {unexplainedFai
b690: 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 65 lure socket doTe
b6a0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
b6b0: 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d ver} {. # rem
b6c0: 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f ote equivalent o
b6d0: 66 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 42 f 9.3. # HOBB
b6e0: 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 S: never worked
b6f0: 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 65 correctly. se
b700: 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 t counter 0.
b710: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
b720: 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d roc count_up {s}
b730: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
b740: 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 er done after_id
b750: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
b760: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
b770: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 {.. incr cou
b780: 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 nter.. if {$c
b790: 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 ounter > 9} {...
b7a0: 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 set done {EOF is
b7b0: 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 sticky}...after
b7c0: 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 cancel $after_i
b7d0: 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 d...close $s..
b7e0: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
b7f0: 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 proc timed_out
b800: 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 {} {..global c d
b810: 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 one..set done {t
b820: 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 imed_out, EOF is
b830: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
b840: 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 ose $c. }.
b850: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
b860: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b870: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
b880: 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 14_test_server [
b890: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
b8a0: 76 65 72 20 61 63 63 65 70 74 20 20 2d 72 65 71 ver accept -req
b8b0: 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 uire 0 \...-cert
b8c0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
b8d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b8e0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
b8f0: 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 rKey 8836]..proc
b900: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
b910: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
b920: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 61 66 shake $s.. af
b930: 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 ter 100 close $s
b940: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b950: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
b960: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 -require 0 \..
b970: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
b980: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
b990: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b9a0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
b9b0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
b9c0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 rIP 8836]. fi
b9d0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
b9e0: 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 ble "count_up $c
b9f0: 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 5f ". set after_
ba00: 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 id [after 1000 t
ba10: 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 imed_out]. vw
ba20: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e ait done. sen
ba30: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
ba40: 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 $socket10_14_tes
ba50: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
ba60: 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 t done.} {EOF is
ba70: 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 sticky}..test t
ba80: 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 lsIO-11.13 {test
ba90: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
baa0: 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 async flush, as
bab0: 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 ync close} \..{s
bac0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
bad0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
bae0: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
baf0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
bb00: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c ount done..set l
bb10: 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 [read $s]..incr
bb20: 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c count [string l
bb30: 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b ength $l]..if {[
bb40: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
bb50: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
bb60: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
bb70: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
bb80: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
bb90: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 mand {..set firs
bba0: 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 tblock [string r
bbb0: 65 70 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 epeat a 31]..set
bbc0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 secondblock [st
bbd0: 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 ring repeat b 65
bbe0: 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 535]..set l [tls
bbf0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
bc00: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
bc10: 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 0 \...-certfile
bc20: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
bc30: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
bc40: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
bc50: 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 8845]..proc acc
bc60: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
bc70: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
bc80: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
bc90: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
bca0: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
bcb0: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
bcc0: 31 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 16384 \... -b
bcd0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
bce0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
bcf0: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 readable "readab
bd00: 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 le $s"..}..proc
bd10: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
bd20: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
bd30: 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s].. fileeve
bd40: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b nt $s readable {
bd50: 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 }.. after 100
bd60: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 0 respond $s..}.
bd70: 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 .proc respond {s
bd80: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
bd90: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
bda0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
bdb0: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
bdc0: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 after 1000 w
bdd0: 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 ritedata $s..}..
bde0: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
bdf0: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
be00: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 secondblock..
be10: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
be20: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
be30: 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a k.. close $s.
be40: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
be50: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
be60: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
be70: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
be80: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
be90: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
bea0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
beb0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
bec0: 49 50 20 38 38 34 35 5d 0a 20 20 20 20 66 63 6f IP 8845]. fco
bed0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
bee0: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
bef0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ion lf -bufferin
bf00: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
bf10: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
bf20: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c $s hello. fil
bf30: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
bf40: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
bf50: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
bf60: 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 ter 10000 [list
bf70: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
bf80: 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut]]. vwait d
bf90: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
bfa0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
bfb0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
bfc0: 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 se $l}. set c
bfd0: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 70 72 ount.} 65566..pr
bfe0: 6f 63 20 67 65 74 64 61 74 61 20 7b 74 79 70 65 oc getdata {type
bff0: 20 66 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 52 file} {. # R
c000: 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 ead handler on t
c010: 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b he accepted sock
c020: 65 74 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 78 et.. global x
c030: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 6c . global fail
c040: 65 64 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 ed. set statu
c050: 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 s [catch {read $
c060: 66 69 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 20 file} data].
c070: 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 if {$status != 0
c080: 7d 20 7b 0a 09 73 65 74 20 78 20 22 72 65 61 64 } {..set x "read
c090: 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 failed, error w
c0a0: 61 73 20 24 64 61 74 61 22 0a 09 63 61 74 63 68 as $data"..catch
c0b0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
c0c0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
c0d0: 64 61 74 61 20 6e 65 20 7b 7d 7d 20 7b 0a 20 20 data ne {}} {.
c0e0: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c } elseif {[fbl
c0f0: 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a ocked $file]} {.
c100: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 65 } elseif {[e
c110: 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 69 66 of $file]} {..if
c120: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 20 20 {$failed} {..
c130: 20 20 73 65 74 20 78 20 22 24 74 79 70 65 20 73 set x "$type s
c140: 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 ocket was inheri
c150: 74 65 64 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 ted"..} else {..
c160: 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70 65 set x "$type
c170: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c180: 69 6e 68 65 72 69 74 65 64 22 0a 09 7d 0a 09 63 inherited"..}..c
c190: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
c1a0: 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 le }. } else
c1b0: 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 {..set x {imposs
c1c0: 69 62 6c 65 20 63 61 73 65 7d 0a 09 63 61 74 63 ible case}..catc
c1d0: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
c1e0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 }. }. retu
c1f0: 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f rn.}..test tlsIO
c200: 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 -12.1 {testing i
c210: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 nheritance of se
c220: 72 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 7b 73 rver sockets} {s
c230: 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 ocket exec} {.
c240: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c250: 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 ript1. makeFi
c260: 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 le {} script2..
c270: 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 # Script1 is
c280: 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 just a 10 second
c290: 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 delay. If the
c2a0: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 server socket.
c2b0: 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 # is inherited
c2c0: 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c , it will be hel
c2d0: 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 d open for 10 se
c2e0: 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 conds.. set f
c2f0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 [open script1 w
c300: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c310: 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 .after 10000 exi
c320: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
c330: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c340: 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 $f.. # Scrip
c350: 74 32 20 63 72 65 61 74 65 73 20 74 68 65 20 73 t2 creates the s
c360: 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 erver socket, la
c370: 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a unches script1,.
c380: 20 20 20 20 23 20 77 61 69 74 73 20 61 20 73 65 # waits a se
c390: 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e cond, and exits.
c3a0: 20 20 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 The server soc
c3b0: 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 ket will now.
c3c0: 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c # be closed unl
c3d0: 65 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 ess script1 inhe
c3e0: 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 rited it... s
c3f0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
c400: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
c410: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
c420: 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 h $::tcltest::tc
c430: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
c440: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
c450: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
c460: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
c470: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
c480: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
c490: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
c4a0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
c4b0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c4c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
c4d0: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
c4e0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
c4f0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
c500: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c510: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
c520: 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 828\]". puts
c530: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
c540: 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f t { file addr po
c550: 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 rt } {.. clos
c560: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 e $file..}..exec
c570: 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 $tclsh script1
c580: 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 &..close $f..aft
c590: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 er 1000 exit..vw
c5a0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c5b0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c5c0: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 # Launch scr
c5d0: 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 ipt2 and wait 5
c5e0: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 seconds.. exe
c5f0: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
c600: 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a ltest script2 &.
c610: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 7b after 5000 {
c620: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
c630: 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 ed 1 }. vwait
c640: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
c650: 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 # If we can
c660: 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f still connect to
c670: 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 the server, the
c680: 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 socket got inhe
c690: 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b rited... if {
c6a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
c6b0: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
c6c0: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
c6d0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
c6e0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c6f0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
c700: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 127.0.0.1 8828}
c710: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b msg]} {..set x {
c720: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
c730: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
c740: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 . } else {..c
c750: 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 lose $msg..set x
c760: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c770: 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 was inherited}.
c780: 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a }.. set x.
c790: 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 } {server socket
c7a0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c7b0: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
c7c0: 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.2 {testing in
c7d0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 heritance of cli
c7e0: 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f ent sockets} {so
c7f0: 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 cket exec} {.
c800: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
c810: 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c ipt1. makeFil
c820: 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 e {} script2..
c830: 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a # Script1 is j
c840: 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 ust a 10 second
c850: 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 delay. If the s
c860: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 erver socket.
c870: 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c # is inherited,
c880: 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 it will be held
c890: 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 open for 10 sec
c8a0: 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 onds.. set f
c8b0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
c8c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c8d0: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
c8e0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c8f0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c900: 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 $f.. # Script
c910: 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 2 opens the clie
c920: 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 nt socket and wr
c930: 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 ites to it. It
c940: 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 then. # launc
c950: 68 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 hes script1 and
c960: 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 exits. If the c
c970: 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 hild process inh
c980: 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 erited the. #
c990: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 client socket,
c9a0: 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 the socket will
c9b0: 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a still be open...
c9c0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c9d0: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c9e0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c9f0: 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 tclsh $::tcltes
ca00: 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 t::tcltest].
ca10: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
ca20: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
ca30: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
ca40: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 $f {..package p
ca50: 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 refer latest..pa
ca60: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
ca70: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
ca80: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
ca90: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
caa0: 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 63 e 0 -certfile $c
cab0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
cac0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 20 20 20 e $caCert \..
cad0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
cae0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
caf0: 38 32 39 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 829\]". puts
cb00: 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 $f {..exec $tcls
cb10: 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 h script1 &..put
cb20: 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c s $f testing..fl
cb30: 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 ush $f..after 10
cb40: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
cb50: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
cb60: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
cb70: 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 76 Create the serv
cb80: 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 er socket.. s
cb90: 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a et server [tls::
cba0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
cbb0: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
cbc0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
cbd0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
cbe0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
cbf0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
cc00: 79 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 y 8829]. proc
cc10: 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 accept { file h
cc20: 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 23 20 ost port } {..#
cc30: 57 68 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 When the client
cc40: 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 6c connects, establ
cc50: 69 73 68 20 74 68 65 20 72 65 61 64 20 68 61 6e ish the read han
cc60: 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 dler..global ser
cc70: 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 ver..close $serv
cc80: 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 er..fconfigure $
cc90: 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 file -blocking 0
cca0: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c ..fileevent $fil
ccb0: 65 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 e readable [list
ccc0: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 66 do_handshake $f
ccd0: 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 ile readable \..
cce0: 09 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 63 .[list getdata c
ccf0: 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65 72 69 6e lient] -bufferin
cd00: 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a g line]..return.
cd10: 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 }.. # If
cd20: 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e the socket doesn
cd30: 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 't hit end-of-fi
cd40: 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c le in 5 seconds,
cd50: 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 70 the. # scrip
cd60: 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 20 t1 process must
cd70: 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 have inherited t
cd80: 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 he client...
cd90: 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 set failed 0.
cda0: 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 after 5000 [lis
cdb0: 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d 0a t set failed 1].
cdc0: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
cdd0: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
cde0: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
cdf0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
ce00: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 script2 &.. v
ce10: 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 wait x. if {!
ce20: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 $failed} {..vwai
ce30: 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 t failed. }.
ce40: 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 set x.} {clie
ce50: 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f nt socket was no
ce60: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 t inherited}..te
ce70: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 st tlsIO-12.3 {t
ce80: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
ce90: 63 65 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 ce of accepted s
cea0: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
ceb0: 65 74 20 65 78 65 63 20 75 6e 69 78 4f 6e 6c 79 et exec unixOnly
cec0: 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 } {. makeFile
ced0: 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 {} script1.
cee0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
cef0: 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b pt2.. set f [
cf00: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
cf10: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
cf20: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
cf30: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
cf40: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
cf50: 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 f.. set f [op
cf60: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
cf70: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
cf80: 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c set tclsh $::tcl
cf90: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
cfa0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
cfb0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
cfc0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
cfd0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
cfe0: 65 20 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a e prefer latest.
cff0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
d000: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
d010: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
d020: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
d030: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
d040: 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 ire 0 \.. -ce
d050: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
d060: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
d070: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
d080: 76 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 verKey 8930\]".
d090: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
d0a0: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
d0b0: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 host port } {..
d0c0: 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 global tclsh
d0d0: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
d0e0: 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e $file -bufferin
d0f0: 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 73 g line.. puts
d100: 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 $file {test dat
d110: 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 a on socket}..
d120: 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 exec $tclsh sc
d130: 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 ript1 &.. aft
d140: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a er 1000 exit..}.
d150: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
d160: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
d170: 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 f.. # Launch
d180: 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 the script2 proc
d190: 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 ess and connect
d1a0: 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 to it. See how
d1b0: 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 long. # the s
d1c0: 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e ocket stays open
d1d0: 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 .. exec $::tc
d1e0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
d1f0: 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 cript2 &.. af
d200: 74 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b 5f ter 2000 set ok_
d210: 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 to_proceed 1.
d220: 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f vwait ok_to_pro
d230: 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 ceed.. set f
d240: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
d250: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
d260: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
d270: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
d280: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
d290: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
d2a0: 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 127.0.0.1 8930].
d2b0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
d2c0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c f -buffering ful
d2d0: 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 l -blocking 0.
d2e0: 20 20 23 20 57 65 20 6e 65 65 64 20 74 6f 20 70 # We need to p
d2f0: 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 ut a byte into t
d300: 68 65 20 72 65 61 64 20 71 75 65 75 65 2c 20 6f he read queue, o
d310: 74 68 65 72 77 69 73 65 20 74 68 65 0a 20 20 20 therwise the.
d320: 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 # TLS handshake
d330: 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 68 0a doesn't finish.
d340: 20 20 20 20 70 75 74 73 20 24 66 20 61 3b 20 66 puts $f a; f
d350: 6c 75 73 68 20 24 66 0a 20 20 20 20 66 69 6c 65 lush $f. file
d360: 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c event $f readabl
d370: 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 e [list getdata
d380: 61 63 63 65 70 74 65 64 20 24 66 5d 0a 0a 20 20 accepted $f]..
d390: 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 # If the socke
d3a0: 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 t is still open
d3b0: 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c after 5 seconds,
d3c0: 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 6f the script1 pro
d3d0: 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 cess. # must
d3e0: 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 have inherited t
d3f0: 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b he accepted sock
d400: 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 et... set fai
d410: 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 led 0. after
d420: 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 5000 set failed
d430: 31 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 1.. vwait x.
d440: 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 set x.} {acce
d450: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
d460: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
d470: 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 test tlsIO-13.1
d480: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
d490: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
d4a0: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
d4b0: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 s} \..{socket te
d4c0: 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 stthread} {.
d4d0: 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 # HOBBS: never t
d4e0: 65 73 74 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 ested. remove
d4f0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
d500: 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 threadReap..
d510: 6d 61 6b 65 46 69 6c 65 20 7b 0a 09 70 61 63 6b makeFile {..pack
d520: 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 65 73 age prefer lates
d530: 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 t..package requi
d540: 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 re tls..set f [t
d550: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
d560: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
d570: 72 65 20 30 20 38 38 32 38 5d 0a 09 70 72 6f 63 re 0 8828]..proc
d580: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
d590: 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 {.. fileevent
d5a0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
d5b0: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
d5c0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
d5d0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
d5e0: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
d5f0: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
d600: 69 0a 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 i.. set l [g
d610: 65 74 73 20 24 73 5d 0a 09 20 20 20 20 20 69 66 ets $s].. if
d620: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
d630: 20 67 6c 6f 62 61 6c 20 78 0a 09 09 20 63 6c 6f global x... clo
d640: 73 65 20 24 73 0a 09 09 20 73 65 74 20 78 20 64 se $s... set x d
d650: 6f 6e 65 0a 09 20 20 20 20 20 7d 20 65 6c 73 65 one.. } else
d660: 20 7b 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 {.. inc
d670: 72 20 69 0a 09 09 20 70 75 74 73 20 24 73 20 24 r i... puts $s $
d680: 6c 0a 09 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 l.. }..}..se
d690: 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 t i 0..vwait x..
d6a0: 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 close $f...# thr
d6b0: 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c ead cleans itsel
d6c0: 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 f up...testthrea
d6d0: 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 d exit. } scr
d6e0: 69 70 74 0a 0a 20 20 20 20 23 20 63 72 65 61 74 ipt.. # creat
d6f0: 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 e a thread. s
d700: 65 74 20 73 65 72 76 65 72 74 68 72 65 61 64 20 et serverthread
d710: 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 65 61 [testthread crea
d720: 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 te { source scri
d730: 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 pt } ]. updat
d740: 65 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 e.. after 100
d750: 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 0. set s [tls
d760: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
d770: 65 20 30 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 e 0 127.0.0.1 88
d780: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
d790: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
d7a0: 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 line.. catch
d7b0: 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c {..puts $s "hel
d7c0: 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 lo"..gets $s res
d7d0: 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ult. }. cl
d7e0: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
d7f0: 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 e.. after 200
d800: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
d810: 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 sult [threadReap
d820: 5d 0a 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c ].. set resul
d830: 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a t..} {hello 1}..
d840: 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 31 20 test tlsIO-14.1
d850: 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 {test tls::unimp
d860: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ort} {socket} {.
d870: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
d880: 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 {tls::unimport}
d890: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
d8a0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
d8b0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e ould be "tls::un
d8c0: 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d import channel"}
d8d0: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e }.test tlsIO-14.
d8e0: 32 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 2 {test tls::uni
d8f0: 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 mport} {socket}
d900: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
d910: 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 h {tls::unimport
d920: 20 66 6f 6f 20 62 61 72 7d 20 6d 73 67 5d 20 24 foo bar} msg] $
d930: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
d940: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
d950: 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 e "tls::unimport
d960: 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 channel"}}.test
d970: 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b 74 65 73 tlsIO-14.3 {tes
d980: 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d t tls::unimport}
d990: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
d9a0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
d9b0: 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 6f 67 75 73 ::unimport bogus
d9c0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
d9d0: 20 7b 63 61 6e 20 6e 6f 74 20 66 69 6e 64 20 63 {can not find c
d9e0: 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 20 22 62 6f hannel named "bo
d9f0: 67 75 73 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 gus"}}.test tlsI
da00: 4f 2d 31 34 2e 34 20 7b 74 65 73 74 20 74 6c 73 O-14.4 {test tls
da10: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 ::unimport} {soc
da20: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 73 74 64 ket} {. # std
da30: 69 6e 20 63 61 6e 20 74 61 6b 65 20 64 69 66 66 in can take diff
da40: 65 72 65 6e 74 20 6e 61 6d 65 73 20 61 73 20 74 erent names as t
da50: 68 65 20 22 74 6f 70 22 20 63 68 61 6e 6e 65 6c he "top" channel
da60: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
da70: 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 {tls::unimport
da80: 73 74 64 69 6e 7d 20 6d 73 67 5d 20 5c 0a 09 5b stdin} msg] \..[
da90: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 7b 62 61 string match {ba
daa0: 64 20 63 68 61 6e 6e 65 6c 20 22 2a 22 3a 20 6e d channel "*": n
dab0: 6f 74 20 61 20 73 74 61 63 6b 65 64 20 63 68 61 ot a stacked cha
dac0: 6e 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b 31 nnel} $msg].} {1
dad0: 20 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 1}.test tlsIO-1
dae0: 34 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 4.5 {test tls::u
daf0: 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 nimport} {socket
db00: 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 } {. set len
db10: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
db20: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
db30: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
db40: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
db50: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
db60: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
db70: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
db80: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
db90: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
dba0: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
dbb0: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
dbc0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
dbd0: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
dbe0: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
dbf0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
dc00: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
dc10: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
dc20: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
dc30: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
dc40: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
dc50: 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e king 0..fileeven
dc60: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
dc70: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
dc80: 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 $s readable rea
dc90: 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 dlittle \...-buf
dca0: 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 fering none].
dcb0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
dcc0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
dcd0: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
dce0: 65 20 30 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 e 0 \..-certfile
dcf0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
dd00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
dd10: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
dd20: 20 38 38 33 38 5d 0a 20 20 20 20 73 65 74 20 63 8838]. set c
dd30: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 [tls::socket -r
dd40: 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 equire 0 -certfi
dd50: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
dd60: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
dd70: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
dd80: 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 ey \.. localh
dd90: 6f 73 74 20 38 38 33 38 5d 0a 20 20 20 20 23 20 ost 8838]. #
dda0: 6f 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e 74 20 only the client
ddb0: 67 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 gets tls::import
ddc0: 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b 74 6c . set res [tl
ddd0: 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 5d 0a s::unimport $c].
dde0: 20 20 20 20 6c 69 73 74 20 24 72 65 73 20 5b 63 list $res [c
ddf0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 20 atch {close $c}
de00: 65 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b 63 61 err] $err \..[ca
de10: 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 20 65 tch {close $s} e
de20: 72 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 30 rr] $err.} {{} 0
de30: 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 74 20 {} 0 {}}..test
de40: 74 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 7b 74 tls-bug58-1.0 {t
de50: 65 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e 65 67 est protocol neg
de60: 6f 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 72 65 otiation failure
de70: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
de80: 20 23 20 46 6f 6c 6c 6f 77 69 6e 67 20 63 6f 64 # Following cod
de90: 65 20 69 73 20 62 61 73 65 64 20 6f 6e 20 77 68 e is based on wh
dea0: 61 74 20 77 61 73 20 72 65 70 6f 72 74 65 64 20 at was reported
deb0: 69 6e 20 62 75 67 20 23 35 38 2e 20 50 72 69 6f in bug #58. Prio
dec0: 72 0a 20 20 20 20 23 20 74 6f 20 66 69 78 20 74 r. # to fix t
ded0: 68 65 20 70 72 6f 67 72 61 6d 20 77 6f 75 6c 64 he program would
dee0: 20 63 72 61 73 68 20 77 69 74 68 20 61 20 73 65 crash with a se
def0: 67 66 61 75 6c 74 2e 0a 20 20 20 20 70 72 6f 63 gfault.. proc
df00: 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 72 accept {sock ar
df10: 67 73 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 gs} {..fconfigur
df20: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
df30: 67 20 30 3b 0a 09 66 69 6c 65 65 76 65 6e 74 20 g 0;..fileevent
df40: 24 73 6f 63 6b 20 72 65 61 64 61 62 6c 65 20 5b $sock readable [
df50: 6c 69 73 74 20 48 61 6e 64 73 68 61 6b 65 20 24 list Handshake $
df60: 73 6f 63 6b 5d 0a 20 20 20 20 7d 0a 20 20 20 20 sock]. }.
df70: 70 72 6f 63 20 48 61 6e 64 73 68 61 6b 65 20 7b proc Handshake {
df80: 73 6f 63 6b 7d 20 7b 0a 09 73 65 74 20 3a 3a 64 sock} {..set ::d
df90: 6f 6e 65 20 48 41 4e 44 0a 09 63 61 74 63 68 20 one HAND..catch
dfa0: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
dfb0: 24 73 6f 63 6b 7d 20 6d 73 67 0a 09 73 65 74 20 $sock} msg..set
dfc0: 3a 3a 64 6f 6e 65 20 24 6d 73 67 0a 20 20 20 20 ::done $msg.
dfd0: 7d 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 77 68 }. # NOTE: wh
dfe0: 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 en doing an in-p
dff0: 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 rocess client/se
e000: 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 rver test, both
e010: 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 sides need. #
e020: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
e030: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
e040: 68 61 6e 64 73 68 61 6b 65 0a 0a 20 20 20 20 23 handshake.. #
e050: 20 53 65 72 76 65 72 20 2d 20 4f 6e 6c 79 20 61 Server - Only a
e060: 63 63 65 70 74 20 54 4c 53 20 31 2e 33 0a 20 20 ccept TLS 1.3.
e070: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
e080: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
e090: 65 70 74 20 2d 72 65 71 75 65 73 74 20 30 20 2d ept -request 0 -
e0a0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 63 65 require 0 \..-ce
e0b0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
e0c0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
e0d0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
e0e0: 76 65 72 4b 65 79 20 5c 0a 09 2d 73 73 6c 32 20 verKey \..-ssl2
e0f0: 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 31 20 0 -ssl3 0 -tls1
e100: 30 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 6c 73 0 -tls1.1 0 -tls
e110: 31 2e 32 20 30 20 2d 74 6c 73 31 2e 33 20 31 20 1.2 0 -tls1.3 1
e120: 38 38 33 37 5d 0a 20 20 20 20 23 20 43 6c 69 65 8837]. # Clie
e130: 6e 74 20 2d 20 4f 6e 6c 79 20 70 72 6f 70 6f 73 nt - Only propos
e140: 65 20 54 4c 53 31 2e 32 0a 20 20 20 20 73 65 74 e TLS1.2. set
e150: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
e160: 2d 61 73 79 6e 63 20 2d 63 61 66 69 6c 65 20 24 -async -cafile $
e170: 63 61 43 65 72 74 20 2d 72 65 71 75 65 73 74 20 caCert -request
e180: 30 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 0 -require 0 \..
e190: 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 20 -ssl2 0 -ssl3 0
e1a0: 2d 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 31 20 -tls1 0 -tls1.1
e1b0: 30 20 2d 74 6c 73 31 2e 32 20 31 20 2d 74 6c 73 0 -tls1.2 1 -tls
e1c0: 31 2e 33 20 30 20 6c 6f 63 61 6c 68 6f 73 74 20 1.3 0 localhost
e1d0: 38 38 33 37 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8837]. fconfi
e1e0: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
e1f0: 67 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 20 g 0. puts $c
e200: 61 20 3b 20 66 6c 75 73 68 20 24 63 0a 20 20 20 a ; flush $c.
e210: 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 after 5000 [lis
e220: 74 20 73 65 74 20 3a 3a 64 6f 6e 65 20 74 69 6d t set ::done tim
e230: 65 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 eout]. vwait
e240: 3a 3a 64 6f 6e 65 0a 20 20 20 20 73 77 69 74 63 ::done. switc
e250: 68 20 2d 65 78 61 63 74 20 2d 2d 20 24 3a 3a 64 h -exact -- $::d
e260: 6f 6e 65 20 7b 0a 09 22 68 61 6e 64 73 68 61 6b one {.."handshak
e270: 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 e failed: wrong
e280: 73 73 6c 20 76 65 72 73 69 6f 6e 22 20 2d 0a 09 ssl version" -..
e290: 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 "handshake faile
e2a0: 64 3a 20 75 6e 73 75 70 70 6f 72 74 65 64 20 70 d: unsupported p
e2b0: 72 6f 74 6f 63 6f 6c 22 20 7b 0a 09 20 20 20 20 rotocol" {..
e2c0: 73 65 74 20 3a 3a 64 6f 6e 65 20 22 68 61 6e 64 set ::done "hand
e2d0: 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 shake failed: wr
e2e0: 6f 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 ong version numb
e2f0: 65 72 22 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 er"..}. }.
e300: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 catch {close $c
e310: 7d 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f }. catch {clo
e320: 73 65 20 24 73 7d 0a 20 20 20 20 73 65 74 20 3a se $s}. set :
e330: 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e 64 73 68 61 :done.} {handsha
e340: 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 ke failed: wrong
e350: 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 7d version number}
e360: 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b ..# cleanup.if {
e370: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f [string match so
e380: 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ck* $commandSock
e390: 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 et] == 1} {. p
e3a0: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
e3b0: 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 et exit. flush
e3c0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a $commandSocket.
e3d0: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
e3e0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 commandSocket}.c
e3f0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d atch {close $rem
e400: 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 oteProcChan}.::t
e410: 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 cltest::cleanupT
e420: 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 ests.flush stdou
e430: 74 0a 72 65 74 75 72 6e 0a t.return.