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 2d 63 cket command} -c
2120: 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b onstraints {sock
2130: 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 et} -body {.
2140: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2150: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2160: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 72 } msg] $msg.} -r
2170: 65 73 75 6c 74 20 7b 31 20 7b 77 72 6f 6e 67 20 esult {1 {wrong
2180: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2190: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
21a0: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
21b0: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
21c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 32 ..test tlsIO-1.2
21d0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
21e0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
21f0: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
2200: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
2210: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2220: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2230: 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 rver foo} msg] $
2240: 6d 73 67 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 31 msg.} -result {1
2250: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2260: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2270: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2280: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2290: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
22a0: 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 lsIO-1.3 {arg pa
22b0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
22c0: 20 63 6f 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 command} -const
22d0: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 raints {socket}
22e0: 2d 62 6f 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 -body {. list
22f0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2300: 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 cket -myaddr} ms
2310: 67 5d 20 24 6d 73 67 0a 7d 20 2d 72 65 73 75 6c g] $msg.} -resul
2320: 74 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22 20 t {1 {"-myaddr"
2330: 6f 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20 66 option must be f
2340: 6f 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75 65 ollowed by value
2350: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2360: 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .4 {arg parsing
2370: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2380: 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 nd} -constraints
2390: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 {socket} -body
23a0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
23b0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
23c0: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
23d0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 72 } msg] $msg.} -r
23e0: 65 73 75 6c 74 20 7b 31 20 7b 77 72 6f 6e 67 20 esult {1 {wrong
23f0: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2400: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2410: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2420: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2430: 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 69 O-1.5 {arg parsi
2440: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2450: 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 mmand} -constrai
2460: 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f nts {socket} -bo
2470: 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 dy {. list [c
2480: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2490: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
24a0: 24 6d 73 67 0a 7d 20 2d 72 65 73 75 6c 74 20 7b $msg.} -result {
24b0: 31 20 7b 22 2d 6d 79 70 6f 72 74 22 20 6f 70 74 1 {"-myport" opt
24c0: 69 6f 6e 20 6d 75 73 74 20 62 65 20 66 6f 6c 6c ion must be foll
24d0: 6f 77 65 64 20 62 79 20 76 61 6c 75 65 7d 7d 0a owed by value}}.
24e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 .test tlsIO-1.6
24f0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2500: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2510: 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 -constraints {s
2520: 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 ocket} -body {.
2530: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2540: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
2550: 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d 20 24 ort xxxx} msg] $
2560: 6d 73 67 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 31 msg.} -result {1
2570: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2580: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2590: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
25a0: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
25b0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 est tlsIO-1.7 {a
25c0: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
25d0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 2d ocket command} -
25e0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
25f0: 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 ket} -body {.
2600: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2610: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
2620: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
2630: 67 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b g.} -result {1 {
2640: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2650: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2660: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2670: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2680: 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 67 t tlsIO-1.8 {arg
2690: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
26a0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 2d 63 6f ket command} -co
26b0: 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 nstraints {socke
26c0: 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 6c t} -body {. l
26d0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
26e0: 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d :socket -froboz}
26f0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d 61 msg] $msg.} -ma
2700: 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 75 6c 74 tch glob -result
2710: 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 6f 6e 20 {1 {bad option
2720: 22 2d 66 72 6f 62 6f 7a 22 3a 20 6d 75 73 74 20 "-froboz": must
2730: 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a 74 be one of *}}..t
2740: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 est tlsIO-1.9 {a
2750: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2760: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 2d ocket command} -
2770: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
2780: 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 ket} -body {.
2790: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
27a0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
27b0: 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 r foo -myport 25
27c0: 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 21 3333} msg] $m
27d0: 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 6c 6f 62 sg.} -match glob
27e0: 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b 62 61 64 -result {1 {bad
27f0: 20 6f 70 74 69 6f 6e 20 22 2d 6d 79 70 6f 72 74 option "-myport
2800: 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f ": must be one o
2810: 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 f *}}..test tlsI
2820: 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 72 73 O-1.10 {arg pars
2830: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2840: 6f 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 ommand} -constra
2850: 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 ints {socket} -b
2860: 6f 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b ody {. list [
2870: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2880: 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 et host 2528 -ju
2890: 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 nk} msg] $msg.}
28a0: 2d 72 65 73 75 6c 74 20 7b 31 20 7b 77 72 6f 6e -result {1 {wron
28b0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
28c0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
28d0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
28e0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
28f0: 73 49 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 sIO-1.11 {arg pa
2900: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2910: 20 63 6f 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 command} -const
2920: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 raints {socket}
2930: 2d 62 6f 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 -body {. list
2940: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2950: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c cket -server cal
2960: 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d lback 2520 --} m
2970: 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 72 65 73 75 sg] $msg.} -resu
2980: 6c 74 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 lt {1 {wrong # a
2990: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
29a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
29b0: 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 ver command ?opt
29c0: 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 ions? port"}}..t
29d0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b est tlsIO-1.12 {
29e0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
29f0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2a00: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
2a10: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
2a20: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2a30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 ls::socket foo b
2a40: 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 adport} msg] $ms
2a50: 67 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b g.} -result {1 {
2a60: 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 expected integer
2a70: 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 but got "badpor
2a80: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
2a90: 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.1 {tcp connec
2aa0: 74 69 6f 6e 7d 20 2d 63 6f 6e 73 74 72 61 69 6e tion} -constrain
2ab0: 74 73 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f ts {socket stdio
2ac0: 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 72 65 } -body {. re
2ad0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
2ae0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2af0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2b00: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
2b10: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
2b20: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
2b30: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 f {..package pre
2b40: 66 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b fer latest..pack
2b50: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
2b60: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
2b70: 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 r 2000 [list set
2b80: 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 x timed_out]].
2b90: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
2ba0: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
2bb0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
2bc0: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
2bd0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
2be0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
2bf0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
2c00: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c serverKey 8828 \
2c10: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
2c20: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 ..proc accept {f
2c30: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ile addr port} {
2c40: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
2c50: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
2c60: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
2c70: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2c80: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2c90: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2ca0: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a ose $f..puts $x.
2cb0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
2cc0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
2cd0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
2ce0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
2cf0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
2d00: 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 ets $f x. if
2d10: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
2d20: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
2d30: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2d40: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2d50: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2d60: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 y 127.0.0.1 8828
2d70: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
2d80: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
2d90: 20 7b 0a 09 6c 61 70 70 65 6e 64 20 78 20 5b 67 {..lappend x [g
2da0: 65 74 73 20 24 66 5d 0a 09 63 6c 6f 73 65 20 24 ets $f]..close $
2db0: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 msg. }. la
2dc0: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2dd0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
2de0: 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 73 75 set x.} -resu
2df0: 6c 74 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b lt {ready done {
2e00: 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 }}..if [info exi
2e10: 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 sts port] {.
2e20: 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 incr port.} else
2e30: 20 7b 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 {. set port
2e40: 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 76 65 [expr {$tlsServe
2e50: 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 rPort + [pid]%10
2e60: 32 34 7d 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 24}].}..test tls
2e70: 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e IO-2.2 {tcp conn
2e80: 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 ection with clie
2e90: 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 69 65 nt port specifie
2ea0: 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 d} -constraints
2eb0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 2d {socket stdio} -
2ec0: 62 6f 64 79 20 7b 0a 20 20 20 20 72 65 6d 6f 76 body {. remov
2ed0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2ee0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2ef0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2f00: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
2f10: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
2f20: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
2f30: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
2f40: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
2f50: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2f60: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2f70: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 000 [list set x
2f80: 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 done]]. }.
2f90: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2fa0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2fb0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
2fc0: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
2fd0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2fe0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2ff0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3000: 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 y 8829 \]". p
3010: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3020: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3030: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
3040: 6f 62 61 6c 20 78 0a 09 20 20 20 20 70 75 74 73 obal x.. puts
3050: 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 "[gets $sock] $
3060: 70 6f 72 74 22 0a 09 20 20 20 20 63 6c 6f 73 65 port".. close
3070: 20 24 73 6f 63 6b 0a 09 20 20 20 20 73 65 74 20 $sock.. set
3080: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
3090: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
30a0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
30b0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
30c0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
30d0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
30e0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
30f0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3100: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3110: 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 s $f x. globa
3120: 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b l port. if {[
3130: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
3140: 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 et -myport $port
3150: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d -require 0 \..-
3160: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
3170: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3180: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3190: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
31a0: 30 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 0.0.1 8829} sock
31b0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 73 6f 63 ]} {..set x $soc
31c0: 6b 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 k..catch {close
31d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
31e0: 2e 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 .0.0.1 8829]}.
31f0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 70 75 74 73 } else {..puts
3200: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
3210: 75 73 68 20 24 73 6f 63 6b 0a 09 6c 61 70 70 65 ush $sock..lappe
3220: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 09 nd x [gets $f]..
3230: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3240: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3250: 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 73 75 set x.} -resu
3260: 6c 74 20 5b 6c 69 73 74 20 72 65 61 64 79 20 22 lt [list ready "
3270: 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 hello $port"]..t
3280: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 est tlsIO-2.3 {t
3290: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
32a0: 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 th client interf
32b0: 61 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 2d ace specified} -
32c0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
32d0: 6b 65 74 20 73 74 64 69 6f 7d 20 2d 62 6f 64 79 ket stdio} -body
32e0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
32f0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3300: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3310: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3320: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3330: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
3340: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3350: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
3360: 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 est..package req
3370: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
3380: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
3390: 5b 6c 69 73 74 20 73 65 74 20 78 20 64 6f 6e 65 [list set x done
33a0: 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ]]. }. put
33b0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
33c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
33d0: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
33e0: 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 73 e 0 -certfile $s
33f0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
3400: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3410: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
3420: 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 30 \]". puts
3430: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
3440: 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 t {sock addr por
3450: 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c t} {.. global
3460: 20 78 0a 09 20 20 20 20 70 75 74 73 20 22 5b 67 x.. puts "[g
3470: 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 72 ets $sock] $addr
3480: 22 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 6f ".. close $so
3490: 63 6b 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f ck.. set x do
34a0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
34b0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
34c0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
34d0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
34e0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
34f0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3500: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3510: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3520: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3530: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
3540: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
3550: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
3560: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d -require 0 \..-
3570: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
3580: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3590: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
35a0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
35b0: 30 2e 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 0.0.1 8830} sock
35c0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 73 6f 63 ]} {..set x $soc
35d0: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 k. } else {..
35e0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
35f0: 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 ..catch {flush $
3600: 73 6f 63 6b 7d 0a 09 6c 61 70 70 65 6e 64 20 78 sock}..lappend x
3610: 20 5b 67 65 74 73 20 24 66 5d 0a 09 63 6c 6f 73 [gets $f]..clos
3620: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3630: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3640: 65 74 20 78 0a 7d 20 2d 72 65 73 75 6c 74 20 7b et x.} -result {
3650: 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 37 ready {hello 127
3660: 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 74 .0.0.1}}..test t
3670: 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 6f lsIO-2.4 {tcp co
3680: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 73 65 nnection with se
3690: 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 20 73 rver interface s
36a0: 70 65 63 69 66 69 65 64 7d 20 2d 63 6f 6e 73 74 pecified} -const
36b0: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 73 raints {socket s
36c0: 74 64 69 6f 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 tdio} -body {.
36d0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
36e0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
36f0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
3700: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
3710: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
3720: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
3730: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
3740: 20 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 prefer latest..
3750: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3760: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
3770: 61 66 74 65 72 20 32 30 30 30 20 5b 6c 69 73 74 after 2000 [list
3780: 20 73 65 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 set x done]].
3790: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
37a0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
37b0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
37c0: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d ept -require 0 -
37d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
37e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
37f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
3800: 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 erverKey -myaddr
3810: 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 20 localhost 8831
3820: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3830: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3840: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
3850: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
3860: 09 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 . puts "[gets
3870: 20 24 73 6f 63 6b 5d 22 0a 09 20 20 20 20 63 6c $sock]".. cl
3880: 6f 73 65 20 24 73 6f 63 6b 0a 09 20 20 20 20 73 ose $sock.. s
3890: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
38a0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
38b0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
38c0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
38d0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
38e0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
38f0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3900: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3910: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3920: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
3930: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3940: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
3950: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
3960: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
3970: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
3980: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f le $clientKey lo
3990: 63 61 6c 68 6f 73 74 20 38 38 33 31 7d 20 73 6f calhost 8831} so
39a0: 63 6b 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 73 ck]} {..set x $s
39b0: 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ock. } else {
39c0: 0a 09 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c ..puts $sock hel
39d0: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
39e0: 09 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 .lappend x [gets
39f0: 20 24 66 5d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 $f]..close $soc
3a00: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
3a10: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
3a20: 20 2d 72 65 73 75 6c 74 20 7b 72 65 61 64 79 20 -result {ready
3a30: 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 hello}..test tls
3a40: 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e IO-2.5 {tcp conn
3a50: 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 ection with redu
3a60: 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 ndant server por
3a70: 74 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 t} -constraints
3a80: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 2d {socket stdio} -
3a90: 62 6f 64 79 20 7b 0a 20 20 20 20 72 65 6d 6f 76 body {. remov
3aa0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3ab0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3ac0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3ad0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
3ae0: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
3af0: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
3b00: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
3b10: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
3b20: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3b30: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3b40: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 000 [list set x
3b50: 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 done]]. }.
3b60: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3b70: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3b80: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
3b90: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
3ba0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
3bb0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3bc0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3bd0: 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 y 8832 \]". p
3be0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3bf0: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3c00: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
3c10: 6f 62 61 6c 20 78 0a 09 20 20 20 20 70 75 74 73 obal x.. puts
3c20: 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a "[gets $sock]".
3c30: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b . close $sock
3c40: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
3c50: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
3c60: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3c70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3c80: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
3c90: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3ca0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3cb0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3cc0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3cd0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
3ce0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
3cf0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 {tls::socket -re
3d00: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
3d10: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3d20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3d30: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3d40: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
3d50: 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 09 73 832} sock]} {..s
3d60: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
3d70: 20 65 6c 73 65 20 7b 0a 09 70 75 74 73 20 24 73 else {..puts $s
3d80: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
3d90: 20 24 73 6f 63 6b 0a 09 6c 61 70 70 65 6e 64 20 $sock..lappend
3da0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 09 63 6c 6f x [gets $f]..clo
3db0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3dc0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3dd0: 73 65 74 20 78 0a 7d 20 2d 72 65 73 75 6c 74 20 set x.} -result
3de0: 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 {ready hello}..t
3df0: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 est tlsIO-2.6 {t
3e00: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 2d cp connection} -
3e10: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
3e20: 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 ket} -body {.
3e30: 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 set status ok.
3e40: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
3e50: 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 set sock [tls::s
3e60: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
3e70: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 127.0.0.1 8833]
3e80: 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 }]} {..if {![cat
3e90: 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d ch {gets $sock}]
3ea0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
3eb0: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
3ec0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3ed0: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a . set status.
3ee0: 7d 20 2d 72 65 73 75 6c 74 20 6f 6b 0a 0a 74 65 } -result ok..te
3ef0: 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 st tlsIO-2.7 {ec
3f00: 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c ho server, one l
3f10: 69 6e 65 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 ine} -constraint
3f20: 73 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d s {socket stdio}
3f30: 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 72 65 6d -body {. rem
3f40: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3f50: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3f60: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3f70: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
3f80: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
3f90: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
3fa0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
3fb0: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
3fc0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
3fd0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
3fe0: 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 2000 [list set
3ff0: 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 x done]]. }.
4000: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
4010: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
4020: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
4030: 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 require 0 -certf
4040: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
4050: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4060: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
4070: 4b 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 Key 8834 \]".
4080: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
4090: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
40a0: 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 {.. fileevent
40b0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
40c0: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
40d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
40e0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
40f0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
4100: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
4110: 20 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 5b {.. set l [
4120: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 20 69 gets $s].. i
4130: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
4140: 09 20 67 6c 6f 62 61 6c 20 78 0a 09 09 20 63 6c . global x... cl
4150: 6f 73 65 20 24 73 0a 09 09 20 73 65 74 20 78 20 ose $s... set x
4160: 64 6f 6e 65 0a 09 20 20 20 20 20 7d 20 65 6c 73 done.. } els
4170: 65 20 7b 0a 09 09 20 70 75 74 73 20 24 73 20 24 e {... puts $s $
4180: 6c 0a 09 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 l.. }..}..pu
4190: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
41a0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
41b0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
41c0: 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 ..puts done.
41d0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
41e0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
41f0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
4200: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
4210: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
4220: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
4230: 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 s::socket -requi
4240: 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 re 0 -certfile $
4250: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
4260: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4270: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4280: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 y 127.0.0.1 8834
4290: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
42a0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
42b0: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
42c0: 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 lf. puts $s
42d0: 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 "hello abcdefghi
42e0: 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 jklmnop". aft
42f0: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
4300: 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 x [gets $s].
4310: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
4320: 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 y [gets $f].
4330: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 close $f. li
4340: 73 74 20 24 78 20 24 79 0a 7d 20 2d 72 65 73 75 st $x $y.} -resu
4350: 6c 74 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 lt {{hello abcde
4360: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e fghijklmnop} don
4370: 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 e}..test tlsIO-2
4380: 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c .8 {echo server,
4390: 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 loop 50 times,
43a0: 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f single connectio
43b0: 6e 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 n} -constraints
43c0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 2d {socket stdio} -
43d0: 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 74 20 66 body {. set f
43e0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
43f0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
4400: 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 st set auto_path
4410: 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 $auto_path].
4420: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
4430: 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 65 73 age prefer lates
4440: 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 t..package requi
4450: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
4460: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
4470: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
4480: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
4490: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
44a0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
44b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
44c0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
44d0: 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 y 8835 \]". p
44e0: 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 uts $f {..fconfi
44f0: 67 75 72 65 20 24 66 20 2d 62 6c 6f 63 6b 69 6e gure $f -blockin
4500: 67 20 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 1 -buffering l
4510: 69 6e 65 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ine..proc accept
4520: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
4530: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4540: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
4550: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
4560: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
4570: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
4580: 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 ine..}..proc ech
4590: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f o {s} {.. glo
45a0: 62 61 6c 20 69 0a 09 20 20 20 20 73 65 74 20 6c bal i.. set l
45b0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
45c0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
45d0: 09 09 67 6c 6f 62 61 6c 20 78 0a 09 09 63 6c 6f ..global x...clo
45e0: 73 65 20 24 73 0a 09 09 73 65 74 20 78 20 64 6f se $s...set x do
45f0: 6e 65 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 ne.. } elseif
4600: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
4610: 20 24 6c 5d 20 3e 20 30 7d 20 7b 0a 09 09 69 6e $l] > 0} {...in
4620: 63 72 20 69 0a 09 09 70 75 74 73 20 24 73 20 24 cr i...puts $s $
4630: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 l.. }..}..set
4640: 20 69 20 30 0a 09 70 75 74 73 20 72 65 61 64 79 i 0..puts ready
4650: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
4660: 65 72 20 32 30 30 30 30 20 5b 6c 69 73 74 20 73 er 20000 [list s
4670: 65 74 20 78 20 74 69 6d 65 2d 6f 75 74 5d 5d 0a et x time-out]].
4680: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
4690: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
46a0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 24 lose $f..puts "$
46b0: 78 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 x $i". }.
46c0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
46d0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
46e0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
46f0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
4700: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4710: 24 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 20 2d $f -blocking 1 -
4720: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
4730: 20 20 20 67 65 74 73 20 24 66 20 76 61 72 0a 20 gets $f var.
4740: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
4750: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
4760: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4770: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4780: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4790: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
47a0: 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 7.0.0.1 8835].
47b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
47c0: 2d 62 6c 6f 63 6b 69 6e 67 20 31 20 2d 62 75 66 -blocking 1 -buf
47d0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
47e0: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
47f0: 73 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 s. catch {..f
4800: 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 or {set x 0} {$x
4810: 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 < 50} {incr x}
4820: 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 22 {.. puts $s "
4830: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
4840: 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 klmnop".. get
4850: 73 20 24 73 20 76 61 72 0a 09 7d 0a 20 20 20 20 s $s var..}.
4860: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
4870: 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 catch {set x
4880: 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 [gets $f]}. c
4890: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 0a atch {close $f}.
48a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 73 set x.} -res
48b0: 75 6c 74 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 ult {done 50}..t
48c0: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 est tlsIO-2.9 {s
48d0: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
48e0: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
48f0: 63 6b 65 74 20 73 74 64 69 6f 7d 20 2d 62 6f 64 cket stdio} -bod
4900: 79 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 y {. set s [t
4910: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4920: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
4930: 72 65 20 30 20 38 38 32 38 5d 0a 20 20 20 20 72 re 0 8828]. r
4940: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4950: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4960: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4970: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
4980: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
4990: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
49a0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 0a -nonewline $f {.
49b0: 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 20 .package prefer
49c0: 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 latest..package
49d0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 require tls..tls
49e0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
49f0: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
4a00: 20 30 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 20 0 8828. }.
4a10: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4a20: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4a30: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4a40: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4a50: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
4a60: 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 after 100.
4a70: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
4a80: 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d tch {close $f} m
4a90: 73 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 sg] [string rang
4aa0: 65 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 e $msg 0 43]].
4ab0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
4ac0: 65 74 20 78 0a 7d 20 2d 72 65 73 75 6c 74 20 7b et x.} -result {
4ad0: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
4ae0: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
4af0: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d already in use}
4b00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
4b10: 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 10 {close on acc
4b20: 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f ept, accepted so
4b30: 63 6b 65 74 20 6c 69 76 65 73 7d 20 2d 63 6f 6e cket lives} -con
4b40: 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 straints {socket
4b50: 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 } -body {. se
4b60: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 t done 0. set
4b70: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
4b80: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 64 6f 000 [list set do
4b90: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 ne timed_out]].
4ba0: 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a set ss [tls::
4bb0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4bc0: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
4bd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
4be0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
4bf0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4c00: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
4c10: 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 30]. proc acc
4c20: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
4c30: 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 lobal ss..close
4c40: 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $ss..fileevent $
4c50: 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 s readable "read
4c60: 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 it $s"..fconfigu
4c70: 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a re $s -trans lf.
4c80: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
4c90: 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f eadit {s} {..glo
4ca0: 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 bal done..gets $
4cb0: 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 s..close $s..set
4cc0: 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 done 1. }.
4cd0: 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 set cs [tls::s
4ce0: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
4cf0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4d00: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4d10: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4d20: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f le $clientKey lo
4d30: 63 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 calhost 8830].
4d40: 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 close $cs..
4d50: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
4d60: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
4d70: 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 mer. set done
4d80: 0a 7d 20 2d 72 65 73 75 6c 74 20 31 0a 0a 74 65 .} -result 1..te
4d90: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 st tlsIO-2.11 {d
4da0: 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 etecting new dat
4db0: 61 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 a} -constraints
4dc0: 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b {socket} -body {
4dd0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
4de0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
4df0: 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e 20 al sock..# when
4e00: 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 doing an in-proc
4e10: 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 ess client/serve
4e20: 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 r test, both sid
4e30: 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 es need..# to be
4e40: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f non-blocking fo
4e50: 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 r the TLS handsh
4e60: 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 ake. Also make
4e70: 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 72 sure..# to retur
4e80: 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f n the channel to
4e90: 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 line buffering
4ea0: 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 mode...fconfigur
4eb0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
4ec0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4ed0: 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 66 ..set sock $s..f
4ee0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
4ef0: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
4f00: 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 20 ndshake $s].
4f10: 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }.. set s [tl
4f20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4f30: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
4f40: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
4f50: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4f60: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4f70: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4f80: 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 rKey 8400]. s
4f90: 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 et sock "". s
4fa0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
4fb0: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 et -require 0 -c
4fc0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4fd0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4fe0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4ff0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
5000: 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 23 .0.1 8400]. #
5010: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
5020: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
5030: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
5040: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 th sides need.
5050: 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c # to be non-bl
5060: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
5070: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c LS handshake Al
5080: 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a so make sure to.
5090: 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 # return the
50a0: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 channel to line
50b0: 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 buffering mode
50c0: 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 (TLS sets it to
50d0: 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 'none').. fco
50e0: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 6c 6f nfigure $s2 -blo
50f0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
5100: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 ng line. vwai
5110: 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 t sock. puts
5120: 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 $s2 one. flus
5130: 68 20 24 73 32 0a 20 20 20 20 23 20 6e 65 65 64 h $s2. # need
5140: 20 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c update to compl
5150: 65 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b ete TLS handshak
5160: 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 e in-process.
5170: 20 75 70 64 61 74 65 0a 20 20 20 20 61 66 74 65 update. afte
5180: 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 r 500. fconfi
5190: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
51a0: 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 king 0. set r
51b0: 65 73 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 73 esult a:[gets $s
51c0: 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 ock]. lappend
51d0: 20 72 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 20 result b:[gets
51e0: 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 $sock]. fconf
51f0: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
5200: 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 cking 1. puts
5210: 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 $s2 two. flu
5220: 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 sh $s2. fconf
5230: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
5240: 63 6b 69 6e 67 20 31 0a 20 20 20 20 6c 61 70 70 cking 1. lapp
5250: 65 6e 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 65 end result c:[ge
5260: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
5270: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
5280: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 blocking 1. c
5290: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
52a0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
52b0: 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 $sock. set re
52c0: 73 75 6c 74 0a 7d 20 2d 72 65 73 75 6c 74 20 7b sult.} -result {
52d0: 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 6f 7d 0a a:one b: c:two}.
52e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 .test tlsIO-2.12
52f0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
5300: 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 ; no certificate
5310: 73 20 73 70 65 63 69 66 69 65 64 7d 20 5c 0a 09 s specified} \..
5320: 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 -constraints {s
5330: 6f 63 6b 65 74 20 73 74 64 69 6f 20 75 6e 69 78 ocket stdio unix
5340: 4f 6e 6c 79 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 Only} -body {.
5350: 20 20 23 20 54 68 65 72 65 20 69 73 20 61 20 64 # There is a d
5360: 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f ebug assertion o
5370: 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 n Windows/SSL th
5380: 61 74 20 63 61 75 73 65 73 20 61 20 63 72 61 73 at causes a cras
5390: 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 h when the. #
53a0: 20 63 65 72 74 69 66 69 63 61 74 65 20 69 73 6e certificate isn
53b0: 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 't specified..
53c0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
53d0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
53e0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
53f0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
5400: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
5410: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
5420: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
5430: 20 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 prefer latest..
5440: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5450: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
5460: 61 66 74 65 72 20 32 30 30 30 20 5b 6c 69 73 74 after 2000 [list
5470: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
5480: 5d 5d 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a ]]..set f [tls::
5490: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
54a0: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
54b0: 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 8828]..proc acc
54c0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
54d0: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
54e0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
54f0: 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 done.. close
5500: 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 $file..}..puts r
5510: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
5520: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
5530: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
5540: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
5550: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5560: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5570: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5580: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
5590: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
55a0: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
55b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
55c0: 69 72 65 20 30 20 31 32 37 2e 30 2e 30 2e 31 20 ire 0 127.0.0.1
55d0: 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 8828} msg]} {..s
55e0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
55f0: 65 6c 73 65 20 7b 0a 09 6c 61 70 70 65 6e 64 20 else {..lappend
5600: 78 20 5b 67 65 74 73 20 24 66 5d 0a 09 63 6c 6f x [gets $f]..clo
5610: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5620: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
5630: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
5640: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 2d $f. set x.} -
5650: 72 65 73 75 6c 74 20 7b 72 65 61 64 79 20 64 6f result {ready do
5660: 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ne {}}..test tls
5670: 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 IO-3.1 {socket c
5680: 6f 6e 66 6c 69 63 74 7d 20 2d 63 6f 6e 73 74 72 onflict} -constr
5690: 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 73 74 aints {socket st
56a0: 64 69 6f 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 dio} -body {.
56b0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
56c0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
56d0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
56e0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
56f0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
5700: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
5710: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
5720: 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 70 prefer latest..p
5730: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
5740: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
5750: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
5760: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5770: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
5780: 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 73 e 0 -certfile $s
5790: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
57a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
57b0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
57c0: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
57d0: 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 $f {..puts ready
57e0: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c ..gets stdin..cl
57f0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
5800: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5810: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
5820: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5830: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5840: 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 +]. gets $f.
5850: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
5860: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5870: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
5880: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 t -require 0 \..
5890: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
58a0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
58b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
58c0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 38 38 le $clientKey 88
58d0: 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 28} msg] \...$ms
58e0: 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 g]. puts $f b
58f0: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ye. close $f.
5900: 20 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 73 set x.} -res
5910: 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 ult {1 {couldn't
5920: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
5930: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
5940: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
5950: 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 IO-3.2 {server w
5960: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
5970: 6e 74 73 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 nts} -constraint
5980: 73 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d s {socket stdio}
5990: 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 72 65 6d -body {. rem
59a0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
59b0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
59c0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
59d0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
59e0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
59f0: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
5a00: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
5a10: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
5a20: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5a30: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
5a40: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 000 [list set x
5a50: 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 timed_out]]..set
5a60: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
5a70: 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d [list set x tim
5a80: 65 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 74 33 ed_out]]..set t3
5a90: 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 5b 6c [after 32000 [l
5aa0: 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f ist set x timed_
5ab0: 6f 75 74 5d 5d 0a 09 73 65 74 20 63 6f 75 6e 74 out]]..set count
5ac0: 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 er 0. }. p
5ad0: 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b uts $f "set s \[
5ae0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5af0: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
5b00: 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 ire 0 -certfile
5b10: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
5b20: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5b30: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
5b40: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
5b50: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
5b60: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
5b70: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
5b80: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
5b90: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
5ba0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5bb0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 ering line..}..p
5bc0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
5bd0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 global x..
5be0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
5bf0: 24 73 5d 0a 09 20 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
5c00: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 20 63 6c 6f of $s]} {... clo
5c10: 73 65 20 24 73 0a 09 09 20 73 65 74 20 78 20 64 se $s... set x d
5c20: 6f 6e 65 0a 09 20 20 20 20 20 7d 20 65 6c 73 65 one.. } else
5c30: 20 7b 0a 09 09 20 70 75 74 73 20 24 73 20 24 6c {... puts $s $l
5c40: 0a 09 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 .. }..}..put
5c50: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
5c60: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5c70: 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t1..vwait x..aft
5c80: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 er cancel $t2..v
5c90: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5ca0: 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 ncel $t3..close
5cb0: 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 $s..puts $x.
5cc0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
5cd0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
5ce0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
5cf0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
5d00: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 t]" r+]. set
5d10: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
5d20: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
5d30: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
5d40: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5d50: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
5d60: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5d70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
5d80: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
5d90: 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 8828]. fconf
5da0: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
5db0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
5dc0: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
5dd0: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 t -require 0 \..
5de0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
5df0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5e00: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5e10: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5e20: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
5e30: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
5e40: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
5e50: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
5e60: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
5e70: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
5e80: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
5e90: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5ea0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5eb0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
5ec0: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
5ed0: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5ee0: 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 e $s3 -buffering
5ef0: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 line. for {s
5f00: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
5f10: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 0} {incr i} {..p
5f20: 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c uts $s1 hello,tl
5f30: 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 74 73 sIO-3.2,s1..gets
5f40: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 $s1..puts $s2 h
5f50: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 ello,tlsIO-3.2,s
5f60: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 2..gets $s2..put
5f70: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 s $s3 hello,tlsI
5f80: 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 20 24 O-3.2,s3..gets $
5f90: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
5fa0: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
5fb0: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
5fc0: 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 s3. lappend x
5fd0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
5fe0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5ff0: 78 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 72 65 61 x.} -result {rea
6000: 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 dy done}..test t
6010: 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 lsIO-4.1 {server
6020: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
6030: 69 65 6e 74 73 7d 20 2d 63 6f 6e 73 74 72 61 69 ients} -constrai
6040: 6e 74 73 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 nts {socket stdi
6050: 6f 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 23 o} -body {. #
6060: 20 68 61 76 65 20 73 65 65 6e 20 69 6e 74 65 72 have seen inter
6070: 6d 69 74 74 65 6e 74 20 68 61 6e 67 73 20 6f 6e mittent hangs on
6080: 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 72 65 6d Windows. rem
6090: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
60a0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
60b0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
60c0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
60d0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
60e0: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
60f0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
6100: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
6110: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
6120: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
6130: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
6140: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
6150: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
6160: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
6170: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6180: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
6190: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
61a0: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
61b0: 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 ts $f {..fconfig
61c0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
61d0: 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 g line..for {set
61e0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
61f0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
6200: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 puts $s hello..
6210: 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 gets $s..}..
6220: 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 close $s..puts b
6230: 79 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 ye..gets stdin.
6240: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
6250: 66 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 f. set p1 [op
6260: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
6270: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
6280: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
6290: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d fconfigure $p1 -
62a0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
62b0: 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 set p2 [open
62c0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
62d0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
62e0: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
62f0: 6e 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 nfigure $p2 -buf
6300: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
6310: 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b set p3 [open "|[
6320: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
6330: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
6340: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
6350: 67 75 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 gure $p3 -buffer
6360: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f ing line. pro
6370: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
6380: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
6390: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
63a0: 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 e..fileevent $s
63b0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
63c0: 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 cho $s]. }.
63d0: 20 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 proc echo {s}
63e0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
63f0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
6400: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
6410: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
6420: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 20 65 set x done..} e
6430: 6c 73 65 20 7b 0a 09 20 20 20 20 70 75 74 73 20 lse {.. puts
6440: 24 73 20 24 6c 0a 09 7d 0a 20 20 20 20 7d 0a 20 $s $l..}. }.
6450: 20 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 set t1 [after
6460: 20 33 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 30000 [list set
6470: 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 x timed_out]].
6480: 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 set t2 [after
6490: 20 33 31 30 30 30 20 5b 6c 69 73 74 20 73 65 74 31000 [list set
64a0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 x timed_out]].
64b0: 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 set t3 [after
64c0: 20 33 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 32000 [list set
64d0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 x timed_out]].
64e0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
64f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6500: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
6510: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
6520: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6530: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6540: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6550: 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 8828]. puts
6560: 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p1 open. put
6570: 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 s $p2 open. p
6580: 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 uts $p3 open.
6590: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
65a0: 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 it x. vwait x
65b0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
65c0: 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 l $t1. after
65d0: 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 cancel $t2. a
65e0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
65f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6600: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
6610: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 ppend l [list p1
6620: 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a [gets $p1] $x].
6630: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6640: 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 ist p2 [gets $p2
6650: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
6660: 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 d l [list p3 [ge
6670: 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 ts $p3] $x].
6680: 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 puts $p1 bye.
6690: 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 puts $p2 bye.
66a0: 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 puts $p3 bye.
66b0: 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 close $p1.
66c0: 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 close $p2. c
66d0: 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 lose $p3. set
66e0: 20 6c 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 7b 70 l.} -result {{p
66f0: 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 1 bye done} {p2
6700: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 bye done} {p3 by
6710: 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 e done}}..test t
6720: 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f lsIO-4.2 {byte o
6730: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
6740: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
6750: 74 6f 6e 73 7d 20 2d 63 6f 6e 73 74 72 61 69 6e tons} -constrain
6760: 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 ts {socket} -bod
6770: 79 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b y {. set x ok
6780: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
6790: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
67a0: 72 76 65 72 20 64 6f 64 6f 20 2d 72 65 71 75 69 rver dodo -requi
67b0: 72 65 20 30 20 30 78 33 30 30 30 7d 20 6d 73 67 re 0 0x3000} msg
67c0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 ]} {..set x $msg
67d0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 . } else {..c
67e0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
67f0: 20 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 73 set x.} -res
6800: 75 6c 74 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 ult ok..test tls
6810: 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 IO-5.1 {byte ord
6820: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
6830: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
6840: 6e 73 7d 20 5c 0a 09 20 2d 63 6f 6e 73 74 72 61 ns} \.. -constra
6850: 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 75 6e 69 ints {socket uni
6860: 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 2d xOnly notRoot} -
6870: 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 74 20 78 body {. set x
6880: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
6890: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
68a0: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
68b0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
68c0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 2d 72 65 -server dodo -re
68d0: 71 75 69 72 65 20 30 20 30 78 31 7d 20 6d 73 67 quire 0 0x1} msg
68e0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f ]} {..set x {hto
68f0: 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 ns problem, shou
6900: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
6910: 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e , are you runnin
6920: 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 g as SU?}..close
6930: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6940: 73 65 74 20 78 0a 7d 20 2d 72 65 73 75 6c 74 20 set x.} -result
6950: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
6960: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
6970: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e }..test tlsIO-5.
6980: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
6990: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
69a0: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 2d umbers, htons} -
69b0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
69c0: 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 ket} -body {.
69d0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
69e0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
69f0: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
6a00: 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 gh}. if {![ca
6a10: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
6a20: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 2d 72 -server dodo -r
6a30: 65 71 75 69 72 65 20 30 20 30 78 31 30 30 30 30 equire 0 0x10000
6a40: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
6a50: 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f {port resolutio
6a60: 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c n problem, shoul
6a70: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d d be disallowed}
6a80: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
6a90: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 2d }. set x.} -
6aa0: 72 65 73 75 6c 74 20 7b 63 6f 75 6c 64 6e 27 74 result {couldn't
6ab0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
6ac0: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
6ad0: 67 68 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d gh}..test tlsIO-
6ae0: 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.3 {byte order
6af0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
6b00: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
6b10: 20 5c 0a 09 2d 63 6f 6e 73 74 72 61 69 6e 74 73 \..-constraints
6b20: 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c {socket unixOnl
6b30: 79 20 6e 6f 74 52 6f 6f 74 7d 20 2d 62 6f 64 79 y notRoot} -body
6b40: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
6b50: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
6b60: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 et: not owner}.
6b70: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
6b80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6b90: 76 65 72 20 64 6f 64 6f 20 2d 72 65 71 75 69 72 ver dodo -requir
6ba0: 65 20 30 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a e 0 21} msg]} {.
6bb0: 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 .set x {htons pr
6bc0: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
6bd0: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
6be0: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
6bf0: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
6c00: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
6c10: 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 63 6f 75 6c .} -result {coul
6c20: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
6c30: 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 : not owner}..te
6c40: 73 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 st tlsIO-6.1 {ac
6c50: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
6c60: 72 6f 72 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 ror} -constraint
6c70: 73 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d s {socket stdio}
6c80: 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 23 20 54 -body {. # T
6c90: 68 65 72 65 20 69 73 20 61 20 64 65 62 75 67 20 here is a debug
6ca0: 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e assertion on Win
6cb0: 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 dows/SSL that ca
6cc0: 75 73 65 73 20 61 20 63 72 61 73 68 20 77 68 65 uses a crash whe
6cd0: 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 n the. # cert
6ce0: 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 ificate isn't sp
6cf0: 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d ecified.. rem
6d00: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
6d10: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
6d20: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
6d30: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
6d40: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
6d50: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
6d60: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
6d70: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
6d80: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
6d90: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
6da0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
6db0: 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d st tls::socket -
6dc0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 cafile $caCert 1
6dd0: 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 5d 0a 20 27.0.0.1 8848].
6de0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6df0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6e00: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6e10: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6e20: 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 r+]. proc bg
6e30: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
6e40: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
6e50: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 rgs. }. pr
6e60: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6e70: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
6e80: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6e90: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6ea0: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
6eb0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
6ec0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
6ed0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6ee0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6ef0: 79 20 38 38 34 38 5d 0a 20 20 20 20 70 75 74 73 y 8848]. puts
6f00: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c $f hello. cl
6f10: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 ose $f. set t
6f20: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6f30: 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 0 [list set x ti
6f40: 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 76 77 med_out]]. vw
6f50: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6f60: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6f70: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
6f80: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
6f90: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 2d 72 65 . set x.} -re
6fa0: 73 75 6c 74 20 7b 7b 64 69 76 69 64 65 20 62 79 sult {{divide by
6fb0: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c zero}}..test tl
6fc0: 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 sIO-7.1 {testing
6fd0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6fe0: 20 6f 70 74 69 6f 6e 73 7d 20 2d 63 6f 6e 73 74 options} -const
6ff0: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 73 raints {socket s
7000: 74 64 69 6f 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 tdio} -body {.
7010: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
7020: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
7030: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
7040: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
7050: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
7060: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
7070: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
7080: 20 70 72 65 66 65 72 20 6c 61 74 65 73 74 0a 09 prefer latest..
7090: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
70a0: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
70b0: 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a ts $f [list tls:
70c0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
70d0: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
70e0: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
70f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7100: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7110: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7120: 65 79 20 38 38 32 30 5d 0a 20 20 20 20 70 75 74 ey 8820]. put
7130: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
7140: 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 ept args {..
7150: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
7160: 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 t x done..}..put
7170: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d s ready..set tim
7180: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
7190: 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 [list set x time
71a0: 64 5f 6f 75 74 5d 5d 0a 09 76 77 61 69 74 20 78 d_out]]..vwait x
71b0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
71c0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
71d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
71e0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
71f0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
7200: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
7210: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
7220: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7230: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
7240: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7250: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7260: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7270: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
7280: 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 0.0.1 8820].
7290: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
72a0: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
72b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
72c0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
72d0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
72e0: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
72f0: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
7300: 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 0] 127.0.0.1].
7310: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
7320: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
7330: 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a dex $p 2] 8820].
7340: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
7350: 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 2d 72 65 length $p].} -re
7360: 73 75 6c 74 20 7b 30 20 30 20 33 7d 0a 0a 74 65 sult {0 0 3}..te
7370: 73 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 st tlsIO-7.2 {te
7380: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7390: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 2d cific options} -
73a0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
73b0: 6b 65 74 20 73 74 64 69 6f 7d 20 2d 62 6f 64 79 ket stdio} -body
73c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
73d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
73e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
73f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
7400: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
7410: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
7420: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
7430: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
7440: 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 est..package req
7450: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
7460: 20 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a puts $f "tls:
7470: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
7480: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
7490: 30 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 0 -certfile $ser
74a0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
74b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
74c0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 31 $serverKey 8821
74d0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
74e0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 .proc accept arg
74f0: 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 s {.. global
7500: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
7510: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
7520: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
7530: 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 73 er 10000 [list s
7540: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 5d 5d et x timed_out]]
7550: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
7560: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
7570: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
7580: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
7590: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
75a0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
75b0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
75c0: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
75d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
75e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
75f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7600: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7610: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7620: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
7630: 38 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 821]. set p [
7640: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
7650: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f ockname]. clo
7660: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
7670: 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $f. set l "".
7680: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
7690: 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c length $p]. l
76a0: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
76b0: 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 $p 0]. lappe
76c0: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 nd l [string equ
76d0: 61 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d al [lindex $p 2]
76e0: 20 38 38 32 31 5d 0a 7d 20 2d 72 65 73 75 6c 74 8821].} -result
76f0: 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d {3 127.0.0.1 0}
7700: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 ..test tlsIO-7.3
7710: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7720: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7730: 73 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 s} -constraints
7740: 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b {socket} -body {
7750: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7760: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
7770: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
7780: 30 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 0 \..-certfile $
7790: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
77a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
77b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
77c0: 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 822]. set l [
77d0: 6c 6c 65 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 llength [fconfig
77e0: 75 72 65 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f ure $s]]. clo
77f0: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 se $s. update
7800: 0a 20 20 20 20 23 20 41 20 62 75 67 20 66 69 78 . # A bug fix
7810: 65 64 20 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 ed in fconfigure
7820: 20 66 6f 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 for 8.3.4+ make
7830: 20 74 68 69 73 20 72 65 74 75 72 6e 20 31 34 20 this return 14
7840: 6e 6f 72 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 normally,. #
7850: 62 75 74 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 but 12 in older
7860: 76 65 72 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 versions.. ex
7870: 70 72 20 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 pr {$l >= 12 &&
7880: 28 28 24 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d (($l % 2) == 0)}
7890: 0a 7d 20 2d 72 65 73 75 6c 74 20 31 0a 0a 23 20 .} -result 1..#
78a0: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
78b0: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
78c0: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
78d0: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
78e0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 ..test tlsIO-7.4
78f0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7900: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7910: 73 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 s} -constraints
7920: 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b {socket} -body {
7930: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7940: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
7950: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
7960: 30 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 0 \..-certfile $
7970: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7980: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7990: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
79a0: 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 823]. proc ac
79b0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
79c0: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
79d0: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
79e0: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
79f0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
7a00: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
7a10: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
7a20: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7a30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7a40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7a50: 0a 09 6c 6f 63 61 6c 68 6f 73 74 20 38 38 32 33 ..localhost 8823
7a60: 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ]. set timer
7a70: 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 [after 10000 [li
7a80: 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f st set x timed_o
7a90: 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut]]. vwait x
7aa0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
7ab0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
7ac0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
7ad0: 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $s1. set l ""
7ae0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
7af0: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
7b00: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 2d 72 65 73 ength $x].} -res
7b10: 75 6c 74 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 ult {8823 3}..#
7b20: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
7b30: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
7b40: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
7b50: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
7b60: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 ..test tlsIO-7.5
7b70: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7b80: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7b90: 73 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 s} -constraints
7ba0: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 {socket unixOrPc
7bb0: 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 } -body {. se
7bc0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7bd0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7be0: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
7bf0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
7c00: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7c10: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7c20: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 $serverKey 8829
7c30: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
7c40: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
7c50: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 bal x..set x [fc
7c60: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 onfigure $s -soc
7c70: 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 kname]..close $s
7c80: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7c90: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 1 [tls::socket \
7ca0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
7cb0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
7cc0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7cd0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
7ce0: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
7cf0: 20 38 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 8829]. set t
7d00: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
7d10: 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 0 [list set x ti
7d20: 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 76 77 med_out]]. vw
7d30: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
7d40: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
7d50: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7d60: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7d70: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
7d80: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
7d90: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
7da0: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 2d [llength $x].} -
7db0: 72 65 73 75 6c 74 20 7b 31 32 37 2e 30 2e 30 2e result {127.0.0.
7dc0: 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 1 8829 3}..test
7dd0: 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 69 tlsIO-8.1 {testi
7de0: 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f ng -async flag o
7df0: 6e 20 73 6f 63 6b 65 74 73 7d 20 2d 63 6f 6e 73 n sockets} -cons
7e00: 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d traints {socket}
7e10: 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 23 20 4e -body {. # N
7e20: 4f 54 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d OTE: This test m
7e30: 61 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 ay fail on some
7e40: 53 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 Solaris 2.4 syst
7e50: 65 6d 73 2e 0a 20 20 20 20 23 20 53 65 65 20 6e ems.. # See n
7e60: 6f 74 65 73 20 69 6e 20 54 63 6c 27 73 20 73 6f otes in Tcl's so
7e70: 63 6b 65 74 2e 74 65 73 74 2e 0a 20 20 20 20 73 cket.test.. s
7e80: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7e90: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
7ea0: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 -require 0 \..
7eb0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
7ec0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
7ed0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7ee0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
7ef0: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
7f00: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7f10: 6f 62 61 6c 20 78 0a 09 23 20 57 68 65 6e 20 64 obal x..# When d
7f20: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
7f30: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
7f40: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
7f50: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 09 23 20 s need to be..#
7f60: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 non-blocking for
7f70: 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 the TLS handsha
7f80: 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 ke. Also make s
7f90: 75 72 65 20 74 6f 20 72 65 74 75 72 6e 20 74 68 ure to return th
7fa0: 65 0a 09 23 20 63 68 61 6e 6e 65 6c 20 74 6f 20 e..# channel to
7fb0: 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d line buffering m
7fc0: 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 ode...fconfigure
7fd0: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
7fe0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7ff0: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 73 65 .puts $s bye..se
8000: 74 20 78 20 61 63 63 65 70 74 65 64 0a 20 20 20 t x accepted.
8010: 20 7d 0a 20 20 20 20 70 72 6f 63 20 63 6f 6e 6e }. proc conn
8020: 65 63 74 65 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f ected {s} {..glo
8030: 62 61 6c 20 78 0a 09 66 69 6c 65 65 76 65 6e 74 bal x..fileevent
8040: 20 24 73 20 77 72 69 74 61 62 6c 65 20 7b 7d 0a $s writable {}.
8050: 09 73 65 74 20 78 20 63 6f 6e 6e 65 63 74 65 64 .set x connected
8060: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8070: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 1 [tls::socket -
8080: 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 require 0 -certf
8090: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
80a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
80b0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
80c0: 65 6e 74 4b 65 79 20 2d 61 73 79 6e 63 20 6c 6f entKey -async lo
80d0: 63 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a 20 20 calhost 8830].
80e0: 20 20 73 65 74 20 63 20 5b 63 68 61 6e 20 63 6f set c [chan co
80f0: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 63 6f 6e nfigure $s1 -con
8100: 6e 65 63 74 69 6e 67 5d 0a 20 20 20 20 23 20 57 necting]. # W
8110: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
8120: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
8130: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
8140: 20 73 69 64 65 73 20 6e 65 65 64 20 74 6f 20 62 sides need to b
8150: 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 6c 6f 63 e. # non-bloc
8160: 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 king for the TLS
8170: 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f handshake Also
8180: 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 20 72 65 make sure to re
8190: 74 75 72 6e 20 74 68 65 0a 20 20 20 20 23 20 63 turn the. # c
81a0: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
81b0: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 20 uffering mode..
81c0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
81d0: 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 1 -blocking 0 -b
81e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
81f0: 20 20 23 20 43 72 65 61 74 65 20 61 73 79 6e 63 # Create async
8200: 20 68 61 6e 64 6c 65 72 0a 20 20 20 20 66 69 6c handler. fil
8210: 65 65 76 65 6e 74 20 24 73 31 20 77 72 69 74 61 eevent $s1 writa
8220: 62 6c 65 20 5b 6c 69 73 74 20 63 6f 6e 6e 65 63 ble [list connec
8230: 74 65 64 20 24 73 31 5d 0a 20 20 20 20 76 77 61 ted $s1]. vwa
8240: 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 68 it x. # TLS h
8250: 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 73 andshaking needs
8260: 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 74 one byte from t
8270: 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 20 he client....
8280: 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 20 puts $s1 a.
8290: 76 77 61 69 74 20 78 0a 20 20 20 20 23 20 47 65 vwait x. # Ge
82a0: 74 20 64 61 74 61 20 66 72 6f 6d 20 73 65 72 76 t data from serv
82b0: 65 72 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 er. fconfigur
82c0: 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 e $s1 -blocking
82d0: 31 0a 20 20 20 20 67 65 74 73 20 24 73 31 0a 7d 1. gets $s1.}
82e0: 20 2d 63 6c 65 61 6e 75 70 20 7b 0a 20 20 20 20 -cleanup {.
82f0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
8300: 73 65 20 24 73 31 0a 7d 20 2d 72 65 73 75 6c 74 se $s1.} -result
8310: 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f bye..test tlsIO
8320: 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 -9.1 {testing sp
8330: 75 72 69 6f 75 73 20 28 30 20 62 79 74 65 20 72 urious (0 byte r
8340: 65 61 64 29 20 65 76 65 6e 74 73 7d 20 2d 63 6f ead) events} -co
8350: 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 nstraints {socke
8360: 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 t} -body {. s
8370: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
8380: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
8390: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
83a0: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
83b0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
83c0: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
83d0: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
83e0: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
83f0: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
8400: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
8410: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
8420: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
8430: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
8440: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
8450: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
8460: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
8470: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
8480: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
8490: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
84a0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
84b0: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 s -blocking 0..f
84c0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
84d0: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
84e0: 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 ndshake $s reada
84f0: 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 5c ble readlittle \
8500: 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f ...-buffering no
8510: 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ne]. }. se
8520: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8530: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8540: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
8550: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
8560: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
8570: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8580: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 31 $serverKey 8831
8590: 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 ]. set c [tls
85a0: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
85b0: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
85c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
85d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
85e0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
85f0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 tKey \.. loca
8600: 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 lhost 8831].
8610: 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 66 # This differs f
8620: 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 rom socket-9.1 i
8630: 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 n that both side
8640: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 s need to be.
8650: 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 # non-blocking
8660: 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 because of TLS'
8670: 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 required handsha
8680: 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ke. fconfigur
8690: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
86a0: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
86b0: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
86c0: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
86d0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
86e0: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 66 0123456789. f
86f0: 6c 75 73 68 20 24 63 0a 20 20 20 20 73 65 74 20 lush $c. set
8700: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
8710: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 64 6f 6e 00 [list set don
8720: 65 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 e timed_out]].
8730: 20 20 61 66 74 65 72 20 31 30 30 30 20 5b 6c 69 after 1000 [li
8740: 73 74 20 63 6c 6f 73 65 20 24 63 5d 0a 20 20 20 st close $c].
8750: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
8760: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
8770: 6d 65 72 0a 20 20 20 20 63 61 74 63 68 20 7b 63 mer. catch {c
8780: 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 6c 69 73 lose $s}. lis
8790: 74 20 5b 65 78 70 72 20 7b 24 73 70 75 72 69 6f t [expr {$spurio
87a0: 75 73 20 3c 3d 20 31 7d 5d 20 24 6c 65 6e 0a 7d us <= 1}] $len.}
87b0: 20 2d 72 65 73 75 6c 74 20 7b 31 20 35 30 7d 0a -result {1 50}.
87c0: 23 20 57 61 73 20 30 20 35 30 0a 0a 74 65 73 74 # Was 0 50..test
87d0: 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 tlsIO-9.2 {test
87e0: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
87f0: 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 fileevents, flu
8800: 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 2d 63 6f sh on close} -co
8810: 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 nstraints {socke
8820: 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 t} -body {. s
8830: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
8840: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
8850: 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 1]. set secon
8860: 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 dblock [string r
8870: 65 70 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 epeat b 65535].
8880: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8890: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
88a0: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
88b0: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
88c0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
88d0: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
88e0: 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 readable readab
88f0: 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 le \...-translat
8900: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
8910: 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 ze 16384 -buffer
8920: 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a ing line]. }.
8930: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
8940: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
8950: 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 gets $s]..dputs
8960: 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 "got \"[string r
8970: 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 eplace $l 10 end
8980: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
8990: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
89a0: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c ]) from $s"..fil
89b0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
89c0: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
89d0: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
89e0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
89f0: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
8a00: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 l firstblock..dp
8a10: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
8a20: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 ing replace $fir
8a30: 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 stblock 10 end-3
8a40: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
8a50: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 ring length $fir
8a60: 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 stblock]) down $
8a70: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
8a80: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
8a90: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
8aa0: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
8ab0: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
8ac0: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
8ad0: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
8ae0: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8af0: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 tring replace $s
8b00: 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e econdblock 10 en
8b10: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
8b20: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
8b30: 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f secondblock]) do
8b40: 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f wn $s"..puts -no
8b50: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
8b60: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
8b70: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
8b80: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
8b90: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
8ba0: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
8bb0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8bc0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
8bd0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8be0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 39 5d 0a serverKey 8839].
8bf0: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
8c00: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
8c10: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
8c20: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
8c30: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8c40: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
8c50: 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 ey \.. localh
8c60: 6f 73 74 20 38 38 33 39 5d 0a 20 20 20 20 66 63 ost 8839]. fc
8c70: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
8c80: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c cking 0 -trans l
8c90: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
8ca0: 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 e. set count
8cb0: 30 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 65 0. puts $c he
8cc0: 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 llo. proc rea
8cd0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
8ce0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
8cf0: 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 5d t data [read $s]
8d00: 0a 09 64 70 75 74 73 20 22 72 65 61 64 20 5c 22 ..dputs "read \"
8d10: 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 [string replace
8d20: 24 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 2e $data 10 end-3 .
8d30: 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 ..]\" \...([stri
8d40: 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d ng length $data]
8d50: 29 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 ) from $s"..incr
8d60: 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c count [string l
8d70: 65 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 66 ength $data]..if
8d80: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
8d90: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
8da0: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
8db0: 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 }. fileeve
8dc0: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 5b nt $c readable [
8dd0: 6c 69 73 74 20 72 65 61 64 69 74 20 24 63 5d 0a list readit $c].
8de0: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
8df0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
8e00: 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 ter 10000 [list
8e10: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
8e20: 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut]]. vwait d
8e30: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
8e40: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
8e50: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d catch {close $c}
8e60: 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 . catch {clos
8e70: 65 20 24 73 7d 0a 20 20 20 20 6c 69 73 74 20 24 e $s}. list $
8e80: 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 2d 72 count $done.} -r
8e90: 65 73 75 6c 74 20 7b 36 35 35 36 36 20 31 7d 0a esult {65566 1}.
8ea0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 .test tlsIO-9.3
8eb0: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
8ec0: 63 6b 79 6e 65 73 73 7d 20 2d 63 6f 6e 73 74 72 ckyness} -constr
8ed0: 61 69 6e 74 73 20 7b 75 6e 65 78 70 6c 61 69 6e aints {unexplain
8ee0: 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 edFailure socket
8ef0: 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 23 20 } -body {. #
8f00: 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 HOBBS: never wor
8f10: 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 ked correctly.
8f20: 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f proc count_to_
8f30: 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 eof {s} {..globa
8f40: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d l count done tim
8f50: 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 er..set l [gets
8f60: 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $s]..if {[eof $s
8f70: 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 ]} {.. incr c
8f80: 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 ount.. if {$c
8f90: 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c ount > 9} {...cl
8fa0: 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e ose $s...set don
8fb0: 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 e true...set cou
8fc0: 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b nt {eof is stick
8fd0: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
8fe0: 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a l $timer.. }.
8ff0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
9000: 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b c timerproc {} {
9010: 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f ..global done co
9020: 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 unt c..set done
9030: 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 true..set count
9040: 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c {timer went off,
9050: 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 eof is not stic
9060: 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 ky}..close $c.
9070: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e }. set coun
9080: 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 t 0. set done
9090: 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 false. proc
90a0: 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 write_then_close
90b0: 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 {s} {..puts $s
90c0: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 bye..close $s.
90d0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
90e0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
90f0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
9100: 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 ocking 0 -buffer
9110: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
9120: 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 ation lf..fileev
9130: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
9140: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
9150: 6b 65 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 ke $s writable w
9160: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
9170: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c \...-buffering l
9180: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
9190: 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 lf]. }. s
91a0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
91b0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
91c0: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 -require 0 \..
91d0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
91e0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
91f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9200: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9210: 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 3]. set c [tl
9220: 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 s::socket -requi
9230: 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 re 0 \.. -cer
9240: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9250: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9260: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9270: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 ntKey \.. loc
9280: 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 20 20 alhost 8833].
9290: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
92a0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
92b0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
92c0: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 slation lf. f
92d0: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
92e0: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 able "count_to_e
92f0: 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 of $c". set t
9300: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
9310: 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 timerproc].
9320: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 vwait done. c
9330: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
9340: 63 6f 75 6e 74 0a 7d 20 2d 72 65 73 75 6c 74 20 count.} -result
9350: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
9360: 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 .removeFile scri
9370: 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 pt..test tlsIO-1
9380: 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 0.1 {testing soc
9390: 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 ket accept callb
93a0: 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 ack error handli
93b0: 6e 67 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 ng} -constraints
93c0: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 {socket} -body
93d0: 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 {. set goterr
93e0: 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 or 0. proc bg
93f0: 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 error args {glob
9400: 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 al goterror; set
9410: 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 goterror 1}.
9420: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
9430: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
9440: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 pt -require 0 -c
9450: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 38 38 afile $caCert 88
9460: 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 98]. proc acc
9470: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f ept {s a p} {clo
9480: 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 se $s; error}.
9490: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
94a0: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
94b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
94c0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 127.0.0.1 8898].
94d0: 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 vwait goterr
94e0: 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a or. close $s.
94f0: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
9500: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 set goterror.}
9510: 2d 72 65 73 75 6c 74 20 31 0a 0a 74 65 73 74 20 -result 1..test
9520: 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 tlsIO-11.1 {tcp
9530: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 2d 63 6f 6e connection} -con
9540: 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 straints {socket
9550: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9560: 74 65 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 20 teServer} -body
9570: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
9580: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
9590: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
95a0: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
95b0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
95c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
95d0: 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 equire 0 \...-ce
95e0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
95f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9600: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9610: 76 65 72 4b 65 79 20 38 38 33 34 5d 0a 09 70 72 verKey 8834]..pr
9620: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
9630: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9640: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9650: 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 puts $s done..
9660: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
9670: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
9680: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
9690: 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 ire 0 \.. -ce
96a0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
96b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
96c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
96d0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
96e0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
96f0: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
9700: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
9710: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
9720: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
9730: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
9740: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
9750: 2d 72 65 73 75 6c 74 20 64 6f 6e 65 0a 0a 74 65 -result done..te
9760: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 st tlsIO-11.2 {c
9770: 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 lient specifies
9780: 69 74 73 20 70 6f 72 74 7d 20 2d 63 6f 6e 73 74 its port} -const
9790: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 64 raints {socket d
97a0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
97b0: 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 20 7b 0a Server} -body {.
97c0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
97d0: 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 ists port]} {..i
97e0: 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 ncr port. } e
97f0: 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 lse {..set port
9800: 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 76 65 [expr {$tlsServe
9810: 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 rPort + [pid]%10
9820: 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 24}]. }. s
9830: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
9840: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9850: 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 .set socket9_2_t
9860: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
9870: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
9880: 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 accept -require
9890: 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 0 \...-certfile
98a0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
98b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
98c0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
98d0: 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 8835]..proc acce
98e0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
98f0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
9900: 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 $s.. puts $s
9910: 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 $p.. close $
9920: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9930: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
9940: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 t -require 0 \..
9950: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9960: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9970: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9980: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9990: 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f . -myport $po
99a0: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
99b0: 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 IP 8835]. set
99c0: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
99d0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
99e0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
99f0: 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 $socket9_2_test
9a00: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 _server}. if
9a10: 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a {$r == $port} {.
9a20: 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 .set result ok.
9a30: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
9a40: 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 result broken.
9a50: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 }. set res
9a60: 75 6c 74 0a 7d 20 2d 72 65 73 75 6c 74 20 6f 6b ult.} -result ok
9a70: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9a80: 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 3 {trying to con
9a90: 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d nect, no server}
9aa0: 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 -constraints {s
9ab0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9ac0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 2d hRemoteServer} -
9ad0: 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 74 20 73 body {. set s
9ae0: 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 tatus ok. if
9af0: 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 20 {![catch {set s
9b00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
9b10: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
9b20: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9b30: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9b40: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9b50: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9b60: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 $remoteServerIp
9b70: 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 8836]}]} {..if {
9b80: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
9b90: 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 }]} {.. set s
9ba0: 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a tatus broken..}.
9bb0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
9bc0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
9bd0: 20 2d 72 65 73 75 6c 74 20 6f 6b 0a 0a 74 65 73 -result ok..tes
9be0: 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 t tlsIO-11.4 {re
9bf0: 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c mote echo, one l
9c00: 69 6e 65 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 ine} -constraint
9c10: 73 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 s {socket doTest
9c20: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9c30: 72 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 r} -body {. s
9c40: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
9c50: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9c60: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f .set socket10_6_
9c70: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
9c80: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
9c90: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
9ca0: 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 0 \...-certfile
9cb0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9cc0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9cd0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9ce0: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
9cf0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9d00: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9d10: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
9d20: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
9d30: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
9d40: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9d50: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
9d60: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
9d70: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
9d80: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
9d90: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
9da0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
9db0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
9dc0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
9dd0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
9de0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9df0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
9e00: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
9e10: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9e20: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9e30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9e40: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9e50: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9e60: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
9e70: 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 figure $f -trans
9e80: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
9e90: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9ea0: 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 puts $f hello.
9eb0: 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 66 set r [gets $f
9ec0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
9ed0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9ee0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
9ef0: 36 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 6_test_server}.
9f00: 20 20 20 73 65 74 20 72 0a 7d 20 2d 72 65 73 75 set r.} -resu
9f10: 6c 74 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 lt hello..test t
9f20: 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 lsIO-11.5 {remot
9f30: 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 e echo, 50 lines
9f40: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
9f50: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9f60: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9f70: 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 6e 64 -body {. send
9f80: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
9f90: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9fa0: 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 t socket10_7_tes
9fb0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
9fc0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
9fd0: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
9fe0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
9ff0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a000: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a010: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
a020: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a030: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
a040: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
a050: 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 s.. fileevent
a060: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
a070: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
a080: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
a090: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
a0a0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
a0b0: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
a0c0: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
a0d0: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
a0e0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
a0f0: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
a100: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
a110: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
a120: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b }. set f [
a130: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
a140: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
a150: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a160: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a170: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a180: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a190: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a1a0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
a1b0: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
a1c0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
a1d0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
a1e0: 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 {set cnt 0} {$c
a1f0: 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 nt < 50} {incr c
a200: 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 nt} {..puts $f "
a210: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 hello, $cnt"..if
a220: 20 7b 5b 67 65 74 73 20 24 66 5d 20 6e 65 20 22 {[gets $f] ne "
a230: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 7d 20 7b 0a hello, $cnt"} {.
a240: 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 . break..}.
a250: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
a260: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a270: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
a280: 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0_7_test_server}
a290: 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 2d . set cnt.} -
a2a0: 72 65 73 75 6c 74 20 35 30 0a 0a 23 20 4d 61 63 result 50..# Mac
a2b0: 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 intosh sockets c
a2c0: 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 an have more tha
a2d0: 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 n one server per
a2e0: 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 port.if {$tcl_p
a2f0: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
a300: 29 20 65 71 20 22 6d 61 63 69 6e 74 6f 73 68 22 ) eq "macintosh"
a310: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 } {. set conf
a320: 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 lictResult {0 88
a330: 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 36}.} else {.
a340: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
a350: 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 ult {1 {couldn't
a360: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
a370: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
a380: 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 use}}.}..test t
a390: 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 lsIO-11.6 {socke
a3a0: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 2d 63 6f 6e t conflict} -con
a3b0: 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 straints {socket
a3c0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
a3d0: 74 65 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 20 teServer} -body
a3e0: 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c {. set s1 [tl
a3f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
a400: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
a410: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
a420: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a430: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a440: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
a450: 72 4b 65 79 20 38 38 33 36 5d 0a 20 20 20 20 69 rKey 8836]. i
a460: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 f {[catch {set s
a470: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 2 [tls::socket -
a480: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
a490: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
a4a0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
a4b0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
a4c0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a4d0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 7d serverKey 8836]}
a4e0: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 msg]} {..set re
a4f0: 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 sult [list 1 $ms
a500: 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a g]. } else {.
a510: 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 .set result [lis
a520: 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f t 0 [lindex [fco
a530: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 nfigure $s2 -soc
a540: 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 kname] 2]]..clos
a550: 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 e $s2. }.
a560: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
a570: 74 20 72 65 73 75 6c 74 0a 7d 20 2d 72 65 73 75 t result.} -resu
a580: 6c 74 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 lt $conflictResu
a590: 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 lt..test tlsIO-1
a5a0: 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 1.7 {server with
a5b0: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
a5c0: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
a5d0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
a5e0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
a5f0: 2d 62 6f 64 79 20 7b 0a 20 20 20 20 73 65 6e 64 -body {. send
a600: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
a610: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
a620: 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 t socket10_9_tes
a630: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
a640: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
a650: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
a660: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
a670: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a680: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a690: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
a6a0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a6b0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
a6c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
a6d0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
a6e0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
a6f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
a700: 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 cho $s]..}..proc
a710: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
a720: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
a730: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
a740: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
a750: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
a760: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
a770: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
a780: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a790: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
a7a0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a7b0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a7c0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a7d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
a7e0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
a7f0: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
a800: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 fconfigure $s1
a810: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
a820: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
a830: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
a840: 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 0 \.. -certf
a850: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a860: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a870: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a880: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a890: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
a8a0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
a8b0: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
a8c0: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
a8d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
a8e0: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
a8f0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a900: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a910: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a920: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a930: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a940: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
a950: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
a960: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
a970: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
a980: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
a990: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
a9a0: 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 31 0a 09 67 tlsIO-11.7,s1..g
a9b0: 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 ets $s1..puts $s
a9c0: 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2 hello,tlsIO-11
a9d0: 2e 37 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a .7,s2..gets $s2.
a9e0: 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c .puts $s3 hello,
a9f0: 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 33 0a 09 67 tlsIO-11.7,s3..g
aa00: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
aa10: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
aa20: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
aa30: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
aa40: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
aa50: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
aa60: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
aa70: 69 0a 7d 20 2d 72 65 73 75 6c 74 20 31 30 30 0a i.} -result 100.
aa80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 .test tlsIO-11.8
aa90: 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 {client with se
aaa0: 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 2d veral servers} -
aab0: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
aac0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
aad0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 2d 62 6f emoteServer} -bo
aae0: 64 79 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 dy {. sendCer
aaf0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
ab00: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a Command {..tls::
ab10: 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 init -certfile $
ab20: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
ab30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ab40: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 ile $serverKey..
ab50: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
ab60: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
ab70: 65 70 74 20 34 30 30 33 22 20 2d 72 65 71 75 69 ept 4003" -requi
ab80: 72 65 20 30 20 34 30 30 33 5d 0a 09 73 65 74 20 re 0 4003]..set
ab90: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
aba0: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
abb0: 34 30 30 34 22 20 2d 72 65 71 75 69 72 65 20 30 4004" -require 0
abc0: 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 4004]..set s3 [
abd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
abe0: 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 ver "accept 4005
abf0: 22 20 2d 72 65 71 75 69 72 65 20 30 20 34 30 30 " -require 0 400
ac00: 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 5]..proc handsha
ac10: 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 ke {s mp} {..
ac20: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
ac30: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
ac40: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 } elseif {[catc
ac50: 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b h {tls::handshak
ac60: 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b e $s} result]} {
ac70: 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 ...# Some errors
ac80: 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 are normal...
ac90: 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 } elseif {$res
aca0: 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 ult == 1} {...#
acb0: 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 Handshake comple
acc0: 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 te...fileevent $
acd0: 73 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 s readable ""...
ace0: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c puts $s $mp...cl
acf0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
ad00: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d ..proc accept {m
ad10: 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 p s a p} {..
ad20: 23 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 # These have to
ad30: 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b accept non-block
ad40: 69 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 ing, because the
ad50: 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 handshaking..
ad60: 20 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 # order isn't
ad70: 64 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 deterministic..
ad80: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
ad90: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
ada0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
adb0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
adc0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 eadable [list ha
add0: 6e 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a ndshake $s $mp].
ade0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 .}. }. tls
adf0: 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 ::init -certfile
ae00: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
ae10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ae20: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
ae30: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
ae40: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
ae50: 65 20 30 20 24 72 65 6d 6f 74 65 53 65 72 76 65 e 0 $remoteServe
ae60: 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 rIP 4003]. se
ae70: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
ae80: 74 20 2d 72 65 71 75 69 72 65 20 30 20 24 72 65 t -require 0 $re
ae90: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
aea0: 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 4]. set s3 [t
aeb0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
aec0: 69 72 65 20 30 20 24 72 65 6d 6f 74 65 53 65 72 ire 0 $remoteSer
aed0: 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 verIP 4005].
aee0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
aef0: 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 pend l [gets $s1
af00: 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f ] [gets $s1] [eo
af10: 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 f $s1] [gets $s2
af20: 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f ] [gets $s2] [eo
af30: 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 f $s2] \..[gets
af40: 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 $s3] [gets $s3]
af50: 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c [eof $s3]. cl
af60: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
af70: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
af80: 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s3. sendComm
af90: 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 and {..close $s1
afa0: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f ..close $s2..clo
afb0: 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 se $s3. }.
afc0: 20 73 65 74 20 6c 0a 7d 20 2d 72 65 73 75 6c 74 set l.} -result
afd0: 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 {4003 {} 1 4004
afe0: 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d {} 1 4005 {} 1}
aff0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
b000: 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 9 {accept callba
b010: 63 6b 20 65 72 72 6f 72 7d 20 2d 63 6f 6e 73 74 ck error} -const
b020: 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 20 64 raints {socket d
b030: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
b040: 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 20 7b 0a Server} -body {.
b050: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
b060: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
b070: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
b080: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
b090: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
b0a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
b0b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
b0c0: 79 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 y 8836]. proc
b0d0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
b0e0: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
b0f0: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
b100: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
b110: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
b120: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
b130: 61 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 alues. if {[c
b140: 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e atch {sendComman
b150: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 d {.. set pee
b160: 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 rname [fconfigur
b170: 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 e $callerSocket
b180: 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 -peername]..
b190: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
b1a0: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
b1b0: 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
b1c0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
b1d0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b1e0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
b1f0: 5c 0a 09 09 20 20 20 20 5b 6c 69 6e 64 65 78 20 \... [lindex
b200: 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 $peername 0] 883
b210: 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 6].. close $s
b220: 0a 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 .. }} msg]} {..c
b230: 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 lose $s..error $
b240: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
b250: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
b260: 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 0000 [list set x
b270: 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 timed_out]].
b280: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
b290: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
b2a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
b2b0: 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 rename bgerror
b2c0: 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 {}. set x.}
b2d0: 2d 72 65 73 75 6c 74 20 7b 7b 64 69 76 69 64 65 -result {{divide
b2e0: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
b2f0: 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 tlsIO-11.10 {te
b300: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
b310: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 2d cific options} -
b320: 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 constraints {soc
b330: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b340: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 2d 62 6f emoteServer} -bo
b350: 64 79 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 dy {. sendCer
b360: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
b370: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
b380: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
b390: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
b3a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
b3b0: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
b3c0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b3d0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
b3e0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
b3f0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
b400: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
b410: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
b420: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
b430: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
b440: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
b450: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b460: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b470: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b480: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b490: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b4a0: 50 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 P 8836]. set
b4b0: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
b4c0: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
b4d0: 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 set n [fconfigur
b4e0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
b4f0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
b500: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 lappend l [lind
b510: 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $p 2] [llengt
b520: 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 h $p] [llength $
b530: 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a p]. close $s.
b540: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b550: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
b560: 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _12_test_server}
b570: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 2d 72 65 . set l.} -re
b580: 73 75 6c 74 20 7b 38 38 33 36 20 33 20 33 7d 0a sult {8836 3 3}.
b590: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b5a0: 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 1 {testing spuri
b5b0: 6f 75 73 20 65 76 65 6e 74 73 7d 20 2d 63 6f 6e ous events} -con
b5c0: 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 74 straints {socket
b5d0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
b5e0: 74 65 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 20 teServer} -body
b5f0: 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 {. # remote e
b600: 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 quivalent of 9.1
b610: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
b620: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
b630: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
b640: 74 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 t_test_server [t
b650: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
b660: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
b670: 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 re 0 \...-certfi
b680: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
b690: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b6a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
b6b0: 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 ey 8836]..proc h
b6c0: 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 andshake {s} {..
b6d0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
b6e0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
b6f0: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 } elseif {[c
b700: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
b710: 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d hake $s} result]
b720: 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 } {...# Some err
b730: 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a ors are normal..
b740: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
b750: 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 result == 1} {..
b760: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
b770: 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e plete...fileeven
b780: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 t $s writable ""
b790: 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 72 69 ...after 100 wri
b7a0: 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d tesome $s.. }
b7b0: 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ..}..proc accept
b7c0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b7d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
b7e0: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
b7f0: 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 lf".. fileev
b800: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
b810: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
b820: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s]..}..proc wri
b830: 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 tesome {s} {..
b840: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
b850: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
b860: 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 i} {...puts $s
b870: 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 "line $i from re
b880: 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 mote server"..
b890: 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 }.. close $
b8a0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b8b0: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
b8c0: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
b8d0: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
b8e0: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
b8f0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
b900: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
b910: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
b920: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
b930: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
b940: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
b950: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
b960: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
b970: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
b980: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
b990: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
b9a0: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
b9b0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
b9c0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b9d0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
b9e0: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 -require 0 \..
b9f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
ba00: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
ba10: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
ba20: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
ba30: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
ba40: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 IP 8836]. # G
ba50: 65 74 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 et the buffering
ba60: 20 63 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 corrected. f
ba70: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 configure $c -bu
ba80: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
ba90: 20 23 20 50 75 74 20 61 20 62 79 74 65 20 69 6e # Put a byte in
baa0: 74 6f 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 to the client pi
bab0: 70 65 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c pe to trigger TL
bac0: 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 S handshaking.
bad0: 20 20 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 puts $c a.
bae0: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
baf0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 dable [list read
bb00: 6c 69 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 little $c]. s
bb10: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
bb20: 31 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 10000 [list set
bb30: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 5d 5d done timed_out]]
bb40: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
bb50: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
bb60: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
bb70: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
bb80: 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 socket_test_serv
bb90: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
bba0: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 2d 72 urious $len.} -r
bbb0: 65 73 75 6c 74 20 7b 30 20 32 36 39 30 7d 0a 0a esult {0 2690}..
bbc0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 32 test tlsIO-11.12
bbd0: 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 {testing EOF st
bbe0: 69 63 6b 79 6e 65 73 73 7d 20 2d 63 6f 6e 73 74 ickyness} -const
bbf0: 72 61 69 6e 74 73 20 7b 75 6e 65 78 70 6c 61 69 raints {unexplai
bc00: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
bc10: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
bc20: 6f 74 65 53 65 72 76 65 72 7d 20 2d 62 6f 64 79 oteServer} -body
bc30: 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 {. # remote
bc40: 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e equivalent of 9.
bc50: 33 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 3. # HOBBS: n
bc60: 65 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 ever worked corr
bc70: 65 63 74 6c 79 0a 20 20 20 20 73 65 74 20 63 6f ectly. set co
bc80: 75 6e 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 unter 0. set
bc90: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
bca0: 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 count_up {s} {..
bcb0: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 global counter d
bcc0: 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 one after_id..se
bcd0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 t l [gets $s]..i
bce0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
bcf0: 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 incr counter
bd00: 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 .. if {$count
bd10: 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 er > 9} {...set
bd20: 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 done {EOF is sti
bd30: 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e cky}...after can
bd40: 63 65 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 cel $after_id...
bd50: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a close $s.. }.
bd60: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
bd70: 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b c timed_out {} {
bd80: 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a ..global c done.
bd90: 09 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 .set done {timed
bda0: 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 _out, EOF is not
bdb0: 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 sticky}..close
bdc0: 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e $c. }. sen
bdd0: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
bde0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
bdf0: 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 et socket10_14_t
be00: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
be10: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
be20: 61 63 63 65 70 74 20 20 2d 72 65 71 75 69 72 65 accept -require
be30: 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 0 \...-certfile
be40: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
be50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
be60: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
be70: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
be80: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
be90: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
bea0: 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 20 e $s.. after
beb0: 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 100 close $s..}.
bec0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
bed0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
bee0: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
bef0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
bf00: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
bf10: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
bf20: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
bf30: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
bf40: 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 8836]. fileev
bf50: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
bf60: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 "count_up $c".
bf70: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b set after_id [
bf80: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 after 1000 timed
bf90: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 _out]. vwait
bfa0: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d done. sendCom
bfb0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
bfc0: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
bfd0: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f rver}. set do
bfe0: 6e 65 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 45 4f ne.} -result {EO
bff0: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 F is sticky}..te
c000: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b st tlsIO-11.13 {
c010: 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 testing async wr
c020: 69 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 ite, async flush
c030: 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c , async close} \
c040: 0a 09 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b ..-constraints {
c050: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
c060: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
c070: 2d 62 6f 64 79 20 7b 0a 20 20 20 20 70 72 6f 63 -body {. proc
c080: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
c090: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
c0a0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
c0b0: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
c0c0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
c0d0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
c0e0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
c0f0: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
c100: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
c110: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
c120: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
c130: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
c140: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
c150: 31 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 1]..set secondbl
c160: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
c170: 61 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 at b 65535]..set
c180: 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 l [tls::socket
c190: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c1a0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 require 0 \...-c
c1b0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
c1c0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c1d0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
c1e0: 72 76 65 72 4b 65 79 20 38 38 34 35 5d 0a 09 70 rverKey 8845]..p
c1f0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
c200: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
c210: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
c220: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
c230: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
c240: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
c250: 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 ersize 16384 \..
c260: 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 . -buffering
c270: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
c280: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
c290: 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d "readable $s"..}
c2a0: 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 ..proc readable
c2b0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
c2c0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
c2d0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
c2e0: 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 dable {}.. af
c2f0: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
c300: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 $s..}..proc res
c310: 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 pond {s} {..
c320: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
c330: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
c340: 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 ewline $s $first
c350: 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 block.. after
c360: 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 1000 writedata
c370: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
c380: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 edata {s} {..
c390: 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c global secondbl
c3a0: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
c3b0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
c3c0: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c ondblock.. cl
c3d0: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
c3e0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
c3f0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
c400: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
c410: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
c420: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
c430: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
c440: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
c450: 65 53 65 72 76 65 72 49 50 20 38 38 34 35 5d 0a eServerIP 8845].
c460: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
c470: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 s -blocking 0 -t
c480: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
c490: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
c4a0: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
c4b0: 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a puts $s hello.
c4c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
c4d0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
c4e0: 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 t $s". set ti
c4f0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
c500: 20 5b 6c 69 73 74 20 73 65 74 20 64 6f 6e 65 20 [list set done
c510: 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 timed_out]].
c520: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
c530: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
c540: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
c550: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
c560: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 2d 72 set count.} -r
c570: 65 73 75 6c 74 20 36 35 35 36 36 0a 0a 70 72 6f esult 65566..pro
c580: 63 20 67 65 74 64 61 74 61 20 7b 74 79 70 65 20 c getdata {type
c590: 66 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 52 65 file} {. # Re
c5a0: 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 ad handler on th
c5b0: 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 e accepted socke
c5c0: 74 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a t.. global x.
c5d0: 20 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 6c 65 global faile
c5e0: 64 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 d. set status
c5f0: 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 [catch {read $f
c600: 69 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 20 69 ile} data]. i
c610: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
c620: 20 7b 0a 09 73 65 74 20 78 20 22 72 65 61 64 20 {..set x "read
c630: 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 failed, error wa
c640: 73 20 24 64 61 74 61 22 0a 09 63 61 74 63 68 20 s $data"..catch
c650: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
c660: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 64 } elseif {$d
c670: 61 74 61 20 6e 65 20 7b 7d 7d 20 7b 0a 20 20 20 ata ne {}} {.
c680: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f } elseif {[fblo
c690: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 20 cked $file]} {.
c6a0: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f } elseif {[eo
c6b0: 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 69 66 20 f $file]} {..if
c6c0: 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 20 20 20 {$failed} {..
c6d0: 20 73 65 74 20 78 20 22 24 74 79 70 65 20 73 6f set x "$type so
c6e0: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
c6f0: 65 64 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 ed"..} else {..
c700: 20 20 20 73 65 74 20 78 20 22 24 74 79 70 65 20 set x "$type
c710: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c720: 6e 68 65 72 69 74 65 64 22 0a 09 7d 0a 09 63 61 nherited"..}..ca
c730: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
c740: 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b e }. } else {
c750: 0a 09 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 ..set x {impossi
c760: 62 6c 65 20 63 61 73 65 7d 0a 09 63 61 74 63 68 ble case}..catch
c770: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
c780: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
c790: 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d n.}..test tlsIO-
c7a0: 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.1 {testing in
c7b0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 heritance of ser
c7c0: 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 2d 63 6f ver sockets} -co
c7d0: 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 nstraints {socke
c7e0: 74 20 65 78 65 63 7d 20 2d 62 6f 64 79 20 7b 0a t exec} -body {.
c7f0: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 makeFile {}
c800: 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 script1. make
c810: 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a File {} script2.
c820: 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 . # Script1 i
c830: 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f s just a 10 seco
c840: 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 nd delay. If th
c850: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a e server socket.
c860: 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 # is inherit
c870: 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 ed, it will be h
c880: 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 eld open for 10
c890: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 seconds.. set
c8a0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 f [open script1
c8b0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
c8c0: 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 {..after 10000 e
c8d0: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
c8e0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
c8f0: 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 se $f.. # Scr
c900: 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 65 ipt2 creates the
c910: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 server socket,
c920: 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 launches script1
c930: 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 20 ,. # waits a
c940: 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 second, and exit
c950: 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 73 s. The server s
c960: 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 ocket will now.
c970: 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 # be closed u
c980: 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 6e nless script1 in
c990: 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 herited it...
c9a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c9b0: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
c9c0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
c9d0: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
c9e0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
c9f0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
ca00: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
ca10: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
ca20: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
ca30: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
ca40: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
ca50: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
ca60: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
ca70: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
ca80: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
ca90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
caa0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
cab0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
cac0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
cad0: 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 8828\]". put
cae0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
caf0: 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 ept { file addr
cb00: 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c port } {.. cl
cb10: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 ose $file..}..ex
cb20: 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 ec $tclsh script
cb30: 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 1 &..close $f..a
cb40: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
cb50: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
cb60: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
cb70: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 .. # Launch s
cb80: 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 cript2 and wait
cb90: 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 5 seconds.. e
cba0: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
cbb0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
cbc0: 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 &. after 5000
cbd0: 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f { set ok_to_pro
cbe0: 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 ceed 1 }. vwa
cbf0: 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 it ok_to_proceed
cc00: 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 .. # If we ca
cc10: 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 n still connect
cc20: 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 to the server, t
cc30: 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e he socket got in
cc40: 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 herited... if
cc50: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
cc60: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
cc70: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
cc80: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
cc90: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
cca0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
ccb0: 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 . 127.0.0.1 8828
ccc0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
ccd0: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
cce0: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
ccf0: 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a d}. } else {.
cd00: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 .close $msg..set
cd10: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
cd20: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
cd30: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
cd40: 78 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 73 65 72 x.} -result {ser
cd50: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
cd60: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 ot inherited}..t
cd70: 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b est tlsIO-12.2 {
cd80: 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 testing inherita
cd90: 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f nce of client so
cda0: 63 6b 65 74 73 7d 20 2d 63 6f 6e 73 74 72 61 69 ckets} -constrai
cdb0: 6e 74 73 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 nts {socket exec
cdc0: 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 6d 61 } -body {. ma
cdd0: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
cde0: 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 1. makeFile {
cdf0: 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 } script2.. #
ce00: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
ce10: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
ce20: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
ce30: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
ce40: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
ce50: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
ce60: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
ce70: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
ce80: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
ce90: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
cea0: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
ceb0: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
cec0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
ced0: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f . # Script2 o
cee0: 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 pens the client
cef0: 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 socket and write
cf00: 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 s to it. It the
cf10: 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 n. # launches
cf20: 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 script1 and exi
cf30: 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c ts. If the chil
cf40: 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 d process inheri
cf50: 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c ted the. # cl
cf60: 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 ient socket, the
cf70: 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 socket will sti
cf80: 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 ll be open...
cf90: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
cfa0: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
cfb0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
cfc0: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
cfd0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
cfe0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
cff0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
d000: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
d010: 20 7b 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 {..package pref
d020: 65 72 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 er latest..packa
d030: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
d040: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
d050: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
d060: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
d070: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
d080: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
d090: 63 61 43 65 72 74 20 5c 0a 09 20 20 20 20 2d 6b caCert \.. -k
d0a0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
d0b0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
d0c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
d0d0: 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 {..exec $tclsh s
d0e0: 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 cript1 &..puts $
d0f0: 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 f testing..flush
d100: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
d110: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
d120: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
d130: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 ose $f.. # Cr
d140: 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 20 eate the server
d150: 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 socket.. set
d160: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
d170: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
d180: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
d190: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
d1a0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
d1b0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
d1c0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
d1d0: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
d1e0: 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 cept { file host
d1f0: 20 70 6f 72 74 20 7d 20 7b 0a 09 23 20 57 68 65 port } {..# Whe
d200: 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e n the client con
d210: 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 nects, establish
d220: 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 the read handle
d230: 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 r..global server
d240: 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a ..close $server.
d250: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c .fconfigure $fil
d260: 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 e -blocking 0..f
d270: 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 ileevent $file r
d280: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
d290: 5f 68 61 6e 64 73 68 61 6b 65 20 24 66 69 6c 65 _handshake $file
d2a0: 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 5b 6c readable \...[l
d2b0: 69 73 74 20 67 65 74 64 61 74 61 20 63 6c 69 65 ist getdata clie
d2c0: 6e 74 5d 20 2d 62 75 66 66 65 72 69 6e 67 20 6c nt] -buffering l
d2d0: 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a 20 20 20 ine]..return.
d2e0: 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 }.. # If the
d2f0: 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 socket doesn't
d300: 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 hit end-of-file
d310: 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 in 5 seconds, th
d320: 65 0a 20 20 20 20 23 20 73 63 72 69 70 74 31 20 e. # script1
d330: 70 72 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 process must hav
d340: 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 e inherited the
d350: 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 client... set
d360: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
d370: 74 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 ter 5000 [list s
d380: 65 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 et failed 1]..
d390: 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 # Launch the s
d3a0: 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a cript2 process..
d3b0: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
d3c0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
d3d0: 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 ipt2 &.. vwai
d3e0: 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 t x. if {!$fa
d3f0: 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 iled} {..vwait f
d400: 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 ailed. }.
d410: 73 65 74 20 78 0a 7d 20 2d 72 65 73 75 6c 74 20 set x.} -result
d420: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
d430: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
d440: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 }..test tlsIO-12
d450: 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .3 {testing inhe
d460: 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 ritance of accep
d470: 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ted sockets} \..
d480: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
d490: 63 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f 6e cket exec unixOn
d4a0: 6c 79 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 ly} -body {.
d4b0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
d4c0: 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 pt1. makeFile
d4d0: 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 {} script2..
d4e0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
d4f0: 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt1 w]. puts
d500: 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 $f {..after 100
d510: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
d520: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
d530: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 close $f.. s
d540: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
d550: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
d560: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
d570: 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 h $::tcltest::tc
d580: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
d590: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
d5a0: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
d5b0: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
d5c0: 0a 09 70 61 63 6b 61 67 65 20 70 72 65 66 65 72 ..package prefer
d5d0: 20 6c 61 74 65 73 74 0a 09 70 61 63 6b 61 67 65 latest..package
d5e0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
d5f0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
d600: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
d610: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
d620: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
d630: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
d640: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
d650: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
d660: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
d670: 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 930\]". puts
d680: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
d690: 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f t { file host po
d6a0: 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 rt } {.. glob
d6b0: 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 66 63 al tclsh.. fc
d6c0: 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d onfigure $file -
d6d0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
d6e0: 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b puts $file {
d6f0: 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 test data on soc
d700: 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 ket}.. exec $
d710: 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a tclsh script1 &.
d720: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
d730: 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 exit..}..vwait f
d740: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
d750: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
d760: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
d770: 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 pt2 process and
d780: 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 connect to it.
d790: 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 See how long.
d7a0: 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 # the socket st
d7b0: 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 ays open.. ex
d7c0: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
d7d0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
d7e0: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
d7f0: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
d800: 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f ed 1. vwait o
d810: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 k_to_proceed..
d820: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
d830: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
d840: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
d850: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
d860: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
d870: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
d880: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
d890: 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 1 8930]. fcon
d8a0: 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 figure $f -buffe
d8b0: 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b ring full -block
d8c0: 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 20 6e ing 0. # We n
d8d0: 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 79 74 eed to put a byt
d8e0: 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 64 20 e into the read
d8f0: 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 73 65 queue, otherwise
d900: 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 20 68 the. # TLS h
d910: 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e 27 74 andshake doesn't
d920: 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 74 73 finish. puts
d930: 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 66 0a $f a; flush $f.
d940: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 fileevent $f
d950: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
d960: 67 65 74 64 61 74 61 20 61 63 63 65 70 74 65 64 getdata accepted
d970: 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 $f].. # If t
d980: 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 he socket is sti
d990: 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 ll open after 5
d9a0: 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 seconds, the scr
d9b0: 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 ipt1 process.
d9c0: 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 # must have inh
d9d0: 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 70 erited the accep
d9e0: 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 ted socket...
d9f0: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
da00: 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 74 after 5000 set
da10: 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 76 failed 1.. v
da20: 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 20 78 wait x. set x
da30: 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 61 63 63 65 .} -result {acce
da40: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
da50: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
da60: 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 test tlsIO-13.1
da70: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
da80: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
da90: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
daa0: 73 7d 20 5c 0a 09 2d 63 6f 6e 73 74 72 61 69 6e s} \..-constrain
dab0: 74 73 20 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 ts {socket testt
dac0: 68 72 65 61 64 7d 20 2d 62 6f 64 79 20 7b 0a 20 hread} -body {.
dad0: 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 # HOBBS: neve
dae0: 72 20 74 65 73 74 65 64 0a 20 20 20 20 72 65 6d r tested. rem
daf0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
db00: 20 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 threadReap..
db10: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 09 70 makeFile {..p
db20: 61 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 ackage prefer la
db30: 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 test..package re
db40: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 quire tls..set f
db50: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
db60: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
db70: 71 75 69 72 65 20 30 20 38 38 32 38 5d 0a 09 70 quire 0 8828]..p
db80: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
db90: 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 p} {.. fileev
dba0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
dbb0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
dbc0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
dbd0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
dbe0: 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 e..}..proc echo
dbf0: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
dc00: 61 6c 20 69 0a 09 20 20 20 20 20 73 65 74 20 6c al i.. set l
dc10: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
dc20: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
dc30: 0a 09 09 20 67 6c 6f 62 61 6c 20 78 0a 09 09 20 ... global x...
dc40: 63 6c 6f 73 65 20 24 73 0a 09 09 20 73 65 74 20 close $s... set
dc50: 78 20 64 6f 6e 65 0a 09 20 20 20 20 20 7d 20 65 x done.. } e
dc60: 6c 73 65 20 7b 0a 09 20 20 20 20 20 20 20 20 20 lse {..
dc70: 69 6e 63 72 20 69 0a 09 09 20 70 75 74 73 20 24 incr i... puts $
dc80: 73 20 24 6c 0a 09 20 20 20 20 20 7d 0a 09 7d 0a s $l.. }..}.
dc90: 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 .set i 0..vwait
dca0: 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 x..close $f...#
dcb0: 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 thread cleans it
dcc0: 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 self up...testth
dcd0: 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 read exit. }
dce0: 73 63 72 69 70 74 0a 0a 20 20 20 20 23 20 63 72 script.. # cr
dcf0: 65 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 eate a thread.
dd00: 20 20 73 65 74 20 73 65 72 76 65 72 74 68 72 65 set serverthre
dd10: 61 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 ad [testthread c
dd20: 72 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 reate { source s
dd30: 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 cript } ]. up
dd40: 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 date.. after
dd50: 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 1000. set s [
dd60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
dd70: 75 69 72 65 20 30 20 31 32 37 2e 30 2e 30 2e 31 uire 0 127.0.0.1
dd80: 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 8828]. fconf
dd90: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
dda0: 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 ing line.. ca
ddb0: 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 tch {..puts $s "
ddc0: 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 hello"..gets $s
ddd0: 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 result. }.
dde0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 close $s. up
ddf0: 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 date.. after
de00: 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 2000. lappend
de10: 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 result [threadR
de20: 65 61 70 5d 0a 0a 20 20 20 20 73 65 74 20 72 65 eap].. set re
de30: 73 75 6c 74 0a 0a 7d 20 2d 72 65 73 75 6c 74 20 sult..} -result
de40: 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 74 65 73 74 20 {hello 1}..test
de50: 74 6c 73 49 4f 2d 31 34 2e 31 20 7b 74 65 73 74 tlsIO-14.1 {test
de60: 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 tls::unimport}
de70: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
de80: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
de90: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
dea0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 6d 73 ls::unimport} ms
deb0: 67 5d 20 24 6d 73 67 0a 7d 20 2d 72 65 73 75 6c g] $msg.} -resul
dec0: 74 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 t {1 {wrong # ar
ded0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
dee0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 ls::unimport cha
def0: 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 nnel"}}.test tls
df00: 49 4f 2d 31 34 2e 32 20 7b 74 65 73 74 20 74 6c IO-14.2 {test tl
df10: 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 2d 63 6f s::unimport} -co
df20: 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f 63 6b 65 nstraints {socke
df30: 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 20 20 6c t} -body {. l
df40: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
df50: 3a 75 6e 69 6d 70 6f 72 74 20 66 6f 6f 20 62 61 :unimport foo ba
df60: 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d r} msg] $msg.} -
df70: 72 65 73 75 6c 74 20 7b 31 20 7b 77 72 6f 6e 67 result {1 {wrong
df80: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
df90: 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 be "tls::unimpor
dfa0: 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 t channel"}}.tes
dfb0: 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b 74 65 t tlsIO-14.3 {te
dfc0: 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 st tls::unimport
dfd0: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
dfe0: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
dff0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
e000: 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 {tls::unimport b
e010: 6f 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a ogus} msg] $msg.
e020: 7d 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b 63 61 } -result {1 {ca
e030: 6e 20 6e 6f 74 20 66 69 6e 64 20 63 68 61 6e 6e n not find chann
e040: 65 6c 20 6e 61 6d 65 64 20 22 62 6f 67 75 73 22 el named "bogus"
e050: 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }}.test tlsIO-14
e060: 2e 34 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .4 {test tls::un
e070: 69 6d 70 6f 72 74 7d 20 2d 63 6f 6e 73 74 72 61 import} -constra
e080: 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 ints {socket} -b
e090: 6f 64 79 20 7b 0a 20 20 20 20 23 20 73 74 64 69 ody {. # stdi
e0a0: 6e 20 63 61 6e 20 74 61 6b 65 20 64 69 66 66 65 n can take diffe
e0b0: 72 65 6e 74 20 6e 61 6d 65 73 20 61 73 20 74 68 rent names as th
e0c0: 65 20 22 74 6f 70 22 20 63 68 61 6e 6e 65 6c 0a e "top" channel.
e0d0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
e0e0: 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 73 {tls::unimport s
e0f0: 74 64 69 6e 7d 20 6d 73 67 5d 20 5c 0a 09 5b 73 tdin} msg] \..[s
e100: 74 72 69 6e 67 20 6d 61 74 63 68 20 7b 62 61 64 tring match {bad
e110: 20 63 68 61 6e 6e 65 6c 20 22 2a 22 3a 20 6e 6f channel "*": no
e120: 74 20 61 20 73 74 61 63 6b 65 64 20 63 68 61 6e t a stacked chan
e130: 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 2d 72 65 nel} $msg].} -re
e140: 73 75 6c 74 20 7b 31 20 31 7d 0a 74 65 73 74 20 sult {1 1}.test
e150: 74 6c 73 49 4f 2d 31 34 2e 35 20 7b 74 65 73 74 tlsIO-14.5 {test
e160: 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 tls::unimport}
e170: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
e180: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
e190: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
e1a0: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
e1b0: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
e1c0: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
e1d0: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
e1e0: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
e1f0: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
e200: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
e210: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
e220: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
e230: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
e240: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
e250: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
e260: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
e270: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
e280: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
e290: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
e2a0: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
e2b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
e2c0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
e2d0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
e2e0: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
e2f0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
e300: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 _handshake $s re
e310: 61 64 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c adable readlittl
e320: 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 e \...-buffering
e330: 20 6e 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 none]. }.
e340: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
e350: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
e360: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
e370: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
e380: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
e390: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
e3a0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 38 5d $serverKey 8838]
e3b0: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
e3c0: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
e3d0: 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 0 -certfile $cl
e3e0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
e3f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
e400: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
e410: 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 localhost 88
e420: 33 38 5d 0a 20 20 20 20 23 20 6f 6e 6c 79 20 74 38]. # only t
e430: 68 65 20 63 6c 69 65 6e 74 20 67 65 74 73 20 74 he client gets t
e440: 6c 73 3a 3a 69 6d 70 6f 72 74 0a 20 20 20 20 73 ls::import. s
e450: 65 74 20 72 65 73 20 5b 74 6c 73 3a 3a 75 6e 69 et res [tls::uni
e460: 6d 70 6f 72 74 20 24 63 5d 0a 20 20 20 20 6c 69 mport $c]. li
e470: 73 74 20 24 72 65 73 20 5b 63 61 74 63 68 20 7b st $res [catch {
e480: 63 6c 6f 73 65 20 24 63 7d 20 65 72 72 5d 20 24 close $c} err] $
e490: 65 72 72 20 5c 0a 09 5b 63 61 74 63 68 20 7b 63 err \..[catch {c
e4a0: 6c 6f 73 65 20 24 73 7d 20 65 72 72 5d 20 24 65 lose $s} err] $e
e4b0: 72 72 0a 7d 20 2d 72 65 73 75 6c 74 20 7b 7b 7d rr.} -result {{}
e4c0: 20 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 0 {} 0 {}}..tes
e4d0: 74 20 74 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 t tls-bug58-1.0
e4e0: 7b 74 65 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e {test protocol n
e4f0: 65 67 6f 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 egotiation failu
e500: 72 65 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 re} -constraints
e510: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 {socket} -body
e520: 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f 77 69 6e {. # Followin
e530: 67 20 63 6f 64 65 20 69 73 20 62 61 73 65 64 20 g code is based
e540: 6f 6e 20 77 68 61 74 20 77 61 73 20 72 65 70 6f on what was repo
e550: 72 74 65 64 20 69 6e 20 62 75 67 20 23 35 38 2e rted in bug #58.
e560: 20 50 72 69 6f 72 0a 20 20 20 20 23 20 74 6f 20 Prior. # to
e570: 66 69 78 20 74 68 65 20 70 72 6f 67 72 61 6d 20 fix the program
e580: 77 6f 75 6c 64 20 63 72 61 73 68 20 77 69 74 68 would crash with
e590: 20 61 20 73 65 67 66 61 75 6c 74 2e 0a 20 20 20 a segfault..
e5a0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f proc accept {so
e5b0: 63 6b 20 61 72 67 73 7d 20 7b 0a 09 66 63 6f 6e ck args} {..fcon
e5c0: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
e5d0: 6f 63 6b 69 6e 67 20 30 3b 0a 09 66 69 6c 65 65 ocking 0;..filee
e5e0: 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 vent $sock reada
e5f0: 62 6c 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 68 ble [list Handsh
e600: 61 6b 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 7d ake $sock]. }
e610: 0a 20 20 20 20 70 72 6f 63 20 48 61 6e 64 73 68 . proc Handsh
e620: 61 6b 65 20 7b 73 6f 63 6b 7d 20 7b 0a 09 73 65 ake {sock} {..se
e630: 74 20 3a 3a 64 6f 6e 65 20 48 41 4e 44 0a 09 63 t ::done HAND..c
e640: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
e650: 68 61 6b 65 20 24 73 6f 63 6b 7d 20 6d 73 67 0a hake $sock} msg.
e660: 09 73 65 74 20 3a 3a 64 6f 6e 65 20 24 6d 73 67 .set ::done $msg
e670: 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 4e 4f 54 . }. # NOT
e680: 45 3a 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e E: when doing an
e690: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
e6a0: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
e6b0: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
e6c0: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
e6d0: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
e6e0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 0a 0a TLS handshake..
e6f0: 20 20 20 20 23 20 53 65 72 76 65 72 20 2d 20 4f # Server - O
e700: 6e 6c 79 20 61 63 63 65 70 74 20 54 4c 53 20 31 nly accept TLS 1
e710: 2e 33 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c .3. set s [tl
e720: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
e730: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 65 73 r accept -reques
e740: 74 20 30 20 2d 72 65 71 75 69 72 65 20 30 20 5c t 0 -require 0 \
e750: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
e760: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
e770: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
e780: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d $serverKey \..-
e790: 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 20 2d ssl2 0 -ssl3 0 -
e7a0: 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 31 20 30 tls1 0 -tls1.1 0
e7b0: 20 2d 74 6c 73 31 2e 32 20 30 20 2d 74 6c 73 31 -tls1.2 0 -tls1
e7c0: 2e 33 20 31 20 38 38 33 37 5d 0a 20 20 20 20 23 .3 1 8837]. #
e7d0: 20 43 6c 69 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 Client - Only p
e7e0: 72 6f 70 6f 73 65 20 54 4c 53 31 2e 32 0a 20 20 ropose TLS1.2.
e7f0: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
e800: 63 6b 65 74 20 2d 61 73 79 6e 63 20 2d 63 61 66 cket -async -caf
e810: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 72 65 71 ile $caCert -req
e820: 75 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 20 uest 0 -require
e830: 30 20 5c 0a 09 2d 73 73 6c 32 20 30 20 2d 73 73 0 \..-ssl2 0 -ss
e840: 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d 74 6c l3 0 -tls1 0 -tl
e850: 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 31 s1.1 0 -tls1.2 1
e860: 20 2d 74 6c 73 31 2e 33 20 30 20 6c 6f 63 61 6c -tls1.3 0 local
e870: 68 6f 73 74 20 38 38 33 37 5d 0a 20 20 20 20 66 host 8837]. f
e880: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
e890: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
e8a0: 73 20 24 63 20 61 20 3b 20 66 6c 75 73 68 20 24 s $c a ; flush $
e8b0: 63 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 c. after 5000
e8c0: 20 5b 6c 69 73 74 20 73 65 74 20 3a 3a 64 6f 6e [list set ::don
e8d0: 65 20 74 69 6d 65 6f 75 74 5d 0a 20 20 20 20 76 e timeout]. v
e8e0: 77 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 wait ::done.
e8f0: 73 77 69 74 63 68 20 2d 65 78 61 63 74 20 2d 2d switch -exact --
e900: 20 24 3a 3a 64 6f 6e 65 20 7b 0a 09 22 68 61 6e $::done {.."han
e910: 64 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 dshake failed: w
e920: 72 6f 6e 67 20 73 73 6c 20 76 65 72 73 69 6f 6e rong ssl version
e930: 22 20 2d 0a 09 22 68 61 6e 64 73 68 61 6b 65 20 " -.."handshake
e940: 66 61 69 6c 65 64 3a 20 75 6e 73 75 70 70 6f 72 failed: unsuppor
e950: 74 65 64 20 70 72 6f 74 6f 63 6f 6c 22 20 7b 0a ted protocol" {.
e960: 09 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 . set ::done
e970: 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 "handshake faile
e980: 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f 6e d: wrong version
e990: 20 6e 75 6d 62 65 72 22 0a 09 7d 0a 20 20 20 20 number"..}.
e9a0: 7d 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f }. catch {clo
e9b0: 73 65 20 24 63 7d 0a 20 20 20 20 63 61 74 63 68 se $c}. catch
e9c0: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
e9d0: 73 65 74 20 3a 3a 64 6f 6e 65 0a 7d 20 2d 72 65 set ::done.} -re
e9e0: 73 75 6c 74 20 7b 68 61 6e 64 73 68 61 6b 65 20 sult {handshake
e9f0: 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 failed: wrong ve
ea00: 72 73 69 6f 6e 20 6e 75 6d 62 65 72 7d 0a 0a 23 rsion number}..#
ea10: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
ea20: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
ea30: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
ea40: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
ea50: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
ea60: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
ea70: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
ea80: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
ea90: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
eaa0: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
eab0: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
eac0: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
ead0: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
eae0: 65 74 75 72 6e 0a eturn.