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 20 20 20 20 20 20 20 20 69 66 20 7b e {. if {
0fd0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0fe0: 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a oteServerIP]} {.
0ff0: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
1000: 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 erverPort $tlsSe
1010: 72 76 65 72 50 6f 72 74 0a 20 20 20 20 20 20 20 rverPort.
1020: 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 }. }.}..proc
1030: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 7b 73 do_handshake {s
1040: 20 7b 74 79 70 65 20 72 65 61 64 61 62 6c 65 7d {type readable}
1050: 20 7b 63 6d 64 20 7b 7d 7d 20 61 72 67 73 7d 20 {cmd {}} args}
1060: 7b 0a 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 {. if {[eof $
1070: 73 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a s]} {..close $s.
1080: 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b .dputs "handshak
1090: 65 3a 20 65 6f 66 22 0a 09 73 65 74 20 3a 3a 64 e: eof"..set ::d
10a0: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 22 65 6f 66 o_handshake "eof
10b0: 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b ". } elseif {
10c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e [catch {tls::han
10d0: 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c dshake $s} resul
10e0: 74 5d 7d 20 7b 0a 09 23 20 53 6f 6d 65 20 65 72 t]} {..# Some er
10f0: 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e rors are normal.
1100: 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 ..dputs "handsha
1110: 6b 65 3a 20 24 72 65 73 75 6c 74 22 0a 20 20 20 ke: $result".
1120: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
1130: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 23 20 48 61 lt == 1} {..# Ha
1140: 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 ndshake complete
1150: 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 ..if {[llength $
1160: 61 72 67 73 5d 7d 20 7b 20 65 76 61 6c 20 5b 6c args]} { eval [l
1170: 69 73 74 20 66 63 6f 6e 66 69 67 75 72 65 20 24 ist fconfigure $
1180: 73 5d 20 24 61 72 67 73 20 7d 0a 09 69 66 20 7b s] $args }..if {
1190: 24 63 6d 64 20 65 71 20 22 22 7d 20 7b 0a 09 20 $cmd eq ""} {..
11a0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
11b0: 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c 73 65 $type ""..} else
11c0: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e {.. fileeven
11d0: 74 20 24 73 20 24 74 79 70 65 20 22 24 63 6d 64 t $s $type "$cmd
11e0: 20 5b 6c 69 73 74 20 24 73 5d 22 0a 09 7d 0a 09 [list $s]"..}..
11f0: 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 dputs "handshake
1200: 3a 20 63 6f 6d 70 6c 65 74 65 22 0a 09 73 65 74 : complete"..set
1210: 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 ::do_handshake
1220: 22 63 6f 6d 70 6c 65 74 65 22 0a 20 20 20 20 7d "complete". }
1230: 20 65 6c 73 65 20 7b 0a 09 64 70 75 74 73 20 22 else {..dputs "
1240: 68 61 6e 64 73 68 61 6b 65 3a 20 69 6e 20 70 72 handshake: in pr
1250: 6f 67 72 65 73 73 22 0a 20 20 20 20 7d 0a 7d 0a ogress". }.}.
1260: 0a 23 0a 23 20 43 68 65 63 6b 20 69 66 20 77 65 .#.# Check if we
1270: 27 72 65 20 73 75 70 70 6f 73 65 64 20 74 6f 20 're supposed to
1280: 64 6f 20 74 65 73 74 73 20 61 67 61 69 6e 73 74 do tests against
1290: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
12a0: 65 72 0a 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 er.#..set doTest
12b0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
12c0: 72 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 r 1.if {![info e
12d0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
12e0: 65 72 49 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 erIP] && ($tcl_p
12f0: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
1300: 29 20 6e 65 20 22 6d 61 63 69 6e 74 6f 73 68 22 ) ne "macintosh"
1310: 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d )} {. set rem
1320: 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 37 2e oteServerIP 127.
1330: 30 2e 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 0.0.1.}.if {($do
1340: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1350: 65 72 76 65 72 20 3d 3d 20 31 29 20 26 26 20 28 erver == 1) && (
1360: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 ![info exists re
1370: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 29 moteServerPort])
1380: 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f } {. set remo
1390: 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c teServerPort $tl
13a0: 73 53 65 72 76 65 72 50 6f 72 74 0a 7d 0a 0a 23 sServerPort.}..#
13b0: 20 41 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e Attempt to conn
13c0: 65 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 ect to a remote
13d0: 73 65 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 server if one is
13e0: 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 already running
13f0: 2e 20 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 . If it.# is not
1400: 20 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 running or for
1410: 73 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f some other reaso
1420: 6e 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 n the connect fa
1430: 69 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a ils, attempt to.
1440: 23 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f # start the remo
1450: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 te server on the
1460: 20 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 local host list
1470: 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 38 30 ening on port 80
1480: 34 38 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 48. This.# is on
1490: 6c 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 ly done on platf
14a0: 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 orms that suppor
14b0: 74 20 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 t exec (i.e. not
14c0: 20 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e on the Mac). On
14d0: 0a 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 .# platforms tha
14e0: 74 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 t do not support
14f0: 20 65 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 exec, the remot
1500: 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 e server must be
1510: 20 73 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 started.# by th
1520: 65 20 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 e user before ru
1530: 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e nning the tests.
1540: 0a 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 ..set remoteProc
1550: 43 68 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d Chan "".set comm
1560: 61 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 andSocket "".if
1570: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
1580: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
1590: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 catch {close $c
15a0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 ommandSocket}.
15b0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
15c0: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
15d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
15e0: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
15f0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
1600: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
1610: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
1620: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
1630: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
1640: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
1650: 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 t]}] != 0} {..if
1660: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
1670: 20 65 78 65 63 5d 20 65 71 20 22 22 7d 20 7b 0a exec] eq ""} {.
1680: 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 . set noRemot
1690: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e eTestReason "can
16a0: 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 't exec".. se
16b0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
16c0: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 oteServer 0..} e
16d0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 lse {.. set r
16e0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
16f0: 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 7.0.0.1.. set
1700: 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c remoteFile [fil
1710: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d e join [pwd] rem
1720: 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 ote.tcl].. if
1730: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 {[catch {set re
1740: 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 moteProcChan \..
1750: 09 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 . [open "|[li
1760: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
1770: 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 cltest $remoteFi
1780: 6c 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 72 76 le \... -serv
1790: 65 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f 72 74 erIsSilent -port
17a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f $remoteServerPo
17b0: 72 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 64 72 rt \... -addr
17c0: 65 73 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ess $remoteServe
17d0: 72 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 rIP]" w+]} msg]
17e0: 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 == 0} {...after
17f0: 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 1000...if {[catc
1800: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f h {set commandSo
1810: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 cket [tls::socke
1820: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 20 t -require 0 \.
1830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 09 .
1840: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
1850: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
1860: 74 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 tCert -keyfile $
1870: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 24 clientKey \....$
1880: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 remoteServerIP $
1890: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
18a0: 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a ]} msg] == 0} {.
18b0: 09 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
18c0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
18d0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
18e0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
18f0: 65 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 e...} else {...
1900: 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 set noRemoteT
1910: 65 73 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 estReason $msg..
1920: 09 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 . set doTests
1930: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1940: 20 30 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 0...}.. } el
1950: 73 65 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d se {...set noRem
1960: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 24 oteTestReason "$
1970: 6d 73 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a msg $::tcltest::
1980: 74 63 6c 74 65 73 74 22 0a 09 09 73 65 74 20 64 tcltest"...set d
1990: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
19a0: 53 65 72 76 65 72 20 30 0a 09 20 20 20 20 7d 0a Server 0.. }.
19b0: 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a .}. } else {.
19c0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d .fconfigure $com
19d0: 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e mandSocket -tran
19e0: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
19f0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
1a00: 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 }.}..# Some tes
1a10: 74 73 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 ts are run only
1a20: 69 66 20 77 65 20 61 72 65 20 64 6f 69 6e 67 20 if we are doing
1a30: 74 65 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20 testing against
1a40: 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e a remote server.
1a50: 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a .set ::tcltest::
1a60: 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 testConstraints(
1a70: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1a80: 65 53 65 72 76 65 72 29 20 24 64 6f 54 65 73 74 eServer) $doTest
1a90: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1aa0: 72 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 r.if {$doTestsWi
1ab0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d thRemoteServer =
1ac0: 3d 20 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b = 0} {. if {[
1ad0: 73 74 72 69 6e 67 20 66 69 72 73 74 20 73 20 24 string first s $
1ae0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f ::tcltest::verbo
1af0: 73 65 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 se] != -1} {.
1b00: 20 09 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 .puts "Skipping
1b10: 20 74 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f tests with remo
1b20: 74 65 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 te server. See t
1b30: 65 73 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 ests/socket.test
1b40: 20 66 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 for"..puts "inf
1b50: 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 ormation on how
1b60: 74 6f 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 to run remote se
1b70: 72 76 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 rver."..puts "Re
1b80: 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 ason for not doi
1b90: 6e 67 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a ng remote tests:
1ba0: 20 24 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 $noRemoteTestRe
1bb0: 61 73 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 ason". }.}..#
1bc0: 0a 23 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 .# If we do the
1bd0: 74 65 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 tests, define a
1be0: 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 command to send
1bf0: 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 a command to the
1c00: 0a 23 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 .# remote server
1c10: 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 ..#..if {$doTest
1c20: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1c30: 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 r == 1} {. pr
1c40: 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b oc sendCommand {
1c50: 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d c} {..global com
1c60: 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 mandSocket...if
1c70: 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f {[eof $commandSo
1c80: 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 cket]} {.. er
1c90: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
1ca0: 65 72 20 64 69 73 61 70 70 65 61 72 65 64 22 0a er disappeared".
1cb0: 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 .}...if {[catch
1cc0: 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f {puts $commandSo
1cd0: 63 6b 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b cket $c} msg]} {
1ce0: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d .. error "rem
1cf0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1d00: 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d peared: $msg"..}
1d10: 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 ..if {[catch {pu
1d20: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1d30: 74 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 t "--Marker--Mar
1d40: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 ker--Marker--"}
1d50: 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 msg]} {.. err
1d60: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1d70: 72 20 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 r disappeared: $
1d80: 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 msg"..}...set re
1d90: 73 70 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d sp ""..while {1}
1da0: 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 {.. set line
1db0: 20 5b 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 [gets $commandS
1dc0: 6f 63 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b ocket].. if {
1dd0: 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 [eof $commandSoc
1de0: 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 ket]} {...error
1df0: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1e00: 69 73 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 isappeared"..
1e10: 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6c 69 6e }.. if {$lin
1e20: 65 20 65 71 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d e eq "--Marker--
1e30: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1e40: 22 7d 20 7b 0a 09 09 69 66 20 7b 5b 6c 69 6e 64 "} {...if {[lind
1e50: 65 78 20 24 72 65 73 70 20 30 5d 20 65 71 20 22 ex $resp 0] eq "
1e60: 65 72 72 6f 72 22 7d 20 7b 0a 09 09 20 20 20 20 error"} {...
1e70: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1e80: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1e90: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1ea0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1eb0: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1ec0: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1ed0: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1ee0: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 }..}. }..
1ef0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c 69 73 sendCommand [lis
1f00: 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b 69 6e t proc dputs [in
1f10: 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d 20 5b fo args dputs] [
1f20: 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74 73 5d info body dputs]
1f30: 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 ].. proc send
1f40: 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20 7b 0a CertValues {} {.
1f50: 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20 62 65 .# We need to be
1f60: 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20 63 65 able to send ce
1f70: 72 74 69 66 69 63 61 74 65 20 76 61 6c 75 65 73 rtificate values
1f80: 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a 65 0a that normalize.
1f90: 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61 63 72 .# filenames acr
1fa0: 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a 09 73 oss platforms..s
1fb0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
1fc0: 20 20 73 65 74 20 63 65 72 74 73 44 69 72 09 5b set certsDir.[
1fd0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
1fe0: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 dirname [info sc
1ff0: 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a 09 20 ript]] certs]..
2000: 20 20 20 73 65 74 20 73 65 72 76 65 72 43 65 72 set serverCer
2010: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
2020: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 rtsDir server.pe
2030: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 m].. set clie
2040: 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 ntCert.[file joi
2050: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 n $certsDir clie
2060: 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 nt.pem].. set
2070: 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65 20 6a caCert..[file j
2080: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 oin $certsDir ca
2090: 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 cert.pem].. s
20a0: 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b 66 69 et serverKey.[fi
20b0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
20c0: 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a 09 20 r server.key]..
20d0: 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 set clientKey
20e0: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 .[file join $cer
20f0: 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 tsDir client.key
2100: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 ]..}. }.}..te
2110: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 st tlsIO-1.1 {ar
2120: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2130: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2140: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2150: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2160: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
2170: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2180: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2190: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
21a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
21b0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
21c0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
21d0: 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 O-1.2 {arg parsi
21e0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
21f0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2200: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2210: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2220: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
2230: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2240: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2250: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2260: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2270: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
2280: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2290: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
22a0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
22b0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
22c0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
22d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
22e0: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
22f0: 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22 20 6f {1 {"-myaddr" o
2300: 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20 66 6f ption must be fo
2310: 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75 65 7d llowed by value}
2320: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2330: 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 4 {arg parsing f
2340: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2350: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2360: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2370: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 ls::socket -myad
2380: 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 dr 127.0.0.1} ms
2390: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
23a0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
23b0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
23c0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
23d0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
23e0: 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 tlsIO-1.5 {arg p
23f0: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2400: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2410: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2420: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2430: 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d et -myport} msg]
2440: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d 6d 79 $msg.} {1 {"-my
2450: 70 6f 72 74 22 20 6f 70 74 69 6f 6e 20 6d 75 73 port" option mus
2460: 74 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 t be followed by
2470: 20 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 20 74 value}}..test t
2480: 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 lsIO-1.6 {arg pa
2490: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
24a0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
24b0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
24c0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
24d0: 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 t -myport xxxx}
24e0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
24f0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2500: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2510: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2520: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2530: 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 t tlsIO-1.7 {arg
2540: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2550: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2560: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2570: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2580: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 cket -myport 252
2590: 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 2} msg] $msg.} {
25a0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
25b0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
25c0: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
25d0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
25e0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b test tlsIO-1.8 {
25f0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2600: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2610: 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b 73 6f -constraints {so
2620: 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a 20 20 cket} -body {.
2630: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2640: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 ls::socket -frob
2650: 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 oz} msg] $msg.}
2660: 2d 6d 61 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 -match glob -res
2670: 75 6c 74 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 ult {1 {bad opti
2680: 6f 6e 20 22 2d 66 72 6f 62 6f 7a 22 3a 20 6d 75 on "-froboz": mu
2690: 73 74 20 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d st be one of *}}
26a0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 ..test tlsIO-1.9
26b0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
26c0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
26d0: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
26e0: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
26f0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2700: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2710: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2720: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
2730: 20 24 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 $msg.} -match g
2740: 6c 6f 62 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b lob -result {1 {
2750: 62 61 64 20 6f 70 74 69 6f 6e 20 22 2d 6d 79 70 bad option "-myp
2760: 6f 72 74 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e ort": must be on
2770: 65 20 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 e of *}}..test t
2780: 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 lsIO-1.10 {arg p
2790: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
27a0: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
27b0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
27c0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
27d0: 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 et host 2528 -ju
27e0: 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 nk} msg] $msg.}
27f0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2800: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2810: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2820: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2830: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 .test tlsIO-1.11
2840: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2850: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2860: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2870: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2880: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2890: 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 r callback 2520
28a0: 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 --} msg] $msg.}
28b0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
28c0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
28d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
28e0: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
28f0: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
2900: 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 tlsIO-1.12 {arg
2910: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2920: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2930: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. 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 66 6f 6f 20 62 61 64 70 6f 72 74 cket foo badport
2960: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2970: 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 {expected integ
2980: 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 er but got "badp
2990: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
29a0: 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e IO-2.1 {tcp conn
29b0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
29c0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
29d0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
29e0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
29f0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
2a00: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
2a10: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
2a20: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
2a30: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
2a40: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
2a50: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 5b er [after 2000 [
2a60: 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 list set x timed
2a70: 5f 6f 75 74 5d 5d 0a 20 20 20 20 7d 0a 20 20 20 _out]]. }.
2a80: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2a90: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2aa0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
2ab0: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
2ac0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2ad0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2ae0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2af0: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
2b00: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2b10: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2b20: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
2b30: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
2b40: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
2b50: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
2b60: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
2b70: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
2b80: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
2b90: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
2ba0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2bb0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2bc0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2bd0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2be0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2bf0: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2c00: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2c10: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
2c20: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2c30: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2c40: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2c50: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
2c60: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
2c70: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
2c80: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2c90: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2ca0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
2cb0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
2cc0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2cd0: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
2ce0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
2cf0: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
2d00: 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 if [info exists
2d10: 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 port] {. incr
2d20: 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 0a 20 port.} else {.
2d30: 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 70 set port [exp
2d40: 72 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 r {$tlsServerPor
2d50: 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d t + [pid]%1024}]
2d60: 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 .}..test tlsIO-2
2d70: 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .2 {tcp connecti
2d80: 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 on with client p
2d90: 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b ort specified} {
2da0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
2db0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
2dc0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
2dd0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
2de0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
2df0: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
2e00: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
2e10: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
2e20: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2e30: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2e40: 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 2000 [list set
2e50: 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 x done]]. }.
2e60: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
2e70: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2e80: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2e90: 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 require 0 -certf
2ea0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2eb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2ec0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2ed0: 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 Key 8829 \]".
2ee0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2ef0: 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 accept {sock ad
2f00: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
2f10: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
2f20: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
2f30: 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 "[gets $sock] $
2f40: 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 port".
2f50: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
2f60: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
2f70: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
2f80: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2f90: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2fa0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
2fb0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
2fc0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
2fd0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
2fe0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
2ff0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
3000: 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 $f x. global
3010: 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 port. if {[ca
3020: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
3030: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 2d -myport $port -
3040: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 63 65 require 0 \..-ce
3050: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3060: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3070: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3080: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
3090: 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d 7d 0.1 8829} sock]}
30a0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
30b0: 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 $sock..catch {c
30c0: 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 lose [tls::socke
30d0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 t 127.0.0.1 8829
30e0: 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ]}. } else {.
30f0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
3100: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
3110: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
3120: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
3130: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
3140: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3150: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3160: 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 x.} [list ready
3170: 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a "hello $port"].
3180: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 .test tlsIO-2.3
3190: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
31a0: 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 with client inte
31b0: 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d rface specified}
31c0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
31d0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
31e0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
31f0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3200: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
3210: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
3220: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
3230: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
3240: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3250: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
3260: 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 er 2000 [list se
3270: 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d t x done]]. }
3280: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3290: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
32a0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
32b0: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 -require 0 -cer
32c0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
32d0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
32e0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
32f0: 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a 20 erKey 8830 \]".
3300: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
3310: 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc accept {sock
3320: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
3330: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
3340: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
3350: 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d ts "[gets $sock]
3360: 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 20 $addr".
3370: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3380: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
3390: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
33a0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
33b0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
33c0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
33d0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
33e0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
33f0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3400: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3410: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3420: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
3430: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
3440: 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 et -myaddr 127.0
3450: 2e 30 2e 31 20 2d 72 65 71 75 69 72 65 20 30 20 .0.1 -require 0
3460: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
3470: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3480: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3490: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
34a0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 127.0.0.1 8830}
34b0: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
34c0: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
34d0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
34e0: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
34f0: 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 lo..catch {flush
3500: 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 $sock}.
3510: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
3520: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
3530: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3540: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3550: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 et x.} {ready {h
3560: 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d ello 127.0.0.1}}
3570: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 ..test tlsIO-2.4
3580: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
3590: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
35a0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
35b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
35c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
35d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
35e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
35f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3600: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3610: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
3620: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3630: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3640: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3650: 74 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 ter 2000 [list s
3660: 65 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 et x done]].
3670: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3680: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3690: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
36a0: 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 t -require 0 -ce
36b0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
36c0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
36d0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
36e0: 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 6c verKey -myaddr l
36f0: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 20 5c 5d ocalhost 8831 \]
3700: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3710: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
3720: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
3730: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
3740: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
3750: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
3760: 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 ck]".
3770: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3780: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3790: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
37a0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
37b0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
37c0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
37d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
37e0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
37f0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3800: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3810: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3820: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
3830: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
3840: 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 -require 0 -cert
3850: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3860: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3870: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3880: 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 6f 73 ientKey localhos
3890: 74 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b t 8831} sock]} {
38a0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
38b0: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
38c0: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
38d0: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
38e0: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
38f0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
3900: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
3910: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3920: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3930: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 et x.} {ready he
3940: 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f llo}..test tlsIO
3950: 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.5 {tcp connec
3960: 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 tion with redund
3970: 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d ant server port}
3980: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3990: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
39a0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
39b0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
39c0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
39d0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
39e0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
39f0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
3a00: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3a10: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
3a20: 65 72 20 32 30 30 30 20 5b 6c 69 73 74 20 73 65 er 2000 [list se
3a30: 74 20 78 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d t x done]]. }
3a40: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3a50: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3a60: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3a70: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 -require 0 -cer
3a80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
3a90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3aa0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
3ab0: 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a 20 erKey 8832 \]".
3ac0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
3ad0: 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc accept {sock
3ae0: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
3af0: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
3b00: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
3b10: 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d ts "[gets $sock]
3b20: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
3b30: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
3b40: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3b50: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
3b60: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3b70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3b80: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
3b90: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3ba0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3bb0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3bc0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3bd0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
3be0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
3bf0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 {tls::socket -re
3c00: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
3c10: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3c20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3c30: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3c40: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
3c50: 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 832} sock]} {.
3c60: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
3c70: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 k. } else {.
3c80: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 puts $soc
3c90: 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 k hello..flush $
3ca0: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 sock. lap
3cb0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
3cc0: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
3cd0: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
3ce0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3cf0: 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f x.} {ready hello
3d00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3d10: 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6 {tcp connectio
3d20: 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 n} {socket} {.
3d30: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
3d40: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
3d50: 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a {set sock [tls::
3d60: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
3d70: 30 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 0 127.0.0.1 8833
3d80: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
3d90: 74 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d tch {gets $sock}
3da0: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 ]} {.. set st
3db0: 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 atus broken..}..
3dc0: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3dd0: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
3de0: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
3df0: 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 O-2.7 {echo serv
3e00: 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 er, one line} {s
3e10: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3e20: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3e30: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3e40: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3e50: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
3e60: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
3e70: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
3e80: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
3e90: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3ea0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3eb0: 32 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 2000 [list set x
3ec0: 20 64 6f 6e 65 5d 5d 0a 20 20 20 20 7d 0a 20 20 done]]. }.
3ed0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3ee0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3ef0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
3f00: 65 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 equire 0 -certfi
3f10: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3f20: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
3f30: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
3f40: 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 ey 8834 \]".
3f50: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3f60: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
3f70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
3f80: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
3f90: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
3fa0: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
3fb0: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
3fc0: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
3fd0: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3fe0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3ff0: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
4000: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
4010: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
4020: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
4030: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
4040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
4050: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
4060: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
4070: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
4080: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
4090: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
40a0: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
40b0: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
40c0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
40d0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
40e0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
40f0: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
4100: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4110: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
4120: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
4130: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
4140: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4150: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
4160: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d ket -require 0 -
4170: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4180: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4190: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
41a0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
41b0: 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 0.0.1 8834].
41c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
41d0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
41e0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
41f0: 20 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f puts $s "hello
4200: 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f abcdefghijklmno
4210: 70 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 p". after 100
4220: 30 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 0. set x [get
4230: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
4240: 24 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 $s. set y [ge
4250: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
4260: 20 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 $f. list $x
4270: 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 $y.} {{hello abc
4280: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 defghijklmnop} d
4290: 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f one}..test tlsIO
42a0: 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 -2.8 {echo serve
42b0: 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 r, loop 50 times
42c0: 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 , single connect
42d0: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
42e0: 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 io} {. set f
42f0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
4300: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
4310: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
4320: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
4330: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
4340: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
4350: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
4360: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
4370: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4380: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
4390: 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 73 e 0 -certfile $s
43a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
43b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
43c0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
43d0: 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 35 \]". puts
43e0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
43f0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
4400: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
4410: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
4420: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
4430: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
4440: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
4450: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
4460: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
4470: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
4480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
4490: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
44a0: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
44b0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
44d0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
44e0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
4510: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
4520: 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 .. incr
4530: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
4540: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
4550: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
4560: 09 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 .set i 0..puts r
4570: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
4580: 5b 61 66 74 65 72 20 32 30 30 30 30 20 5b 6c 69 [after 20000 [li
4590: 73 74 20 73 65 74 20 78 20 64 6f 6e 65 5d 5d 0a st set x done]].
45a0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
45b0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
45c0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 lose $f..puts "d
45d0: 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 one $i". }.
45e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
45f0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4600: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4610: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4620: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
4630: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
4640: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
4650: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4660: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4670: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4680: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
4690: 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 7.0.0.1 8835].
46a0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
46b0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
46c0: 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 catch {..for
46d0: 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c {set x 0} {$x <
46e0: 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 50} {incr x} {.
46f0: 09 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 . puts $s "he
4700: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
4710: 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 mnop".. gets
4720: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
4730: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 close $s. cat
4740: 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 ch {set x [gets
4750: 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]}. close $
4760: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 f. set x.} {d
4770: 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c one 50}..test tl
4780: 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 sIO-2.9 {socket
4790: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
47a0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
47b0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
47c0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
47d0: 20 2d 72 65 71 75 69 72 65 20 30 20 38 38 32 38 -require 0 8828
47e0: 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 ]. removeFile
47f0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
4800: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
4810: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
4820: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
4830: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
4840: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
4850: 65 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 e $f {..package
4860: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 require tls..tls
4870: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4880: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
4890: 20 30 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 20 0 8828. }.
48a0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
48b0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
48c0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
48d0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
48e0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
48f0: 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 after 100.
4900: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
4910: 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d tch {close $f} m
4920: 73 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 sg] [string rang
4930: 65 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 e $msg 0 43]].
4940: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
4950: 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 et x.} {1 {could
4960: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
4970: 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 address already
4980: 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 in use}}..test
4990: 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 tlsIO-2.10 {clos
49a0: 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 e on accept, acc
49b0: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 epted socket liv
49c0: 65 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 es} {socket} {.
49d0: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
49e0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
49f0: 65 72 20 32 30 30 30 30 20 5b 6c 69 73 74 20 73 er 20000 [list s
4a00: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
4a10: 74 5d 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b t]]. set ss [
4a20: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4a30: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
4a40: 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 ire 0 -certfile
4a50: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
4a60: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4a70: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
4a80: 65 79 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f ey 8830]. pro
4a90: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
4aa0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 {..global ss..c
4ab0: 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 lose $ss..fileev
4ac0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
4ad0: 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f "readit $s"..fco
4ae0: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
4af0: 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 s lf. }. p
4b00: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
4b10: 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 ..global done..g
4b20: 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 ets $s..close $s
4b30: 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 ..set done 1.
4b40: 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 }. set cs [t
4b50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
4b60: 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 ire 0 -certfile
4b70: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4b80: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4b90: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4ba0: 65 79 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 ey localhost 883
4bb0: 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0]. close $cs
4bc0: 0a 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 .. vwait done
4bd0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
4be0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 l $timer. set
4bf0: 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 done.} 1..test
4c00: 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 tlsIO-2.11 {dete
4c10: 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 cting new data}
4c20: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 70 {socket} {. p
4c30: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4c40: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 p} {..global soc
4c50: 6b 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 k..# when doing
4c60: 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c an in-process cl
4c70: 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 ient/server test
4c80: 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 , both sides nee
4c90: 64 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 d..# to be non-b
4ca0: 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 locking for the
4cb0: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 TLS handshake.
4cc0: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 Also make sure..
4cd0: 23 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 # to return the
4ce0: 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 channel to line
4cf0: 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a buffering mode..
4d00: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
4d10: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
4d20: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 20 ering line..set
4d30: 73 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 65 sock $s..fileeve
4d40: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
4d50: 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b list do_handshak
4d60: 65 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 e $s]. }..
4d70: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
4d80: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4d90: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
4da0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
4db0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4dc0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
4dd0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
4de0: 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 400]. set soc
4df0: 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 k "". set s2
4e00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
4e10: 71 75 69 72 65 20 30 20 2d 63 65 72 74 66 69 6c quire 0 -certfil
4e20: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4e30: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
4e40: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
4e50: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
4e60: 34 30 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 400]. # when
4e70: 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 doing an in-proc
4e80: 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 ess client/serve
4e90: 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 r test, both sid
4ea0: 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f es need. # to
4eb0: 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 be non-blocking
4ec0: 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e for the TLS han
4ed0: 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b dshake Also mak
4ee0: 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 e sure to. #
4ef0: 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e return the chann
4f00: 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 el to line buffe
4f10: 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 ring mode (TLS s
4f20: 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 ets it to 'none'
4f30: 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ).. fconfigur
4f40: 65 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 20 e $s2 -blocking
4f50: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
4f60: 65 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b e. vwait sock
4f70: 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e . puts $s2 on
4f80: 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a e. flush $s2.
4f90: 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 # need updat
4fa0: 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c e to complete TL
4fb0: 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 S handshake in-p
4fc0: 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 rocess. updat
4fd0: 65 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a e. after 500.
4fe0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4ff0: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
5000: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 . set result
5010: 61 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 a:[gets $sock].
5020: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
5030: 74 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d t b:[gets $sock]
5040: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5050: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
5060: 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 74 1. puts $s2 t
5070: 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 wo. flush $s2
5080: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5090: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
50a0: 31 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 1. lappend re
50b0: 73 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 73 6f sult c:[gets $so
50c0: 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ck]. fconfigu
50d0: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
50e0: 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 ng 1. close $
50f0: 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s2. close $s.
5100: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
5110: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d set result.}
5120: 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 6f {a:one b: c:two
5130: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
5140: 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 12 {tcp connecti
5150: 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 on; no certifica
5160: 74 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 5c tes specified} \
5170: 0a 09 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 ..{socket stdio
5180: 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 unixOnly} {.
5190: 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 # There is a deb
51a0: 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 ug assertion on
51b0: 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 Windows/SSL that
51c0: 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 causes a crash
51d0: 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 when the. # c
51e0: 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 ertificate isn't
51f0: 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 specified..
5200: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
5210: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
5220: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
5230: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
5240: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
5250: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
5260: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
5270: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
5280: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
5290: 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 0 [list set x ti
52a0: 6d 65 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 66 med_out]]..set f
52b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
52c0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
52d0: 71 75 69 72 65 20 30 20 38 38 32 38 5d 0a 09 70 quire 0 8828]..p
52e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
52f0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
5300: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
5310: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
5320: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
5330: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
5340: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
5350: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
5360: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
5370: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
5380: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
5390: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
53a0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
53b0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
53c0: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
53d0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
53e0: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
53f0: 65 20 30 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 e 0 127.0.0.1 88
5400: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 28} msg]} {.
5410: 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 set x $msg.
5420: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
5430: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
5440: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
5450: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5460: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
5470: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
5480: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
5490: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d } {ready done {}
54a0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e }..test tlsIO-3.
54b0: 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 1 {socket confli
54c0: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
54d0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
54e0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
54f0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5500: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5510: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
5520: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
5530: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5540: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5550: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
5560: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
5570: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5580: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
5590: 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 re 0 -certfile $
55a0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
55b0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
55c0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
55d0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
55e0: 20 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 $f {..puts read
55f0: 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 y..gets stdin..c
5600: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
5610: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
5620: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
5630: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5640: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5650: 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r+]. gets $f.
5660: 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 set x [list
5670: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
5680: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5690: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
56a0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
56b0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
56c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
56d0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 38 ile $clientKey 8
56e0: 38 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 828} msg] \...$m
56f0: 73 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 sg]. puts $f
5700: 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 bye. close $f
5710: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
5720: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5730: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
5740: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
5750: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 32 20 .test tlsIO-3.2
5760: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
5770: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
5780: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
5790: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
57a0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
57b0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
57c0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
57d0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
57e0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
57f0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
5800: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
5810: 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 et t1 [after 300
5820: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 00 [list set x t
5830: 69 6d 65 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 imed_out]]..set
5840: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
5850: 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 [list set x time
5860: 64 5f 6f 75 74 5d 5d 0a 09 73 65 74 20 74 33 20 d_out]]..set t3
5870: 5b 61 66 74 65 72 20 33 32 30 30 30 20 5b 6c 69 [after 32000 [li
5880: 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f st set x timed_o
5890: 75 74 5d 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 ut]]..set counte
58a0: 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 r 0. }. pu
58b0: 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 ts $f "set s \[t
58c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
58d0: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
58e0: 72 65 20 30 20 2d 63 65 72 74 66 69 6c 65 20 24 re 0 -certfile $
58f0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
5900: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5910: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
5920: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
5930: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
5940: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
5950: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
5960: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
5970: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
5980: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
5990: 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 ring line..}..pr
59a0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
59b0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
59c0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
59d0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
59e0: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
59f0: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
5a00: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
5a10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5a20: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5a30: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
5a40: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
5a50: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
5a70: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
5a80: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5a90: 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 cel $t1..vwait x
5aa0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5ab0: 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t2..vwait x..aft
5ac0: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 er cancel $t3..c
5ad0: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 lose $s..puts $x
5ae0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
5af0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
5b00: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5b10: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5b20: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5b30: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d set x [gets $f]
5b40: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
5b50: 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 ::socket -requir
5b60: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
5b70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
5b80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
5b90: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
5ba0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
5bb0: 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 0.0.1 8828].
5bc0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d fconfigure $s1 -
5bd0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
5be0: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
5bf0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
5c00: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
5c10: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
5c20: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5c30: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
5c40: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
5c50: 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 0.1 8828]. fc
5c60: 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 onfigure $s2 -bu
5c70: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5c80: 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f set s3 [tls::so
5c90: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
5ca0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5cb0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5cc0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5cd0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
5ce0: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
5cf0: 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 8828]. fcon
5d00: 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 figure $s3 -buff
5d10: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
5d20: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
5d30: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
5d40: 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c {..puts $s1 hel
5d50: 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 31 0a lo,tlsIO-3.2,s1.
5d60: 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 .gets $s1..puts
5d70: 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d $s2 hello,tlsIO-
5d80: 33 2e 32 2c 73 32 0a 09 67 65 74 73 20 24 73 32 3.2,s2..gets $s2
5d90: 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f ..puts $s3 hello
5da0: 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 33 0a 09 67 ,tlsIO-3.2,s3..g
5db0: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
5dc0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
5dd0: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
5de0: 6f 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 70 ose $s3. lapp
5df0: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
5e00: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5e10: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
5e20: 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 done}..test tlsI
5e30: 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 O-4.1 {server wi
5e40: 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e th several clien
5e50: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ts} {socket stdi
5e60: 6f 7d 20 7b 0a 20 20 20 20 23 20 68 61 76 65 20 o} {. # have
5e70: 73 65 65 6e 20 69 6e 74 65 72 6d 69 74 74 65 6e seen intermitten
5e80: 74 20 68 61 6e 67 73 20 6f 6e 20 57 69 6e 64 6f t hangs on Windo
5e90: 77 73 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ws. removeFil
5ea0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5eb0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
5ec0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
5ed0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
5ee0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
5ef0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
5f00: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5f10: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 s..gets stdin.
5f20: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
5f30: 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f "set s \[tls::so
5f40: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
5f50: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5f60: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5f70: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5f80: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
5f90: 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 0.1 8828 \]".
5fa0: 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e puts $f {..fcon
5fb0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
5fc0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b ring line..for {
5fd0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
5fe0: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
5ff0: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
6000: 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 o.. gets $s..
6010: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 }..close $s..put
6020: 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 69 s bye..gets stdi
6030: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 n. }. clos
6040: 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 20 e $f. set p1
6050: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
6060: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
6070: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
6080: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 fconfigure $p
6090: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
60a0: 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 e. set p2 [op
60b0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
60c0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
60d0: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
60e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 2d fconfigure $p2 -
60f0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
6100: 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 set p3 [open
6110: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
6120: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
6130: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
6140: 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 66 nfigure $p3 -buf
6150: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
6160: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
6170: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
6180: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
6190: 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 line..fileevent
61a0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
61b0: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d t echo $s]. }
61c0: 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 7b . proc echo {
61d0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 s} {..global x.
61e0: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
61f0: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 69 ts $s]. i
6200: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
6210: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
6220: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
6230: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
6240: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
6250: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
6260: 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 $l. }.
6270: 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 }. set t1 [a
6280: 66 74 65 72 20 33 30 30 30 30 20 5b 6c 69 73 74 fter 30000 [list
6290: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
62a0: 5d 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 ]]. set t2 [a
62b0: 66 74 65 72 20 33 31 30 30 30 20 5b 6c 69 73 74 fter 31000 [list
62c0: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
62d0: 5d 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 ]]. set t3 [a
62e0: 66 74 65 72 20 33 32 30 30 30 20 5b 6c 69 73 74 fter 32000 [list
62f0: 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 set x timed_out
6300: 5d 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c ]]. set s [tl
6310: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6320: 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 r accept -requir
6330: 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 e 0 \.. -cert
6340: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
6350: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6360: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
6370: 72 4b 65 79 20 38 38 32 38 5d 0a 20 20 20 20 70 rKey 8828]. p
6380: 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 uts $p1 open.
6390: 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 puts $p2 open.
63a0: 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e puts $p3 open
63b0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
63c0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
63d0: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
63e0: 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 ancel $t1. af
63f0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 ter cancel $t2.
6400: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6410: 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $t3. close $s
6420: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
6430: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
6440: 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 t p1 [gets $p1]
6450: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
6460: 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 l [list p2 [gets
6470: 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p2] $x]. la
6480: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 ppend l [list p3
6490: 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a [gets $p3] $x].
64a0: 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 puts $p1 bye
64b0: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 . puts $p2 by
64c0: 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 e. puts $p3 b
64d0: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 ye. close $p1
64e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 . close $p2.
64f0: 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 close $p3.
6500: 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 set l.} {{p1 by
6510: 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 e done} {p2 bye
6520: 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f done} {p3 bye do
6530: 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ne}}..test tlsIO
6540: 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -4.2 {byte order
6550: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
6560: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
6570: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
6580: 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 set x ok. if
6590: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
65a0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
65b0: 64 6f 20 2d 72 65 71 75 69 72 65 20 30 20 30 78 do -require 0 0x
65c0: 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 3000} msg]} {..s
65d0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
65e0: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
65f0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
6600: 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c x.} ok..test tl
6610: 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 sIO-5.1 {byte or
6620: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
6630: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
6640: 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ons} \..{socket
6650: 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 unixOnly notRoot
6660: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 } {. set x {c
6670: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
6680: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
6690: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
66a0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
66b0: 72 76 65 72 20 64 6f 64 6f 20 2d 72 65 71 75 69 rver dodo -requi
66c0: 72 65 20 30 20 30 78 31 7d 20 6d 73 67 5d 7d 20 re 0 0x1} msg]}
66d0: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
66e0: 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 {htons problem,
66f0: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
6700: 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 owed, are you ru
6710: 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 nning as SU?}..c
6720: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
6730: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
6740: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
6750: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 t: not owner}.te
6760: 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 st tlsIO-5.2 {by
6770: 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d te order problem
6780: 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 s, socket number
6790: 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 s, htons} {socke
67a0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
67b0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
67c0: 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 cket: port numbe
67d0: 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 r too high}.
67e0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
67f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6800: 20 64 6f 64 6f 20 2d 72 65 71 75 69 72 65 20 30 dodo -require 0
6810: 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 0x10000} msg]}
6820: 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 {..set x {port r
6830: 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 esolution proble
6840: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6850: 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 allowed}..close
6860: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
6870: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
6880: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
6890: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
68a0: 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 gh}.test tlsIO-5
68b0: 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .3 {byte order p
68c0: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
68d0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
68e0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f \..{socket unixO
68f0: 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 nly notRoot} {.
6900: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
6910: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6920: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 not owner}. i
6930: 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a f {![catch {tls:
6940: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6950: 64 6f 64 6f 20 2d 72 65 71 75 69 72 65 20 30 20 dodo -require 0
6960: 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 21} msg]} {..set
6970: 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 x {htons proble
6980: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6990: 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 allowed, are you
69a0: 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d running as SU?}
69b0: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
69c0: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
69d0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
69e0: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
69f0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 ..test tlsIO-6.1
6a00: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
6a10: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
6a20: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 stdio} {. #
6a30: 54 68 65 72 65 20 69 73 20 61 20 64 65 62 75 67 There is a debug
6a40: 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 assertion on Wi
6a50: 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 ndows/SSL that c
6a60: 61 75 73 65 73 20 61 20 63 72 61 73 68 20 77 68 auses a crash wh
6a70: 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 en the. # cer
6a80: 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 tificate isn't s
6a90: 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 pecified.. re
6aa0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
6ab0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
6ac0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
6ad0: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
6ae0: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
6af0: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
6b00: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
6b10: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 require tls..ge
6b20: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
6b30: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
6b40: 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 tls::socket -ca
6b50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 file $caCert 127
6b60: 2e 30 2e 30 2e 31 20 38 38 34 38 5d 0a 20 20 20 .0.0.1 8848].
6b70: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6b80: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6b90: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6ba0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6bb0: 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 +]. proc bger
6bc0: 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 ror args {..glob
6bd0: 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 al x..set x $arg
6be0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
6bf0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6c00: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
6c10: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6c20: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
6c30: 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ept -require 0 \
6c40: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
6c50: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6c60: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6c70: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6c80: 38 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 8848]. puts $
6c90: 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 f hello. clos
6ca0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d e $f. set tim
6cb0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
6cc0: 5b 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 [list set x time
6cd0: 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 d_out]]. vwai
6ce0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
6cf0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6d00: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e close $s. ren
6d10: 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 ame bgerror {}.
6d20: 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 set x.} {{div
6d30: 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 ide by zero}}..t
6d40: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 est tlsIO-7.1 {t
6d50: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
6d60: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6d70: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
6d80: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
6d90: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
6da0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
6db0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
6dc0: 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 st set auto_path
6dd0: 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 $auto_path].
6de0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
6df0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6e00: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6e10: 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 f [list tls::soc
6e20: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
6e30: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
6e40: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6e50: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6e60: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6e70: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
6e80: 38 32 30 5d 0a 20 20 20 20 70 75 74 73 20 24 66 820]. puts $f
6e90: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
6ea0: 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 args {.. glob
6eb0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
6ec0: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
6ed0: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
6ee0: 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 73 after 10000 [lis
6ef0: 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 t set x timed_ou
6f00: 74 5d 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t]]..vwait x..af
6f10: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6f20: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
6f30: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6f40: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6f50: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6f60: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
6f70: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
6f80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6f90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
6fa0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
6fb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6fc0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
6fd0: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
6fe0: 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 1 8820]. set
6ff0: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
7000: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
7010: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7020: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
7030: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
7040: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
7050: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 [lindex $p 0] 1
7060: 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 27.0.0.1]. la
7070: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
7080: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
7090: 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 $p 2] 8820].
70a0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
70b0: 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d th $p].} {0 0 3}
70c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 ..test tlsIO-7.2
70d0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
70e0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
70f0: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
7100: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
7110: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
7120: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
7130: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
7140: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
7150: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
7160: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
7170: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
7180: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
7190: 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 s $f "tls::socke
71a0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
71b0: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 -require 0 -cer
71c0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
71d0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
71e0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
71f0: 65 72 4b 65 79 20 38 38 32 31 22 0a 20 20 20 20 erKey 8821".
7200: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
7210: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
7220: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
7230: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
7240: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
7250: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
7260: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 20 74 00 [list set x t
7270: 69 6d 65 64 5f 6f 75 74 5d 5d 0a 09 76 77 61 69 imed_out]]..vwai
7280: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
7290: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
72a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
72b0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
72c0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
72d0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
72e0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
72f0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
7300: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
7310: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
7320: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7330: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
7340: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
7350: 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 27.0.0.1 8821].
7360: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
7370: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
7380: 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e]. close $s.
7390: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
73a0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
73b0: 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 ppend l [llength
73c0: 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $p]. lappend
73d0: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d l [lindex $p 0]
73e0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
73f0: 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 string equal [li
7400: 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 5d ndex $p 2] 8821]
7410: 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 .} {3 127.0.0.1
7420: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 0}..test tlsIO-7
7430: 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .3 {testing sock
7440: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
7450: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
7460: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
7470: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
7480: 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 ccept -require 0
7490: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
74a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
74b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
74c0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
74d0: 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 22]. set l [l
74e0: 6c 65 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 length [fconfigu
74f0: 72 65 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 re $s]]. clos
7500: 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a e $s. update.
7510: 20 20 20 20 23 20 41 20 62 75 67 20 66 69 78 65 # A bug fixe
7520: 64 20 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 d in fconfigure
7530: 66 6f 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 for 8.3.4+ make
7540: 74 68 69 73 20 72 65 74 75 72 6e 20 31 34 20 6e this return 14 n
7550: 6f 72 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 ormally,. # b
7560: 75 74 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 ut 12 in older v
7570: 65 72 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 ersions.. exp
7580: 72 20 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 r {$l >= 12 && (
7590: 28 24 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a ($l % 2) == 0)}.
75a0: 7d 20 31 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 } 1..# bug repor
75b0: 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 t #5812 fconfigu
75c0: 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 re doesn't retur
75d0: 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f n value for '-so
75e0: 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c ckname'..test tl
75f0: 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 sIO-7.4 {testing
7600: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
7610: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
7620: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
7630: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7640: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
7650: 69 72 65 20 30 20 5c 0a 09 2d 63 65 72 74 66 69 ire 0 \..-certfi
7660: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7670: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7680: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7690: 65 79 20 38 38 32 33 5d 0a 20 20 20 20 70 72 6f ey 8823]. pro
76a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
76b0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
76c0: 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t x [fconfigure
76d0: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 $s -sockname]..c
76e0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
76f0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
7700: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7710: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7720: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7730: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7740: 65 79 20 5c 0a 20 20 20 20 09 6c 6f 63 61 6c 68 ey \. .localh
7750: 6f 73 74 20 38 38 32 33 5d 0a 20 20 20 20 73 65 ost 8823]. se
7760: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7770: 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 78 0000 [list set x
7780: 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 20 20 timed_out]].
7790: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
77a0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
77b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
77c0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
77d0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
77e0: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
77f0: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
7800: 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 ].} {8823 3}..#
7810: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
7820: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
7830: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
7840: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
7850: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 ..test tlsIO-7.5
7860: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7870: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7880: 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f s} {socket unixO
7890: 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 rPc} {. set s
78a0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
78b0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 erver accept -re
78c0: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
78d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
78e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
78f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7900: 65 72 76 65 72 4b 65 79 20 38 38 32 39 5d 0a 20 erverKey 8829].
7910: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7920: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
7930: 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 x..set x [fconf
7940: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
7950: 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 me]..close $s.
7960: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
7970: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
7980: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
7990: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
79a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
79b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
79c0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
79d0: 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 29]. set time
79e0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b r [after 10000 [
79f0: 6c 69 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 list set x timed
7a00: 5f 6f 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 _out]]. vwait
7a10: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
7a20: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
7a30: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
7a40: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 e $s1. set l
7a50: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
7a60: 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 5b [lindex $x 0] [
7a70: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
7a80: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 ength $x].} {127
7a90: 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 7d 0a 0a .0.0.1 8829 3}..
7aa0: 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e 31 20 7b test tlsIO-8.1 {
7ab0: 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 testing -async f
7ac0: 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 lag on sockets}
7ad0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 {socket} {. #
7ae0: 20 4e 4f 54 45 3a 20 54 68 69 73 20 74 65 73 74 NOTE: This test
7af0: 20 6d 61 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d may fail on som
7b00: 65 20 53 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 e Solaris 2.4 sy
7b10: 73 74 65 6d 73 2e 0a 20 20 20 20 23 20 53 65 65 stems.. # See
7b20: 20 6e 6f 74 65 73 20 69 6e 20 54 63 6c 27 73 20 notes in Tcl's
7b30: 73 6f 63 6b 65 74 2e 74 65 73 74 2e 0a 20 20 20 socket.test..
7b40: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7b50: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7b60: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
7b70: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7b80: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7b90: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7ba0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
7bb0: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
7bc0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7bd0: 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 6e global x..# when
7be0: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
7bf0: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
7c00: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
7c10: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
7c20: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
7c30: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
7c40: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
7c50: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
7c60: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
7c70: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
7c80: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
7c90: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
7ca0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
7cb0: 65 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 e..puts $s bye..
7cc0: 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 30 # Only OpenSSL 0
7cd0: 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 73 .9.5a on Windows
7ce0: 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 74 seems to need t
7cf0: 68 65 20 61 66 74 65 72 20 28 64 65 6c 61 79 65 he after (delaye
7d00: 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 74 d)..# close, but
7d10: 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 74 it works just t
7d20: 68 65 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c 20 he same for all
7d30: 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a 09 others. -hobbs..
7d40: 61 66 74 65 72 20 35 30 30 20 63 6c 6f 73 65 20 after 500 close
7d50: 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 $s..set x done.
7d60: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
7d70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 [tls::socket -re
7d80: 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d quire 0 \.. -
7d90: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
7da0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7db0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7dc0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
7dd0: 2d 61 73 79 6e 63 20 6c 6f 63 61 6c 68 6f 73 74 -async localhost
7de0: 20 38 38 33 30 5d 0a 20 20 20 20 23 20 77 68 65 8830]. # whe
7df0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
7e00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
7e10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
7e20: 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 ides need. #
7e30: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
7e40: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
7e50: 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d andshake Also m
7e60: 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 ake sure to.
7e70: 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 # return the cha
7e80: 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 nnel to line buf
7e90: 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 fering mode (TLS
7ea0: 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e sets it to 'non
7eb0: 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 e').. fconfig
7ec0: 75 72 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e ure $s1 -blockin
7ed0: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
7ee0: 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 78 0a ine. vwait x.
7ef0: 20 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 # TLS handsh
7f00: 61 6b 69 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 aking needs one
7f10: 62 79 74 65 20 66 72 6f 6d 20 74 68 65 20 63 6c byte from the cl
7f20: 69 65 6e 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 ient.... puts
7f30: 20 24 73 31 20 61 0a 20 20 20 20 23 20 6e 65 65 $s1 a. # nee
7f40: 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 d update to comp
7f50: 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 lete TLS handsha
7f60: 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 ke in-process.
7f70: 20 20 75 70 64 61 74 65 0a 20 20 20 20 66 63 6f update. fco
7f80: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 6c 6f nfigure $s1 -blo
7f90: 63 6b 69 6e 67 20 31 0a 20 20 20 20 73 65 74 20 cking 1. set
7fa0: 7a 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 20 z [gets $s1].
7fb0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
7fc0: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
7fd0: 7a 0a 7d 20 62 79 65 0a 0a 0a 74 65 73 74 20 74 z.} bye...test t
7fe0: 6c 73 49 4f 2d 39 2e 31 20 7b 74 65 73 74 69 6e lsIO-9.1 {testin
7ff0: 67 20 73 70 75 72 69 6f 75 73 20 28 30 20 62 79 g spurious (0 by
8000: 74 65 20 72 65 61 64 29 20 65 76 65 6e 74 73 7d te read) events}
8010: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8020: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
8030: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
8040: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
8050: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
8060: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
8070: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
8080: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
8090: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
80a0: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
80b0: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
80c0: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
80d0: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
80e0: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
80f0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
8100: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
8110: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
8120: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
8130: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
8140: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8150: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
8160: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 $s -blocking 0..
8170: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
8180: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
8190: 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 andshake $s read
81a0: 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 able readlittle
81b0: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e \...-buffering n
81c0: 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 one]. }. s
81d0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
81e0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
81f0: 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 -require 0 \..
8200: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
8210: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
8220: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8230: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
8240: 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 1]. set c [tl
8250: 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 s::socket -requi
8260: 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 re 0 \.. -cer
8270: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8280: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8290: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
82a0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 ntKey \.. loc
82b0: 61 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 alhost 8831].
82c0: 20 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 # This differs
82d0: 66 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 from socket-9.1
82e0: 69 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 in that both sid
82f0: 65 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 es need to be.
8300: 20 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 # non-blocking
8310: 20 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 because of TLS'
8320: 20 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 required handsh
8330: 61 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ake. fconfigu
8340: 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $c -blocking
8350: 30 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 0. puts -none
8360: 77 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 wline $c 0123456
8370: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
8380: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
8390: 39 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 90123456789.
83a0: 66 6c 75 73 68 20 24 63 0a 20 20 20 20 73 65 74 flush $c. set
83b0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
83c0: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 64 6f 000 [list set do
83d0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 5d 5d 0a 20 ne timed_out]].
83e0: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 5b 6c after 1000 [l
83f0: 69 73 74 20 63 6c 6f 73 65 20 24 63 5d 0a 20 20 ist close $c].
8400: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8410: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
8420: 69 6d 65 72 0a 20 20 20 20 63 61 74 63 68 20 7b imer. catch {
8430: 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 6c 69 close $s}. li
8440: 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 st $spurious $le
8450: 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 n.} {0 50}..test
8460: 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 tlsIO-9.2 {test
8470: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
8480: 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 fileevents, flu
8490: 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f sh on close} {so
84a0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
84b0: 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 firstblock [stri
84c0: 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a ng repeat a 31].
84d0: 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c set secondbl
84e0: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
84f0: 61 74 20 62 20 36 35 35 33 35 5d 0a 20 20 20 20 at b 65535].
8500: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8510: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
8520: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
8530: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
8540: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f eadable [list do
8550: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 _handshake $s re
8560: 61 64 61 62 6c 65 20 72 65 61 64 61 62 6c 65 20 adable readable
8570: 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 69 6f 6e \...-translation
8580: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
8590: 31 36 33 38 34 20 2d 62 75 66 66 65 72 69 6e 67 16384 -buffering
85a0: 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 line]. }.
85b0: 20 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b proc readable {
85c0: 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 s} {..set l [get
85d0: 73 20 24 73 5d 0a 09 64 70 75 74 73 20 22 67 6f s $s]..dputs "go
85e0: 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c t \"[string repl
85f0: 61 63 65 20 24 6c 20 31 30 20 65 6e 64 2d 33 20 ace $l 10 end-3
8600: 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 ...]\" \...([str
8610: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 29 20 ing length $l])
8620: 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c 65 65 76 from $s"..fileev
8630: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
8640: 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 72 {}..after 1000 r
8650: 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a espond $s. }.
8660: 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 proc respond
8670: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 {s} {..global f
8680: 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 75 74 73 irstblock..dputs
8690: 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 "send \"[string
86a0: 20 72 65 70 6c 61 63 65 20 24 66 69 72 73 74 62 replace $firstb
86b0: 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e lock 10 end-3 ..
86c0: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e .]\" \...([strin
86d0: 67 20 6c 65 6e 67 74 68 20 24 66 69 72 73 74 62 g length $firstb
86e0: 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a lock]) down $s".
86f0: 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 .puts -nonewline
8700: 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a $s $firstblock.
8710: 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 .after 1000 writ
8720: 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 edata $s. }.
8730: 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 proc writedat
8740: 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a {s} {..global
8750: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 75 secondblock..dpu
8760: 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 ts "send \"[stri
8770: 6e 67 20 72 65 70 6c 61 63 65 20 24 73 65 63 6f ng replace $seco
8780: 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 ndblock 10 end-3
8790: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
87a0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 73 65 63 ring length $sec
87b0: 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 ondblock]) down
87c0: 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 $s"..puts -nonew
87d0: 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 line $s $secondb
87e0: 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a 20 lock..close $s.
87f0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
8800: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
8810: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
8820: 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 ire 0 \.. -ce
8830: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
8840: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8850: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
8860: 76 65 72 4b 65 79 20 38 38 33 39 5d 0a 20 20 20 verKey 8839].
8870: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8880: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
8890: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
88a0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
88b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
88c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
88d0: 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 \.. localhost
88e0: 20 38 38 33 39 5d 0a 20 20 20 20 66 63 6f 6e 66 8839]. fconf
88f0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
8900: 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d ng 0 -trans lf -
8910: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
8920: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
8930: 20 20 20 70 75 74 73 20 24 63 20 68 65 6c 6c 6f puts $c hello
8940: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
8950: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
8960: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 ount done..set d
8970: 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 ata [read $s]..d
8980: 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b 73 74 puts "read \"[st
8990: 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 64 61 ring replace $da
89a0: 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ta 10 end-3 ...]
89b0: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
89c0: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 20 66 length $data]) f
89d0: 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 6f rom $s"..incr co
89e0: 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 unt [string leng
89f0: 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b th $data]..if {[
8a00: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
8a10: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
8a20: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
8a30: 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 }. fileevent
8a40: 24 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $c readable [lis
8a50: 74 20 72 65 61 64 69 74 20 24 63 5d 0a 20 20 20 t readit $c].
8a60: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
8a70: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8a80: 20 31 30 30 30 30 20 5b 6c 69 73 74 20 73 65 74 10000 [list set
8a90: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 5d done timed_out]
8aa0: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
8ab0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
8ac0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 61 74 l $timer. cat
8ad0: 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 0a 20 20 ch {close $c}.
8ae0: 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 catch {close $
8af0: 73 7d 0a 20 20 20 20 6c 69 73 74 20 24 63 6f 75 s}. list $cou
8b00: 6e 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 nt $done.} {6556
8b10: 36 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 6 1}..test tlsIO
8b20: 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 4f -9.3 {testing EO
8b30: 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 F stickyness} {u
8b40: 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 nexplainedFailur
8b50: 65 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 e socket} {.
8b60: 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 # HOBBS: never w
8b70: 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a orked correctly.
8b80: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 proc count_t
8b90: 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f o_eof {s} {..glo
8ba0: 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 bal count done t
8bb0: 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 imer..set l [get
8bc0: 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 s $s]..if {[eof
8bd0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 $s]} {.. incr
8be0: 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b count.. if {
8bf0: 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 $count > 9} {...
8c00: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
8c10: 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 one true...set c
8c20: 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 ount {eof is sti
8c30: 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e cky}...after can
8c40: 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 cel $timer..
8c50: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 }..}. }. p
8c60: 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d roc timerproc {}
8c70: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 {..global done
8c80: 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e count c..set don
8c90: 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e e true..set coun
8ca0: 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 t {timer went of
8cb0: 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 f, eof is not st
8cc0: 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a icky}..close $c.
8cd0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 6f }. set co
8ce0: 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f unt 0. set do
8cf0: 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f ne false. pro
8d00: 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f c write_then_clo
8d10: 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 se {s} {..puts $
8d20: 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a s bye..close $s.
8d30: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
8d40: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8d50: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
8d60: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
8d70: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
8d80: 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 slation lf..file
8d90: 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c event $s writabl
8da0: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 e [list do_hands
8db0: 68 61 6b 65 20 24 73 20 77 72 69 74 61 62 6c 65 hake $s writable
8dc0: 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 write_then_clos
8dd0: 65 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 e \...-buffering
8de0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
8df0: 6f 6e 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 on lf]. }.
8e00: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
8e10: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
8e20: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
8e30: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8e40: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
8e50: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8e60: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
8e70: 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 833]. set c [
8e80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
8e90: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
8ea0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
8eb0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8ec0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
8ed0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c ientKey \.. l
8ee0: 6f 63 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 ocalhost 8833].
8ef0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
8f00: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
8f10: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8f20: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
8f30: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
8f40: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f adable "count_to
8f50: 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 _eof $c". set
8f60: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
8f70: 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 00 timerproc].
8f80: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8f90: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
8fa0: 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 t count.} {eof i
8fb0: 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 s sticky}..remov
8fc0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 eFile script..te
8fd0: 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 st tlsIO-10.1 {t
8fe0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 esting socket ac
8ff0: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
9000: 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 ror handling} {s
9010: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
9020: 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 goterror 0.
9030: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
9040: 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 s {global goterr
9050: 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 or; set goterror
9060: 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 1}. set s [t
9070: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
9080: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
9090: 72 65 20 30 20 2d 63 61 66 69 6c 65 20 24 63 61 re 0 -cafile $ca
90a0: 43 65 72 74 20 38 38 39 38 5d 0a 20 20 20 20 70 Cert 8898]. p
90b0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
90c0: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 p} {close $s; er
90d0: 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b ror}. set c [
90e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
90f0: 75 69 72 65 20 30 20 2d 63 61 66 69 6c 65 20 24 uire 0 -cafile $
9100: 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 caCert 127.0.0.1
9110: 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 74 8898]. vwait
9120: 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 6c goterror. cl
9130: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
9140: 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 65 $c. set gote
9150: 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 rror.} 1..test t
9160: 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 lsIO-11.1 {tcp c
9170: 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b onnection} {sock
9180: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9190: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
91a0: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
91b0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
91c0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
91d0: 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 1_test_server [t
91e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
91f0: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
9200: 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 re 0 \...-certfi
9210: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9220: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9230: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9240: 65 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 ey 8834]..proc a
9250: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
9260: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9270: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
9280: 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c $s done.. cl
9290: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
92a0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
92b0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
92c0: 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 0 \.. -certfi
92d0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
92e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
92f0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9300: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9310: 65 53 65 72 76 65 72 49 50 20 38 38 33 34 5d 0a eServerIP 8834].
9320: 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 set r [gets
9330: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
9340: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9350: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 {close $socket9
9360: 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _1_test_server}.
9370: 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 set r.} done
9380: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9390: 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 66 2 {client specif
93a0: 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 ies its port} {s
93b0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
93c0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
93d0: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
93e0: 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 xists port]} {..
93f0: 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 incr port. }
9400: 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 else {..set port
9410: 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 76 [expr {$tlsServ
9420: 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 erPort + [pid]%1
9430: 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 024}]. }.
9440: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
9450: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9460: 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f ..set socket9_2_
9470: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
9480: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
9490: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
94a0: 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 0 \...-certfile
94b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
94c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
94d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
94e0: 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 8835]..proc acc
94f0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9500: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9510: 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 e $s.. puts $
9520: 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 s $p.. close
9530: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
9540: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9550: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
9560: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9570: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9580: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9590: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
95a0: 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 .. -myport $p
95b0: 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ort $remoteServe
95c0: 72 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 rIP 8835]. se
95d0: 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t r [gets $s].
95e0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
95f0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9600: 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 e $socket9_2_tes
9610: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 t_server}. if
9620: 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b {$r == $port} {
9630: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a ..set result ok.
9640: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 } else {..se
9650: 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a t result broken.
9660: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 }. set re
9670: 73 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 sult.} ok..test
9680: 74 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 tlsIO-11.3 {tryi
9690: 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e ng to connect, n
96a0: 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 o server} {socke
96b0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
96c0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
96d0: 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 set status ok.
96e0: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
96f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9700: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
9710: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9720: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9730: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9740: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9750: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9760: 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 7b verIp 8836]}]} {
9770: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 ..if {![catch {g
9780: 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 ets $s}]} {..
9790: 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b set status brok
97a0: 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a en..}..close $s.
97b0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 }. set st
97c0: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 atus.} ok..test
97d0: 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f tlsIO-11.4 {remo
97e0: 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e te echo, one lin
97f0: 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 e} {socket doTes
9800: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9810: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
9820: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
9830: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
9840: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f socket10_6_test_
9850: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
9860: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
9870: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
9880: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
9890: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
98a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
98b0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
98c0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
98d0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
98e0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
98f0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9900: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
9910: 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 echo $s].. f
9920: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
9930: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
9940: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 anslation crlf..
9950: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
9960: 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 {.. set l [g
9970: 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 ets $s].. if
9980: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
9990: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
99a0: 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 lse {...puts $s
99b0: 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $l.. }..}.
99c0: 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c }. set f [tl
99d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 s::socket -requi
99e0: 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 re 0 \.. -cer
99f0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9a00: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9a10: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9a20: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9a30: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
9a40: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
9a50: 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $f -translatio
9a60: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
9a70: 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 g line. puts
9a80: 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 $f hello. set
9a90: 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 r [gets $f].
9aa0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
9ab0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9ac0: 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 $socket10_6_tes
9ad0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
9ae0: 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 t r.} hello..tes
9af0: 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 t tlsIO-11.5 {re
9b00: 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 mote echo, 50 li
9b10: 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nes} {socket doT
9b20: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9b30: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
9b40: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
9b50: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9b60: 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 t socket10_7_tes
9b70: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
9b80: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
9b90: 63 65 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 cept -require 0
9ba0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
9bb0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9bc0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9bd0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
9be0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
9bf0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
9c00: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
9c10: 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 s.. fileevent
9c20: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
9c30: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
9c40: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
9c50: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
9c60: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
9c70: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
9c80: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
9c90: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
9ca0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
9cb0: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
9cc0: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
9cd0: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
9ce0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b }. set f [
9cf0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
9d00: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
9d10: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9d20: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9d30: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9d40: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9d50: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9d60: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9d70: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
9d80: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
9d90: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
9da0: 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 {set cnt 0} {$c
9db0: 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 nt < 50} {incr c
9dc0: 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 nt} {..puts $f "
9dd0: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 hello, $cnt"..if
9de0: 20 7b 5b 67 65 74 73 20 24 66 5d 20 6e 65 20 22 {[gets $f] ne "
9df0: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 7d 20 7b 0a hello, $cnt"} {.
9e00: 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 . break..}.
9e10: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
9e20: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9e30: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
9e40: 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0_7_test_server}
9e50: 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 . set cnt.} 5
9e60: 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 0..# Macintosh s
9e70: 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 ockets can have
9e80: 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 more than one se
9e90: 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 rver per port.if
9ea0: 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 {$tcl_platform(
9eb0: 70 6c 61 74 66 6f 72 6d 29 20 65 71 20 22 6d 61 platform) eq "ma
9ec0: 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 cintosh"} {.
9ed0: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
9ee0: 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c lt {0 8836}.} el
9ef0: 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e se {. set con
9f00: 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b flictResult {1 {
9f10: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
9f20: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
9f30: 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d ready in use}}.}
9f40: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9f50: 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 6 {socket confli
9f60: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ct} {socket doTe
9f70: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9f80: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ver} {. set s
9f90: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 1 [tls::socket -
9fa0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
9fb0: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
9fc0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9fd0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9fe0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9ff0: 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a serverKey 8836].
a000: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
a010: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
a020: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
a030: 70 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a pt -require 0 \.
a040: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a050: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a060: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a070: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
a080: 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 836]} msg]} {..s
a090: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
a0a0: 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 1 $msg]. } el
a0b0: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
a0c0: 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 [list 0 [lindex
a0d0: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 [fconfigure $s2
a0e0: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a -sockname] 2]].
a0f0: 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d .close $s2. }
a100: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
a110: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
a120: 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a $conflictResult.
a130: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 .test tlsIO-11.7
a140: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 {server with se
a150: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b veral clients} {
a160: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
a170: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
a180: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
a190: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
a1a0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
a1b0: 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 et10_9_test_serv
a1c0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
a1d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
a1e0: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 require 0 \...-c
a1f0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
a200: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a210: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
a220: 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 rverKey 8836]..p
a230: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
a240: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
a250: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
a260: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
a270: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
a280: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
a290: 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 ]..}..proc echo
a2a0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
a2b0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
a2c0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a2d0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a2e0: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
a2f0: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
a300: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
a310: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 [tls::socket -r
a320: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
a330: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a340: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a350: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a360: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a370: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a380: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
a390: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
a3a0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
a3b0: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
a3c0: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 t -require 0 \..
a3d0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a3e0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a3f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a400: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a410: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a420: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
a430: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
a440: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
a450: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
a460: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
a470: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
a480: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
a490: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a4a0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
a4b0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
a4c0: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
a4d0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
a4e0: 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 3 -buffering lin
a4f0: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 e. for {set i
a500: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
a510: 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 incr i} {..puts
a520: 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d $s1 hello,tlsIO-
a530: 31 31 2e 37 2c 73 31 0a 09 67 65 74 73 20 24 73 11.7,s1..gets $s
a540: 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 1..puts $s2 hell
a550: 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 32 0a o,tlsIO-11.7,s2.
a560: 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 .gets $s2..puts
a570: 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d $s3 hello,tlsIO-
a580: 31 31 2e 37 2c 73 33 0a 09 67 65 74 73 20 24 73 11.7,s3..gets $s
a590: 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 3. }. clos
a5a0: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a5b0: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a5c0: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a5d0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
a5e0: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
a5f0: 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 }. set i.} 10
a600: 30 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 0..test tlsIO-11
a610: 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 .8 {client with
a620: 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d several servers}
a630: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
a640: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
a650: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 } {. sendCert
a660: 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 Values. sendC
a670: 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a 69 ommand {..tls::i
a680: 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 nit -certfile $s
a690: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a6a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a6b0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 73 le $serverKey..s
a6c0: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
a6d0: 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 et -server "acce
a6e0: 70 74 20 34 30 30 33 22 20 2d 72 65 71 75 69 72 pt 4003" -requir
a6f0: 65 20 30 20 34 30 30 33 5d 0a 09 73 65 74 20 73 e 0 4003]..set s
a700: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 2 [tls::socket -
a710: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
a720: 30 30 34 22 20 2d 72 65 71 75 69 72 65 20 30 20 004" -require 0
a730: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
a740: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
a750: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 er "accept 4005"
a760: 20 2d 72 65 71 75 69 72 65 20 30 20 34 30 30 35 -require 0 4005
a770: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
a780: 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 e {s mp} {..
a790: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a7a0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a7b0: 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 } elseif {[catch
a7c0: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
a7d0: 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a $s} result]} {.
a7e0: 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 ..# Some errors
a7f0: 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 are normal...
a800: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
a810: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 lt == 1} {...# H
a820: 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 andshake complet
a830: 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 e...fileevent $s
a840: 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 readable ""...p
a850: 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f uts $s $mp...clo
a860: 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a se $s.. }..}.
a870: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 .proc accept {mp
a880: 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 s a p} {.. #
a890: 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 These have to a
a8a0: 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 ccept non-blocki
a8b0: 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 ng, because the
a8c0: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 handshaking..
a8d0: 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 # order isn't d
a8e0: 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 eterministic..
a8f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
a900: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
a910: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
a920: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
a930: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e adable [list han
a940: 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 dshake $s $mp]..
a950: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a }. }. tls:
a960: 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 :init -certfile
a970: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a980: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a990: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a file $clientKey.
a9a0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
a9b0: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
a9c0: 20 30 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 0 $remoteServer
a9d0: 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 IP 4003]. set
a9e0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
a9f0: 20 2d 72 65 71 75 69 72 65 20 30 20 24 72 65 6d -require 0 $rem
aa00: 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 oteServerIP 4004
aa10: 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c ]. set s3 [tl
aa20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 s::socket -requi
aa30: 72 65 20 30 20 24 72 65 6d 6f 74 65 53 65 72 76 re 0 $remoteServ
aa40: 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 erIP 4005]. s
aa50: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
aa60: 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d end l [gets $s1]
aa70: 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 [gets $s1] [eof
aa80: 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d $s1] [gets $s2]
aa90: 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 [gets $s2] [eof
aaa0: 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 $s2] \..[gets $
aab0: 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b s3] [gets $s3] [
aac0: 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f eof $s3]. clo
aad0: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
aae0: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
aaf0: 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 s3. sendComma
ab00: 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a nd {..close $s1.
ab10: 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 .close $s2..clos
ab20: 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 e $s3. }.
ab30: 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d set l.} {4003 {}
ab40: 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 1 4004 {} 1 400
ab50: 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 5 {} 1}..test tl
ab60: 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 sIO-11.9 {accept
ab70: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
ab80: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
ab90: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
aba0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
abb0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
abc0: 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 er accept -requi
abd0: 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 65 72 re 0 \.. -cer
abe0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
abf0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
ac00: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
ac10: 65 72 4b 65 79 20 38 38 33 36 5d 0a 20 20 20 20 erKey 8836].
ac20: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
ac30: 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 p} {expr 10 / 0
ac40: 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 }. proc bgerr
ac50: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
ac60: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
ac70: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
ac80: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 69 66 ertValues. if
ac90: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
aca0: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
acb0: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
acc0: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
acd0: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
ace0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
acf0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
ad00: 30 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 0 \... -certf
ad10: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
ad20: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
ad30: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
ad40: 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e Key \... [lin
ad50: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
ad60: 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 8836].. clos
ad70: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
ad80: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
ad90: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
ada0: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
adb0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 [after 10000 [li
adc0: 73 74 20 73 65 74 20 78 20 74 69 6d 65 64 5f 6f st set x timed_o
add0: 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut]]. vwait x
ade0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
adf0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
ae00: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
ae10: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
ae20: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
ae30: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
ae40: 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 tlsIO-11.10 {te
ae50: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
ae60: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
ae70: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
ae80: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
ae90: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
aea0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
aeb0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
aec0: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
aed0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
aee0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
aef0: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d -require 0 \...-
af00: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
af10: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
af20: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
af30: 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 erverKey 8836]..
af40: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
af50: 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 p} {close $s}.
af60: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
af70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
af80: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
af90: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
afa0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
afb0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
afc0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
afd0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
afe0: 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 836]. set p [
aff0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
b000: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 eername]. set
b010: 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 n [fconfigure $
b020: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
b030: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
b040: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
b050: 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $p 2] [llength $
b060: 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a p] [llength $p].
b070: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
b080: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
b090: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 ose $socket10_12
b0a0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
b0b0: 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 set l.} {8836
b0c0: 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 3 3}..test tlsIO
b0d0: 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 -11.11 {testing
b0e0: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
b0f0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
b100: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
b110: 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 } {. # remote
b120: 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 equivalent of 9
b130: 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 .1. sendCertV
b140: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
b150: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
b160: 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72 20 ket_test_server
b170: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
b180: 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 rver accept -req
b190: 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 uire 0 \...-cert
b1a0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
b1b0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b1c0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
b1d0: 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 rKey 8836]..proc
b1e0: 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b handshake {s} {
b1f0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
b200: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
b210: 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b .. } elseif {
b220: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e [catch {tls::han
b230: 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c dshake $s} resul
b240: 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 t]} {...# Some e
b250: 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c rrors are normal
b260: 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 ... } elseif
b270: 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b {$result == 1} {
b280: 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 ...# Handshake c
b290: 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 omplete...fileev
b2a0: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
b2b0: 22 22 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 ""...after 100 w
b2c0: 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 ritesome $s..
b2d0: 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 }..}..proc acce
b2e0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
b2f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
b300: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 -translation "au
b310: 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 to lf".. file
b320: 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c event $s writabl
b330: 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b e [list handshak
b340: 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 e $s]..}..proc w
b350: 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 ritesome {s} {..
b360: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
b370: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
b380: 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 cr i} {...puts $
b390: 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 s "line $i from
b3a0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 remote server"..
b3b0: 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 }.. close
b3c0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
b3d0: 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 set len 0. s
b3e0: 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 et spurious 0.
b3f0: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
b400: 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 proc readlittle
b410: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
b420: 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e purious done len
b430: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b440: 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 1]..if {[string
b450: 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 length $l] == 0
b460: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 } {.. if {![e
b470: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 of $s]} {...incr
b480: 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d spurious.. }
b490: 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 else {...close
b4a0: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a $s...set done 1.
b4b0: 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b . }..} else {
b4c0: 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b .. incr len [
b4d0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
b4e0: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 ]..}. }. s
b4f0: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
b500: 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 t -require 0 \..
b510: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
b520: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b530: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b540: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b550: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
b560: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 23 erIP 8836]. #
b570: 20 47 65 74 20 74 68 65 20 62 75 66 66 65 72 69 Get the bufferi
b580: 6e 67 20 63 6f 72 72 65 63 74 65 64 0a 20 20 20 ng corrected.
b590: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
b5a0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
b5b0: 20 20 20 23 20 50 75 74 20 61 20 62 79 74 65 20 # Put a byte
b5c0: 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 6e 74 20 into the client
b5d0: 70 69 70 65 20 74 6f 20 74 72 69 67 67 65 72 20 pipe to trigger
b5e0: 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a TLS handshaking.
b5f0: 20 20 20 20 70 75 74 73 20 24 63 20 61 0a 20 20 puts $c a.
b600: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
b610: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 eadable [list re
b620: 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a 20 20 20 adlittle $c].
b630: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
b640: 72 20 31 30 30 30 30 20 5b 6c 69 73 74 20 73 65 r 10000 [list se
b650: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
b660: 5d 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e ]]. vwait don
b670: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
b680: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
b690: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
b6a0: 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 $socket_test_se
b6b0: 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 rver}. list $
b6c0: 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 spurious $len.}
b6d0: 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 {0 2690}..test t
b6e0: 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 lsIO-11.12 {test
b6f0: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
b700: 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ss} {unexplained
b710: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 Failure socket d
b720: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
b730: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 Server} {. #
b740: 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e remote equivalen
b750: 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 t of 9.3. # H
b760: 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b OBBS: never work
b770: 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 ed correctly.
b780: 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 set counter 0.
b790: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
b7a0: 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 proc count_up
b7b0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
b7c0: 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 unter done after
b7d0: 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 _id..set l [gets
b7e0: 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $s]..if {[eof $
b7f0: 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 s]} {.. incr
b800: 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 counter.. if
b810: 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b {$counter > 9} {
b820: 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 ...set done {EOF
b830: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
b840: 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 ter cancel $afte
b850: 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a r_id...close $s.
b860: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
b870: 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f proc timed_o
b880: 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 ut {} {..global
b890: 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 c done..set done
b8a0: 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 {timed_out, EOF
b8b0: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
b8c0: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a .close $c. }.
b8d0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
b8e0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
b8f0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
b900: 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 10_14_test_serve
b910: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
b920: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 20 2d server accept -
b930: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 09 2d 63 require 0 \...-c
b940: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
b950: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
b960: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
b970: 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 rverKey 8836]..p
b980: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b990: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b9a0: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b9b0: 20 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 after 100 close
b9c0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
b9d0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
b9e0: 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c ket -require 0 \
b9f0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
ba00: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
ba10: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
ba20: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
ba30: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
ba40: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
ba50: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
ba60: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 adable "count_up
ba70: 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 $c". set aft
ba80: 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 er_id [after 100
ba90: 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 0 timed_out].
baa0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
bab0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
bac0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f se $socket10_14_
bad0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
bae0: 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 set done.} {EOF
baf0: 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 is sticky}..tes
bb00: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 t tlsIO-11.13 {t
bb10: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
bb20: 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c te, async flush,
bb30: 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a async close} \.
bb40: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
bb50: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
bb60: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 } {. proc rea
bb70: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
bb80: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
bb90: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
bba0: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
bbb0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
bbc0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
bbd0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
bbe0: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
bbf0: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
bc00: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
bc10: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 Command {..set f
bc20: 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e irstblock [strin
bc30: 67 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a 09 g repeat a 31]..
bc40: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
bc50: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 [string repeat b
bc60: 20 36 35 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 65535]..set l [
bc70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
bc80: 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 75 ver accept -requ
bc90: 69 72 65 20 30 20 5c 0a 09 09 2d 63 65 72 74 66 ire 0 \...-certf
bca0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
bcb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
bcc0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
bcd0: 4b 65 79 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 Key 8845]..proc
bce0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
bcf0: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
bd00: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f hake $s.. fco
bd10: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
bd20: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
bd30: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
bd40: 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 20 20 20 ze 16384 \...
bd50: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
bd60: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
bd70: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
bd80: 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 dable $s"..}..pr
bd90: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
bda0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
bdb0: 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 ts $s].. file
bdc0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
bdd0: 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 e {}.. after
bde0: 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 1000 respond $s.
bdf0: 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 .}..proc respond
be00: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 {s} {.. glob
be10: 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 al firstblock..
be20: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
be30: 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 ne $s $firstbloc
be40: 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 k.. after 100
be50: 30 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 0 writedata $s..
be60: 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 }..proc writedat
be70: 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f a {s} {.. glo
be80: 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a bal secondblock.
be90: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
bea0: 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 line $s $secondb
beb0: 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 lock.. close
bec0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
bed0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
bee0: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a et -require 0 \.
bef0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
bf00: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
bf10: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
bf20: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
bf30: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
bf40: 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 20 20 verIP 8845].
bf50: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
bf60: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
bf70: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
bf80: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
bf90: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 t count 0. pu
bfa0: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $s hello.
bfb0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
bfc0: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
bfd0: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
bfe0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 [after 10000 [li
bff0: 73 74 20 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 st set done time
c000: 64 5f 6f 75 74 5d 5d 0a 20 20 20 20 76 77 61 69 d_out]]. vwai
c010: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
c020: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
c030: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
c040: 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 close $l}. se
c050: 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a t count.} 65566.
c060: 0a 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 74 .proc getdata {t
c070: 79 70 65 20 66 69 6c 65 7d 20 7b 0a 20 20 20 20 ype file} {.
c080: 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f # Read handler o
c090: 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 n the accepted s
c0a0: 6f 63 6b 65 74 2e 0a 20 20 20 20 67 6c 6f 62 61 ocket.. globa
c0b0: 6c 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 66 l x. global f
c0c0: 61 69 6c 65 64 0a 20 20 20 20 73 65 74 20 73 74 ailed. set st
c0d0: 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 atus [catch {rea
c0e0: 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 20 d $file} data].
c0f0: 20 20 20 69 66 20 7b 24 73 74 61 74 75 73 20 21 if {$status !
c100: 3d 20 30 7d 20 7b 0a 09 73 65 74 20 78 20 22 72 = 0} {..set x "r
c110: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
c120: 72 20 77 61 73 20 24 64 61 74 61 22 0a 09 63 61 r was $data"..ca
c130: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
c140: 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 e }. } elseif
c150: 20 7b 24 64 61 74 61 20 6e 65 20 7b 7d 7d 20 7b {$data ne {}} {
c160: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
c170: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d fblocked $file]}
c180: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 {. } elseif
c190: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
c1a0: 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a .if {$failed} {.
c1b0: 09 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70 . set x "$typ
c1c0: 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 e socket was inh
c1d0: 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 65 20 erited"..} else
c1e0: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74 {.. set x "$t
c1f0: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ype socket was n
c200: 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d ot inherited"..}
c210: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
c220: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
c230: 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70 se {..set x {imp
c240: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 63 ossible case}..c
c250: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
c260: 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 le }. }. r
c270: 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c eturn.}..test tl
c280: 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e sIO-12.1 {testin
c290: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
c2a0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d server sockets}
c2b0: 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b {socket exec} {
c2c0: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
c2d0: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b script1. mak
c2e0: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 eFile {} script2
c2f0: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
c300: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
c310: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
c320: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c330: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
c340: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
c350: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
c360: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
c370: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c380: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
c390: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
c3a0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c3b0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c3c0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
c3d0: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 ript2 creates th
c3e0: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c e server socket,
c3f0: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
c400: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 1,. # waits a
c410: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 second, and exi
c420: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 ts. The server
c430: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a socket will now.
c440: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 # be closed
c450: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 unless script1 i
c460: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 nherited it...
c470: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c480: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c490: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c4a0: 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a clsh $::tcltest:
c4b0: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
c4c0: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
c4d0: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
c4e0: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
c4f0: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
c500: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
c510: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
c520: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c530: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c540: 72 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 require 0 \..
c550: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
c560: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
c570: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
c580: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 5c $serverKey 8828\
c590: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
c5a0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
c5b0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d file addr port }
c5c0: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 {.. close $f
c5d0: 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 74 63 ile..}..exec $tc
c5e0: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 63 lsh script1 &..c
c5f0: 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 lose $f..after 1
c600: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
c610: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
c620: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
c630: 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 # Launch script2
c640: 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f and wait 5 seco
c650: 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a nds.. exec $:
c660: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
c670: 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 t script2 &.
c680: 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 after 5000 { set
c690: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 ok_to_proceed 1
c6a0: 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f }. vwait ok_
c6b0: 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 to_proceed..
c6c0: 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c # If we can stil
c6d0: 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 l connect to the
c6e0: 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 server, the soc
c6f0: 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 ket got inherite
c700: 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 d... if {[cat
c710: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
c720: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 63 -require 0 \..-c
c730: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
c740: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c750: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
c760: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 ientKey \. . 1
c770: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
c780: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 sg]} {..set x {s
c790: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
c7a0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
c7b0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
c7c0: 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 ose $msg..set x
c7d0: 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 {server socket w
c7e0: 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 as inherited}.
c7f0: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d }.. set x.}
c800: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c810: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c820: 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 d}..test tlsIO-1
c830: 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.2 {testing inh
c840: 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 eritance of clie
c850: 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 nt sockets} {soc
c860: 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 ket exec} {.
c870: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
c880: 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 pt1. makeFile
c890: 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 {} script2..
c8a0: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
c8b0: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
c8c0: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
c8d0: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
c8e0: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
c8f0: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
c900: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
c910: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
c920: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
c930: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
c940: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
c950: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c960: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c970: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
c980: 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e opens the clien
c990: 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 t socket and wri
c9a0: 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 tes to it. It t
c9b0: 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 hen. # launch
c9c0: 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 es script1 and e
c9d0: 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 xits. If the ch
c9e0: 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 ild process inhe
c9f0: 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 rited the. #
ca00: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 client socket, t
ca10: 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 he socket will s
ca20: 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 till be open...
ca30: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
ca40: 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 cript2 w]. pu
ca50: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
ca60: 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 tclsh $::tcltest
ca70: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
ca80: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
ca90: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
caa0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
cab0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
cac0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
cad0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
cae0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
caf0: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 63 65 72 -require 0 -cer
cb00: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
cb10: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
cb20: 74 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c t \.. -keyfil
cb30: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
cb40: 2e 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 .0.0.1 8829\]".
cb50: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 puts $f {..ex
cb60: 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 ec $tclsh script
cb70: 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 1 &..puts $f tes
cb80: 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 ting..flush $f..
cb90: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
cba0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
cbb0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
cbc0: 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 f.. # Create
cbd0: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
cbe0: 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 t.. set serve
cbf0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
cc00: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
cc10: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
cc20: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
cc30: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
cc40: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
cc50: 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 5d 0a serverKey 8829].
cc60: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
cc70: 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 { file host port
cc80: 20 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 68 65 } {..# When the
cc90: 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 client connects
cca0: 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 , establish the
ccb0: 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c read handler..gl
ccc0: 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f obal server..clo
ccd0: 73 65 20 24 73 65 72 76 65 72 0a 09 66 63 6f 6e se $server..fcon
cce0: 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 6c figure $file -bl
ccf0: 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 ocking 0..fileev
cd00: 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 ent $file readab
cd10: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
cd20: 73 68 61 6b 65 20 24 66 69 6c 65 20 72 65 61 64 shake $file read
cd30: 61 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 20 67 able \...[list g
cd40: 65 74 64 61 74 61 20 63 6c 69 65 6e 74 5d 20 2d etdata client] -
cd50: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a buffering line].
cd60: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 .return. }..
cd70: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
cd80: 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 et doesn't hit e
cd90: 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 nd-of-file in 5
cda0: 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 seconds, the.
cdb0: 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 # script1 proce
cdc0: 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 ss must have inh
cdd0: 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e erited the clien
cde0: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c t... set fail
cdf0: 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 ed 0. after 5
ce00: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 000 [list set fa
ce10: 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c iled 1].. # L
ce20: 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 aunch the script
ce30: 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 2 process.. e
ce40: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
ce50: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
ce60: 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 &.. vwait x.
ce70: 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d if {!$failed}
ce80: 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 {..vwait failed
ce90: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
cea0: 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 .} {client socke
ceb0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
cec0: 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ted}..test tlsIO
ced0: 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 -12.3 {testing i
cee0: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 nheritance of ac
cef0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 cepted sockets}
cf00: 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 63 20 \..{socket exec
cf10: 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 unixOnly} {.
cf20: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
cf30: 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 pt1. makeFile
cf40: 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 {} script2..
cf50: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
cf60: 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt1 w]. puts
cf70: 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 $f {..after 100
cf80: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
cf90: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
cfa0: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 close $f.. s
cfb0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
cfc0: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
cfd0: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
cfe0: 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 h $::tcltest::tc
cff0: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
d000: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
d010: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
d020: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
d030: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
d040: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
d050: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
d060: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
d070: 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 65 71 rver accept -req
d080: 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 2d 63 uire 0 \.. -c
d090: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
d0a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
d0b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
d0c0: 72 76 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a rverKey 8930\]".
d0d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
d0e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
d0f0: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
d100: 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 . global tcls
d110: 68 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 h.. fconfigur
d120: 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 e $file -bufferi
d130: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 ng line.. put
d140: 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 s $file {test da
d150: 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 ta on socket}..
d160: 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 exec $tclsh s
d170: 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 cript1 &.. af
d180: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d ter 1000 exit..}
d190: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
d1a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
d1b0: 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 $f.. # Launch
d1c0: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f the script2 pro
d1d0: 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 cess and connect
d1e0: 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 to it. See how
d1f0: 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 long. # the
d200: 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 socket stays ope
d210: 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 n.. exec $::t
d220: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
d230: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 script2 &.. a
d240: 66 74 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b fter 2000 set ok
d250: 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 _to_proceed 1.
d260: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 vwait ok_to_pr
d270: 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 oceed.. set f
d280: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 [tls::socket -r
d290: 65 71 75 69 72 65 20 30 20 5c 0a 09 20 20 20 20 equire 0 \..
d2a0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
d2b0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
d2c0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
d2d0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
d2e0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 127.0.0.1 8930]
d2f0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
d300: 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 $f -buffering fu
d310: 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ll -blocking 0.
d320: 20 20 20 23 20 57 65 20 6e 65 65 64 20 74 6f 20 # We need to
d330: 70 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 put a byte into
d340: 74 68 65 20 72 65 61 64 20 71 75 65 75 65 2c 20 the read queue,
d350: 6f 74 68 65 72 77 69 73 65 20 74 68 65 0a 20 20 otherwise the.
d360: 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b # TLS handshak
d370: 65 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 68 e doesn't finish
d380: 0a 20 20 20 20 70 75 74 73 20 24 66 20 61 3b 20 . puts $f a;
d390: 66 6c 75 73 68 20 24 66 0a 20 20 20 20 66 69 6c flush $f. fil
d3a0: 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 eevent $f readab
d3b0: 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 le [list getdata
d3c0: 20 61 63 63 65 70 74 65 64 20 24 66 5d 0a 0a 20 accepted $f]..
d3d0: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
d3e0: 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e et is still open
d3f0: 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 after 5 seconds
d400: 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 , the script1 pr
d410: 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 ocess. # must
d420: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
d430: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
d440: 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ket... set fa
d450: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
d460: 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 5000 set failed
d470: 20 31 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 1.. vwait x.
d480: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 set x.} {acc
d490: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 epted socket was
d4a0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
d4b0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 .test tlsIO-13.1
d4c0: 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 {Testing use of
d4d0: 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 shared socket b
d4e0: 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 etween two threa
d4f0: 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 ds} \..{socket t
d500: 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 20 estthread} {.
d510: 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 # HOBBS: never
d520: 74 65 73 74 65 64 0a 20 20 20 20 72 65 6d 6f 76 tested. remov
d530: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
d540: 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 threadReap..
d550: 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 makeFile {.
d560: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
d570: 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 tls..set f [tls
d580: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
d590: 20 61 63 63 65 70 74 20 2d 72 65 71 75 69 72 65 accept -require
d5a0: 20 30 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 0 8828]..proc a
d5b0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
d5c0: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
d5d0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
d5e0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
d5f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
d600: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d610: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
d620: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
d630: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
d640: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
d650: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
d660: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
d670: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
d680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d690: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
d6a0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
d6b0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d6c0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
d6d0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
d6e0: 73 65 20 7b 0a 09 20 20 20 20 20 20 20 20 20 69 se {.. i
d6f0: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
d700: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
d710: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
d720: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 ..}..set i 0..vw
d730: 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a ait x..close $f.
d740: 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e ..# thread clean
d750: 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 s itself up...te
d760: 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 stthread exit.
d770: 20 20 7d 20 73 63 72 69 70 74 0a 0a 20 20 20 20 } script..
d780: 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 # create a threa
d790: 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 d. set server
d7a0: 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 thread [testthre
d7b0: 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 ad create { sour
d7c0: 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 ce script } ].
d7d0: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 update.. af
d7e0: 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 ter 1000. set
d7f0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
d800: 2d 72 65 71 75 69 72 65 20 30 20 31 32 37 2e 30 -require 0 127.0
d810: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
d820: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
d830: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 ffering line..
d840: 20 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 catch {..puts
d850: 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 $s "hello"..gets
d860: 20 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d $s result. }
d870: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
d880: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 update.. af
d890: 74 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 ter 2000. lap
d8a0: 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 pend result [thr
d8b0: 65 61 64 52 65 61 70 5d 0a 0a 20 20 20 20 73 65 eadReap].. se
d8c0: 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c t result..} {hel
d8d0: 6c 6f 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 lo 1}..test tlsI
d8e0: 4f 2d 31 34 2e 31 20 7b 74 65 73 74 20 74 6c 73 O-14.1 {test tls
d8f0: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 ::unimport} {soc
d900: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
d910: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 [catch {tls::uni
d920: 6d 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 mport} msg] $msg
d930: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
d940: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
d950: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 tls::unimport ch
d960: 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c annel"}}.test tl
d970: 73 49 4f 2d 31 34 2e 32 20 7b 74 65 73 74 20 74 sIO-14.2 {test t
d980: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 ls::unimport} {s
d990: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
d9a0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 t [catch {tls::u
d9b0: 6e 69 6d 70 6f 72 74 20 66 6f 6f 20 62 61 72 7d nimport foo bar}
d9c0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
d9d0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
d9e0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 hould be "tls::u
d9f0: 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 nimport channel"
da00: 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }}.test tlsIO-14
da10: 2e 33 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .3 {test tls::un
da20: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
da30: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
da40: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 ch {tls::unimpor
da50: 74 20 62 6f 67 75 73 7d 20 6d 73 67 5d 20 24 6d t bogus} msg] $m
da60: 73 67 0a 7d 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 sg.} {1 {can not
da70: 20 66 69 6e 64 20 63 68 61 6e 6e 65 6c 20 6e 61 find channel na
da80: 6d 65 64 20 22 62 6f 67 75 73 22 7d 7d 0a 74 65 med "bogus"}}.te
da90: 73 74 20 74 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 st tlsIO-14.4 {t
daa0: 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 est tls::unimpor
dab0: 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 t} {socket} {.
dac0: 20 20 23 20 73 74 64 69 6e 20 63 61 6e 20 74 61 # stdin can ta
dad0: 6b 65 20 64 69 66 66 65 72 65 6e 74 20 6e 61 6d ke different nam
dae0: 65 73 20 61 73 20 74 68 65 20 22 74 6f 70 22 20 es as the "top"
daf0: 63 68 61 6e 6e 65 6c 0a 20 20 20 20 6c 69 73 74 channel. list
db00: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e [catch {tls::un
db10: 69 6d 70 6f 72 74 20 73 74 64 69 6e 7d 20 6d 73 import stdin} ms
db20: 67 5d 20 5c 0a 09 5b 73 74 72 69 6e 67 20 6d 61 g] \..[string ma
db30: 74 63 68 20 7b 62 61 64 20 63 68 61 6e 6e 65 6c tch {bad channel
db40: 20 22 2a 22 3a 20 6e 6f 74 20 61 20 73 74 61 63 "*": not a stac
db50: 6b 65 64 20 63 68 61 6e 6e 65 6c 7d 20 24 6d 73 ked channel} $ms
db60: 67 5d 0a 7d 20 7b 31 20 31 7d 0a 74 65 73 74 20 g].} {1 1}.test
db70: 74 6c 73 49 4f 2d 31 34 2e 35 20 7b 74 65 73 74 tlsIO-14.5 {test
db80: 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 tls::unimport}
db90: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
dba0: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
dbb0: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
dbc0: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
dbd0: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
dbe0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
dbf0: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
dc00: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
dc10: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
dc20: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
dc30: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
dc40: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
dc50: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
dc60: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
dc70: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
dc80: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
dc90: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
dca0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
dcb0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
dcc0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
dcd0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
dce0: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 s -blocking 0..f
dcf0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
dd00: 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 able [list do_ha
dd10: 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 ndshake $s reada
dd20: 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 5c ble readlittle \
dd30: 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f ...-buffering no
dd40: 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ne]. }. se
dd50: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
dd60: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
dd70: 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 09 2d 63 -require 0 \..-c
dd80: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
dd90: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
dda0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
ddb0: 72 76 65 72 4b 65 79 20 38 38 33 38 5d 0a 20 20 rverKey 8838].
ddc0: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
ddd0: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
dde0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
ddf0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
de00: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
de10: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
de20: 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 38 5d localhost 8838]
de30: 0a 20 20 20 20 23 20 6f 6e 6c 79 20 74 68 65 20 . # only the
de40: 63 6c 69 65 6e 74 20 67 65 74 73 20 74 6c 73 3a client gets tls:
de50: 3a 69 6d 70 6f 72 74 0a 20 20 20 20 73 65 74 20 :import. set
de60: 72 65 73 20 5b 74 6c 73 3a 3a 75 6e 69 6d 70 6f res [tls::unimpo
de70: 72 74 20 24 63 5d 0a 20 20 20 20 6c 69 73 74 20 rt $c]. list
de80: 24 72 65 73 20 5b 63 61 74 63 68 20 7b 63 6c 6f $res [catch {clo
de90: 73 65 20 24 63 7d 20 65 72 72 5d 20 24 65 72 72 se $c} err] $err
dea0: 20 5c 0a 09 5b 63 61 74 63 68 20 7b 63 6c 6f 73 \..[catch {clos
deb0: 65 20 24 73 7d 20 65 72 72 5d 20 24 65 72 72 0a e $s} err] $err.
dec0: 7d 20 7b 7b 7d 20 30 20 7b 7d 20 30 20 7b 7d 7d } {{} 0 {} 0 {}}
ded0: 0a 0a 74 65 73 74 20 74 6c 73 2d 62 75 67 35 38 ..test tls-bug58
dee0: 2d 31 2e 30 20 7b 74 65 73 74 20 70 72 6f 74 6f -1.0 {test proto
def0: 63 6f 6c 20 6e 65 67 6f 74 69 61 74 69 6f 6e 20 col negotiation
df00: 66 61 69 6c 75 72 65 7d 20 7b 73 6f 63 6b 65 74 failure} {socket
df10: 7d 20 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f 77 } {. # Follow
df20: 69 6e 67 20 63 6f 64 65 20 69 73 20 62 61 73 65 ing code is base
df30: 64 20 6f 6e 20 77 68 61 74 20 77 61 73 20 72 65 d on what was re
df40: 70 6f 72 74 65 64 20 69 6e 20 62 75 67 20 23 35 ported in bug #5
df50: 38 2e 20 50 72 69 6f 72 0a 20 20 20 20 23 20 74 8. Prior. # t
df60: 6f 20 66 69 78 20 74 68 65 20 70 72 6f 67 72 61 o fix the progra
df70: 6d 20 77 6f 75 6c 64 20 63 72 61 73 68 20 77 69 m would crash wi
df80: 74 68 20 61 20 73 65 67 66 61 75 6c 74 2e 0a 20 th a segfault..
df90: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
dfa0: 73 6f 63 6b 20 61 72 67 73 7d 20 7b 0a 20 20 20 sock args} {.
dfb0: 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 fconfigure
dfc0: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
dfd0: 30 3b 0a 20 20 20 20 20 20 20 20 66 69 6c 65 65 0;. filee
dfe0: 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 vent $sock reada
dff0: 62 6c 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 68 ble [list Handsh
e000: 61 6b 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 7d ake $sock]. }
e010: 0a 20 20 20 20 70 72 6f 63 20 48 61 6e 64 73 68 . proc Handsh
e020: 61 6b 65 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 ake {sock} {.
e030: 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 set ::done
e040: 48 41 4e 44 0a 20 20 20 20 20 20 20 20 63 61 74 HAND. cat
e050: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
e060: 6b 65 20 24 73 6f 63 6b 7d 20 6d 73 67 0a 20 20 ke $sock} msg.
e070: 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 set ::done
e080: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
e090: 23 20 4e 4f 54 45 3a 20 77 68 65 6e 20 64 6f 69 # NOTE: when doi
e0a0: 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 ng an in-process
e0b0: 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 client/server t
e0c0: 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 est, both sides
e0d0: 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 need. # to be
e0e0: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f non-blocking fo
e0f0: 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 r the TLS handsh
e100: 61 6b 65 0a 0a 20 20 20 20 23 20 53 65 72 76 65 ake.. # Serve
e110: 72 20 2d 20 4f 6e 6c 79 20 61 63 63 65 70 74 20 r - Only accept
e120: 54 4c 53 20 31 2e 33 0a 20 20 20 20 73 65 74 20 TLS 1.3. set
e130: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
e140: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 72 server accept -r
e150: 65 71 75 65 73 74 20 30 20 2d 72 65 71 75 69 72 equest 0 -requir
e160: 65 20 30 20 5c 0a 20 20 20 20 20 20 20 20 2d 63 e 0 \. -c
e170: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
e180: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
e190: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
e1a0: 72 76 65 72 4b 65 79 20 5c 0a 09 2d 73 73 6c 32 rverKey \..-ssl2
e1b0: 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 31 0 -ssl3 0 -tls1
e1c0: 20 30 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 6c 0 -tls1.1 0 -tl
e1d0: 73 31 2e 32 20 30 20 2d 74 6c 73 31 2e 33 20 31 s1.2 0 -tls1.3 1
e1e0: 20 38 38 33 37 5d 0a 20 20 20 20 23 20 43 6c 69 8837]. # Cli
e1f0: 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 72 6f 70 6f ent - Only propo
e200: 73 65 20 54 4c 53 31 2e 32 0a 20 20 20 20 73 65 se TLS1.2. se
e210: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
e220: 20 2d 61 73 79 6e 63 20 2d 63 61 66 69 6c 65 20 -async -cafile
e230: 24 63 61 43 65 72 74 20 2d 72 65 71 75 65 73 74 $caCert -request
e240: 20 30 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 0 -require 0 \.
e250: 09 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 .-ssl2 0 -ssl3 0
e260: 20 2d 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 31 -tls1 0 -tls1.1
e270: 20 30 20 2d 74 6c 73 31 2e 32 20 31 20 2d 74 6c 0 -tls1.2 1 -tl
e280: 73 31 2e 33 20 30 20 6c 6f 63 61 6c 68 6f 73 74 s1.3 0 localhost
e290: 20 38 38 33 37 5d 0a 20 20 20 20 66 63 6f 6e 66 8837]. fconf
e2a0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
e2b0: 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 ng 0. puts $c
e2c0: 20 61 20 3b 20 66 6c 75 73 68 20 24 63 0a 20 20 a ; flush $c.
e2d0: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
e2e0: 73 74 20 73 65 74 20 3a 3a 64 6f 6e 65 20 74 69 st set ::done ti
e2f0: 6d 65 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 meout]. vwait
e300: 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 73 77 69 74 ::done. swit
e310: 63 68 20 2d 65 78 61 63 74 20 2d 2d 20 24 3a 3a ch -exact -- $::
e320: 64 6f 6e 65 20 7b 0a 20 20 20 20 20 20 20 20 22 done {. "
e330: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
e340: 3a 20 77 72 6f 6e 67 20 73 73 6c 20 76 65 72 73 : wrong ssl vers
e350: 69 6f 6e 22 20 2d 0a 20 20 20 20 20 20 20 20 22 ion" -. "
e360: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
e370: 3a 20 75 6e 73 75 70 70 6f 72 74 65 64 20 70 72 : unsupported pr
e380: 6f 74 6f 63 6f 6c 22 20 7b 0a 20 20 20 20 20 20 otocol" {.
e390: 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 set ::done
e3a0: 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c "handshake fail
e3b0: 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f ed: wrong versio
e3c0: 6e 20 6e 75 6d 62 65 72 22 0a 20 20 20 20 20 20 n number".
e3d0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 61 }. }. ca
e3e0: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 0a 20 tch {close $c}.
e3f0: 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 catch {close
e400: 24 73 7d 0a 20 20 20 20 73 65 74 20 3a 3a 64 6f $s}. set ::do
e410: 6e 65 0a 7d 20 7b 68 61 6e 64 73 68 61 6b 65 20 ne.} {handshake
e420: 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 failed: wrong ve
e430: 72 73 69 6f 6e 20 6e 75 6d 62 65 72 7d 0a 0a 23 rsion number}..#
e440: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
e450: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
e460: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
e470: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
e480: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
e490: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
e4a0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
e4b0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
e4c0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
e4d0: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
e4e0: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
e4f0: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
e500: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
e510: 65 74 75 72 6e 0a eturn.