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 20 0a 23 ba Solutions. .#
0180: 0a 23 20 53 65 65 20 74 68 65 20 66 69 6c 65 20 .# See the file
0190: 22 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 22 20 "license.terms"
01a0: 66 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 for information
01b0: 6f 6e 20 75 73 61 67 65 20 61 6e 64 20 72 65 64 on usage and red
01c0: 69 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66 istribution.# of
01d0: 20 74 68 69 73 20 66 69 6c 65 2c 20 61 6e 64 20 this file, and
01e0: 66 6f 72 20 61 20 44 49 53 43 4c 41 49 4d 45 52 for a DISCLAIMER
01f0: 20 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e 54 49 OF ALL WARRANTI
0200: 45 53 2e 0a 23 0a 23 20 52 43 53 3a 20 40 28 23 ES..#.# RCS: @(#
0210: 29 20 24 49 64 3a 20 74 6c 73 49 4f 2e 74 65 73 ) $Id: tlsIO.tes
0220: 74 2c 76 20 31 2e 32 34 20 32 30 31 35 2f 30 36 t,v 1.24 2015/06
0230: 2f 30 36 20 30 39 3a 30 37 3a 30 38 20 61 70 6e /06 09:07:08 apn
0240: 61 64 6b 61 72 6e 69 20 45 78 70 20 24 0a 0a 23 adkarni Exp $..#
0250: 20 52 75 6e 6e 69 6e 67 20 73 6f 63 6b 65 74 20 Running socket
0260: 74 65 73 74 73 20 77 69 74 68 20 61 20 72 65 6d tests with a rem
0270: 6f 74 65 20 73 65 72 76 65 72 3a 0a 23 20 2d 2d ote server:.# --
0280: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0290: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
02a0: 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 20 0a 23 20 53 6f --------.# .# So
02b0: 6d 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b me tests in sock
02c0: 65 74 2e 74 65 73 74 20 64 65 70 65 6e 64 20 6f et.test depend o
02d0: 6e 20 74 68 65 20 65 78 69 73 74 65 6e 63 65 20 n the existence
02e0: 6f 66 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 of a remote serv
02f0: 65 72 20 74 6f 0a 23 20 77 68 69 63 68 20 74 68 er to.# which th
0300: 65 79 20 63 6f 6e 6e 65 63 74 2e 20 54 68 65 20 ey connect. The
0310: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75 remote server mu
0320: 73 74 20 62 65 20 61 6e 20 69 6e 73 74 61 6e 63 st be an instanc
0330: 65 20 6f 66 20 74 63 6c 74 65 73 74 20 61 6e 64 e of tcltest and
0340: 20 69 74 0a 23 20 6d 75 73 74 20 72 75 6e 20 74 it.# must run t
0350: 68 65 20 73 63 72 69 70 74 20 66 6f 75 6e 64 20 he script found
0360: 69 6e 20 74 68 65 20 66 69 6c 65 20 22 72 65 6d in the file "rem
0370: 6f 74 65 2e 74 63 6c 22 20 69 6e 20 74 68 69 73 ote.tcl" in this
0380: 20 64 69 72 65 63 74 6f 72 79 2e 20 59 6f 75 0a directory. You.
0390: 23 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 # can start the
03a0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e remote server on
03b0: 20 61 6e 79 20 6d 61 63 68 69 6e 65 20 72 65 61 any machine rea
03c0: 63 68 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 chable from the
03d0: 6d 61 63 68 69 6e 65 20 6f 6e 0a 23 20 77 68 69 machine on.# whi
03e0: 63 68 20 79 6f 75 20 77 61 6e 74 20 74 6f 20 72 ch you want to r
03f0: 75 6e 20 74 68 65 20 73 6f 63 6b 65 74 20 74 65 un the socket te
0400: 73 74 73 2c 20 62 79 20 69 73 73 75 69 6e 67 3a sts, by issuing:
0410: 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73 .# .# tcltes
0420: 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 70 6f t remote.tcl -po
0430: 72 74 20 38 30 34 38 09 23 20 4f 72 20 63 68 6f rt 8048.# Or cho
0440: 6f 73 65 20 61 6e 6f 74 68 65 72 20 70 6f 72 74 ose another port
0450: 20 6e 75 6d 62 65 72 2e 0a 23 20 0a 23 20 49 66 number..# .# If
0460: 20 74 68 65 20 6d 61 63 68 69 6e 65 20 79 6f 75 the machine you
0470: 20 61 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 are running the
0480: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f remote server o
0490: 6e 20 68 61 73 20 73 65 76 65 72 61 6c 20 49 50 n has several IP
04a0: 0a 23 20 69 6e 74 65 72 66 61 63 65 73 2c 20 79 .# interfaces, y
04b0: 6f 75 20 63 61 6e 20 63 68 6f 6f 73 65 20 77 68 ou can choose wh
04c0: 69 63 68 20 69 6e 74 65 72 66 61 63 65 20 74 68 ich interface th
04d0: 65 20 73 65 72 76 65 72 20 6c 69 73 74 65 6e 73 e server listens
04e0: 20 6f 6e 20 66 6f 72 0a 23 20 63 6f 6e 6e 65 63 on for.# connec
04f0: 74 69 6f 6e 73 20 62 79 20 73 70 65 63 69 66 79 tions by specify
0500: 69 6e 67 20 74 68 65 20 2d 61 64 64 72 65 73 73 ing the -address
0510: 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 66 6c command line fl
0520: 61 67 2c 20 73 6f 3a 0a 23 20 0a 23 20 20 20 20 ag, so:.# .#
0530: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e tcltest remote.
0540: 74 63 6c 20 2d 61 64 64 72 65 73 73 20 79 6f 75 tcl -address you
0550: 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 r.machine.com.#
0560: 0a 23 20 54 68 65 73 65 20 6f 70 74 69 6f 6e 73 .# These options
0570: 20 63 61 6e 20 61 6c 73 6f 20 62 65 20 73 65 74 can also be set
0580: 20 62 79 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 by environment
0590: 76 61 72 69 61 62 6c 65 73 2e 20 4f 6e 20 55 6e variables. On Un
05a0: 69 78 2c 20 79 6f 75 20 63 61 6e 0a 23 20 74 79 ix, you can.# ty
05b0: 70 65 20 74 68 65 73 65 20 63 6f 6d 6d 61 6e 64 pe these command
05c0: 73 20 74 6f 20 74 68 65 20 73 68 65 6c 6c 20 66 s to the shell f
05d0: 72 6f 6d 20 77 68 69 63 68 20 74 68 65 20 72 65 rom which the re
05e0: 6d 6f 74 65 20 73 65 72 76 65 72 20 69 73 20 73 mote server is s
05f0: 74 61 72 74 65 64 3a 0a 23 20 0a 23 20 20 20 20 tarted:.# .#
0600: 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 shell% setenv s
0610: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 erverPort 8048.#
0620: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 shell% sete
0630: 6e 76 20 73 65 72 76 65 72 41 64 64 72 65 73 73 nv serverAddress
0640: 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f your.machine.co
0650: 6d 0a 23 20 0a 23 20 61 6e 64 20 73 75 62 73 65 m.# .# and subse
0660: 71 75 65 6e 74 6c 79 20 79 6f 75 20 63 61 6e 20 quently you can
0670: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0680: 20 73 65 72 76 65 72 20 77 69 74 68 3a 0a 23 20 server with:.#
0690: 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 .# tcltest r
06a0: 65 6d 6f 74 65 2e 74 63 6c 0a 23 20 0a 23 20 74 emote.tcl.# .# t
06b0: 6f 20 68 61 76 65 20 69 74 20 6c 69 73 74 65 6e o have it listen
06c0: 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 20 6f 6e on port 8048 on
06d0: 20 74 68 65 20 69 6e 74 65 72 66 61 63 65 20 79 the interface y
06e0: 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e our.machine.com.
06f0: 0a 23 20 20 20 20 20 0a 23 20 57 68 65 6e 20 74 .# .# When t
0700: 68 65 20 73 65 72 76 65 72 20 73 74 61 72 74 73 he server starts
0710: 2c 20 69 74 20 70 72 69 6e 74 73 20 6f 75 74 20 , it prints out
0720: 61 20 64 65 74 61 69 6c 65 64 20 6d 65 73 73 61 a detailed messa
0730: 67 65 20 63 6f 6e 74 61 69 6e 69 6e 67 20 69 74 ge containing it
0740: 73 0a 23 20 63 6f 6e 66 69 67 75 72 61 74 69 6f s.# configuratio
0750: 6e 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 61 n information, a
0760: 6e 64 20 69 74 20 77 69 6c 6c 20 62 6c 6f 63 6b nd it will block
0770: 20 75 6e 74 69 6c 20 6b 69 6c 6c 65 64 20 77 69 until killed wi
0780: 74 68 20 61 20 43 74 72 6c 2d 43 2e 0a 23 20 4f th a Ctrl-C..# O
0790: 6e 63 65 20 74 68 65 20 72 65 6d 6f 74 65 20 73 nce the remote s
07a0: 65 72 76 65 72 20 65 78 69 73 74 73 2c 20 79 6f erver exists, yo
07b0: 75 20 63 61 6e 20 72 75 6e 20 74 68 65 20 74 65 u can run the te
07c0: 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 sts in socket.te
07d0: 73 74 20 77 69 74 68 0a 23 20 74 68 65 20 73 65 st with.# the se
07e0: 72 76 65 72 20 62 79 20 73 65 74 74 69 6e 67 20 rver by setting
07f0: 74 77 6f 20 54 63 6c 20 76 61 72 69 61 62 6c 65 two Tcl variable
0800: 73 3a 0a 23 20 0a 23 20 20 20 20 20 25 20 73 65 s:.# .# % se
0810: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0820: 20 3c 6e 61 6d 65 20 6f 72 20 61 64 64 72 65 73 <name or addres
0830: 73 20 6f 66 20 6d 61 63 68 69 6e 65 20 6f 6e 20 s of machine on
0840: 77 68 69 63 68 20 73 65 72 76 65 72 20 72 75 6e which server run
0850: 73 3e 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 s>.# % set r
0860: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0870: 38 30 34 38 0a 23 20 0a 23 20 54 68 65 73 65 20 8048.# .# These
0880: 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 61 6c variables are al
0890: 73 6f 20 73 65 74 74 61 62 6c 65 20 66 72 6f 6d so settable from
08a0: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 the environment
08b0: 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 . On Unix, you c
08c0: 61 6e 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 an:.# .# she
08d0: 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 6d 6f 74 ll% setenv remot
08e0: 65 53 65 72 76 65 72 49 50 20 6d 61 63 68 69 6e eServerIP machin
08f0: 65 2e 77 68 65 72 65 2e 73 65 72 76 65 72 2e 72 e.where.server.r
0900: 75 6e 73 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 uns.# shell%
0910: 20 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 setenv remoteSe
0920: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 20 rverPort 8048.#
0930: 0a 23 20 54 68 65 20 70 72 65 61 6d 62 6c 65 20 .# The preamble
0940: 6f 66 20 74 68 65 20 73 6f 63 6b 65 74 2e 74 65 of the socket.te
0950: 73 74 20 66 69 6c 65 20 63 68 65 63 6b 73 20 74 st file checks t
0960: 6f 20 73 65 65 20 69 66 20 74 68 65 20 76 61 72 o see if the var
0970: 69 61 62 6c 65 73 20 61 72 65 20 73 65 74 0a 23 iables are set.#
0980: 20 65 69 74 68 65 72 20 69 6e 20 54 63 6c 20 6f either in Tcl o
0990: 72 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e r in the environ
09a0: 6d 65 6e 74 3b 20 69 66 20 74 68 65 79 20 61 72 ment; if they ar
09b0: 65 2c 20 69 74 20 61 74 74 65 6d 70 74 73 20 74 e, it attempts t
09c0: 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 0a 23 20 74 o connect to.# t
09d0: 68 65 20 73 65 72 76 65 72 2e 20 49 66 20 74 68 he server. If th
09e0: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 73 20 e connection is
09f0: 73 75 63 63 65 73 73 66 75 6c 2c 20 74 68 65 20 successful, the
0a00: 74 65 73 74 73 20 75 73 69 6e 67 20 74 68 65 20 tests using the
0a10: 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 remote.# server
0a20: 77 69 6c 6c 20 62 65 20 70 65 72 66 6f 72 6d 65 will be performe
0a30: 64 3b 20 6f 74 68 65 72 77 69 73 65 2c 20 69 74 d; otherwise, it
0a40: 20 77 69 6c 6c 20 61 74 74 65 6d 70 74 20 74 6f will attempt to
0a50: 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 start the remot
0a60: 65 0a 23 20 73 65 72 76 65 72 20 28 76 69 61 20 e.# server (via
0a70: 65 78 65 63 29 20 6f 6e 20 70 6c 61 74 66 6f 72 exec) on platfor
0a80: 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 ms that support
0a90: 74 68 69 73 2c 20 6f 6e 20 74 68 65 20 6c 6f 63 this, on the loc
0aa0: 61 6c 20 68 6f 73 74 2c 0a 23 20 6c 69 73 74 65 al host,.# liste
0ab0: 6e 69 6e 67 20 61 74 20 70 6f 72 74 20 38 30 34 ning at port 804
0ac0: 38 2e 20 49 66 20 61 6c 6c 20 66 61 69 6c 73 2c 8. If all fails,
0ad0: 20 61 20 6d 65 73 73 61 67 65 20 69 73 20 70 72 a message is pr
0ae0: 69 6e 74 65 64 20 61 6e 64 20 74 68 65 20 74 65 inted and the te
0af0: 73 74 73 0a 23 20 75 73 69 6e 67 20 74 68 65 20 sts.# using the
0b00: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 61 72 remote server ar
0b10: 65 20 6e 6f 74 20 70 65 72 66 6f 72 6d 65 64 2e e not performed.
0b20: 0a 0a 70 72 6f 63 20 64 70 75 74 73 20 7b 6d 73 ..proc dputs {ms
0b30: 67 7d 20 7b 20 72 65 74 75 72 6e 20 3b 20 70 75 g} { return ; pu
0b40: 74 73 20 73 74 64 65 72 72 20 24 6d 73 67 20 3b ts stderr $msg ;
0b50: 20 66 6c 75 73 68 20 73 74 64 65 72 72 20 7d 0a flush stderr }.
0b60: 0a 69 66 20 7b 5b 6c 73 65 61 72 63 68 20 5b 6e .if {[lsearch [n
0b70: 61 6d 65 73 70 61 63 65 20 63 68 69 6c 64 72 65 amespace childre
0b80: 6e 5d 20 3a 3a 74 63 6c 74 65 73 74 5d 20 3d 3d n] ::tcltest] ==
0b90: 20 2d 31 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61 -1} {. packa
0ba0: 67 65 20 72 65 71 75 69 72 65 20 74 63 6c 74 65 ge require tclte
0bb0: 73 74 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65 st. namespace
0bc0: 20 69 6d 70 6f 72 74 20 2d 66 6f 72 63 65 20 3a import -force :
0bd0: 3a 74 63 6c 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 :tcltest::*.}..#
0be0: 20 54 68 65 20 62 75 69 6c 64 20 64 69 72 20 69 The build dir i
0bf0: 73 20 61 64 64 65 64 20 61 73 20 74 68 65 20 66 s added as the f
0c00: 69 72 73 74 20 65 6c 65 6d 65 6e 74 20 6f 66 20 irst element of
0c10: 24 50 41 54 48 0a 23 20 4c 6f 61 64 20 74 68 65 $PATH.# Load the
0c20: 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 tls package.pac
0c30: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
0c40: 0a 0a 73 65 74 20 74 6c 73 53 65 72 76 65 72 50 ..set tlsServerP
0c50: 6f 72 74 20 38 30 34 38 0a 0a 23 20 53 70 65 63 ort 8048..# Spec
0c60: 69 66 79 20 77 68 65 72 65 20 74 68 65 20 63 65 ify where the ce
0c70: 72 74 69 66 69 63 61 74 65 73 20 61 72 65 0a 0a rtificates are..
0c80: 73 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69 set certsDir.[fi
0c90: 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 le join [file di
0ca0: 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 rname [info scri
0cb0: 70 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 74 20 pt]] certs].set
0cc0: 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 serverCert.[file
0cd0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0ce0: 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 server.pem].set
0cf0: 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 clientCert.[file
0d00: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0d10: 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20 client.pem].set
0d20: 63 61 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 caCert.[file joi
0d30: 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 2e 70 n $certsDir ca.p
0d40: 65 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 4b 65 em].set serverKe
0d50: 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 y.[file join $ce
0d60: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 6b 65 rtsDir server.ke
0d70: 79 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 y].set clientKey
0d80: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 .[file join $cer
0d90: 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 tsDir client.key
0da0: 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 ]..# Some tests
0db0: 72 65 71 75 69 72 65 20 74 68 65 20 74 65 73 74 require the test
0dc0: 74 68 72 65 61 64 20 61 6e 64 20 65 78 65 63 20 thread and exec
0dd0: 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 74 20 3a 3a commands..set ::
0de0: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e tcltest::testCon
0df0: 73 74 72 61 69 6e 74 73 28 74 65 73 74 74 68 72 straints(testthr
0e00: 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b ead) \..[expr {[
0e10: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 info commands te
0e20: 73 74 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d stthread] != {}}
0e30: 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a ].set ::tcltest:
0e40: 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 :testConstraints
0e50: 28 65 78 65 63 29 20 5b 65 78 70 72 20 7b 5b 69 (exec) [expr {[i
0e60: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 nfo commands exe
0e70: 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 c] != {}}]..#.#
0e80: 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 If remoteServerI
0e90: 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65 P or remoteServe
0ea0: 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65 rPort are not se
0eb0: 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a t, check in the.
0ec0: 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 # environment va
0ed0: 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65 riables for exte
0ee0: 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 rnally set value
0ef0: 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f s..#..if {![info
0f00: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
0f10: 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 rverIP]} {. i
0f20: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0f30: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0f40: 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d IP)]} {..set rem
0f50: 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e 76 oteServerIP $env
0f60: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 (remoteServerIP)
0f70: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0f80: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0f90: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a eServerPort]} {.
0fa0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0fb0: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 ists env(remoteS
0fc0: 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 erverPort)]} {..
0fd0: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
0fe0: 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 Port $env(remote
0ff0: 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 ServerPort).
1000: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
1010: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
1020: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 s remoteServerIP
1030: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 ]} {.. set re
1040: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 moteServerPort $
1050: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a 20 20 tlsServerPort.
1060: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a }. }.}.
1070: 0a 70 72 6f 63 20 64 6f 5f 68 61 6e 64 73 68 61 .proc do_handsha
1080: 6b 65 20 7b 73 20 7b 74 79 70 65 20 72 65 61 64 ke {s {type read
1090: 61 62 6c 65 7d 20 7b 63 6d 64 20 7b 7d 7d 20 61 able} {cmd {}} a
10a0: 72 67 73 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b rgs} {. if {[
10b0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 63 6c 6f 73 eof $s]} {..clos
10c0: 65 20 24 73 0a 09 64 70 75 74 73 20 22 68 61 6e e $s..dputs "han
10d0: 64 73 68 61 6b 65 3a 20 65 6f 66 22 0a 09 73 65 dshake: eof"..se
10e0: 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 t ::do_handshake
10f0: 20 22 65 6f 66 22 0a 20 20 20 20 7d 20 65 6c 73 "eof". } els
1100: 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 eif {[catch {tls
1110: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 ::handshake $s}
1120: 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 23 20 53 6f result]} {..# So
1130: 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f me errors are no
1140: 72 6d 61 6c 2e 0a 09 64 70 75 74 73 20 22 68 61 rmal...dputs "ha
1150: 6e 64 73 68 61 6b 65 3a 20 24 72 65 73 75 6c 74 ndshake: $result
1160: 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b ". } elseif {
1170: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a $result == 1} {.
1180: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
1190: 70 6c 65 74 65 0a 09 69 66 20 7b 5b 6c 6c 65 6e plete..if {[llen
11a0: 67 74 68 20 24 61 72 67 73 5d 7d 20 7b 20 65 76 gth $args]} { ev
11b0: 61 6c 20 5b 6c 69 73 74 20 66 63 6f 6e 66 69 67 al [list fconfig
11c0: 75 72 65 20 24 73 5d 20 24 61 72 67 73 20 7d 0a ure $s] $args }.
11d0: 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 22 7d .if {$cmd == ""}
11e0: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e {.. fileeven
11f0: 74 20 24 73 20 24 74 79 70 65 20 22 22 0a 09 7d t $s $type ""..}
1200: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 66 69 6c else {.. fil
1210: 65 65 76 65 6e 74 20 24 73 20 24 74 79 70 65 20 eevent $s $type
1220: 22 24 63 6d 64 20 5b 6c 69 73 74 20 24 73 5d 22 "$cmd [list $s]"
1230: 0a 09 7d 0a 09 64 70 75 74 73 20 22 68 61 6e 64 ..}..dputs "hand
1240: 73 68 61 6b 65 3a 20 63 6f 6d 70 6c 65 74 65 22 shake: complete"
1250: 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 ..set ::do_hands
1260: 68 61 6b 65 20 22 63 6f 6d 70 6c 65 74 65 22 0a hake "complete".
1270: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 64 70 } else {..dp
1280: 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 uts "handshake:
1290: 69 6e 20 70 72 6f 67 72 65 73 73 22 0a 20 20 20 in progress".
12a0: 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 }.}..#.# Check
12b0: 69 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 65 if we're suppose
12c0: 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 67 d to do tests ag
12d0: 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 65 ainst the remote
12e0: 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 server.#..set d
12f0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1300: 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 Server 1.if {![i
1310: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
1320: 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 24 eServerIP] && ($
1330: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 tcl_platform(pla
1340: 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e tform) != "macin
1350: 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 tosh")} {. se
1360: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
1370: 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 127.0.0.1.}.if
1380: 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {($doTestsWithRe
1390: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 29 moteServer == 1)
13a0: 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 && (![info exis
13b0: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 ts remoteServerP
13c0: 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 ort])} {. set
13d0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
13e0: 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 t $tlsServerPort
13f0: 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 74 6f .}..# Attempt to
1400: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 72 65 connect to a re
1410: 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 20 6f mote server if o
1420: 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 72 75 ne is already ru
1430: 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 20 69 nning. If it.# i
1440: 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 6f 72 s not running or
1450: 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 72 20 for some other
1460: 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e 6e 65 reason the conne
1470: 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 6d 70 ct fails, attemp
1480: 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 68 65 t to.# start the
1490: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f remote server o
14a0: 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 n the local host
14b0: 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f listening on po
14c0: 72 74 20 38 30 34 38 2e 20 54 68 69 73 0a 23 20 rt 8048. This.#
14d0: 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f 6e 20 is only done on
14e0: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 platforms that s
14f0: 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 2e 65 upport exec (i.e
1500: 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d 61 63 . not on the Mac
1510: 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f 72 6d ). On.# platform
1520: 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 73 75 s that do not su
1530: 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 65 20 pport exec, the
1540: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75 remote server mu
1550: 73 74 20 62 65 20 73 74 61 72 74 65 64 0a 23 20 st be started.#
1560: 62 79 20 74 68 65 20 75 73 65 72 20 62 65 66 6f by the user befo
1570: 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 74 re running the t
1580: 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d 6f 74 ests...set remot
1590: 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 65 74 eProcChan "".set
15a0: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 commandSocket "
15b0: 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 ".if {$doTestsWi
15c0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
15d0: 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f {. catch {clo
15e0: 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 se $commandSocke
15f0: 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 t}. if {[catc
1600: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f h {set commandSo
1610: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 cket [tls::socke
1620: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
1630: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
1640: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
1650: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
1660: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
1670: 65 53 65 72 76 65 72 49 50 20 24 72 65 6d 6f 74 eServerIP $remot
1680: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 eServerPort]}] !
1690: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
16a0: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d o commands exec]
16b0: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 == ""} {.. s
16c0: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
16d0: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 eason "can't exe
16e0: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 c".. set doTe
16f0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1700: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a ver 0..} else {.
1710: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
1720: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e erverIP 127.0.0.
1730: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 1.. set remot
1740: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e eFile [file join
1750: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 [pwd] remote.tc
1760: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 l].. if {[cat
1770: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 ch {set remotePr
1780: 6f 63 43 68 61 6e 20 5c 0a 09 09 20 20 20 20 5b ocChan \... [
1790: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
17a0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
17b0: 20 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 $remoteFile \..
17c0: 09 20 20 20 20 2d 73 65 72 76 65 72 49 73 53 69 . -serverIsSi
17d0: 6c 65 6e 74 20 2d 70 6f 72 74 20 24 72 65 6d 6f lent -port $remo
17e0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c 0a 09 teServerPort \..
17f0: 09 20 20 20 20 2d 61 64 64 72 65 73 73 20 24 72 . -address $r
1800: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 32 emoteServerIP] 2
1810: 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 77 2b 5d > /dev/null" w+]
1820: 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 } msg] == 0} {..
1830: 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 69 66 .after 1000...if
1840: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f {[catch {set co
1850: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 mmandSocket [tls
1860: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
1870: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 09 2d 63 $caCert \....-c
1880: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
1890: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
18a0: 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 24 72 65 ientKey \....$re
18b0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 65 moteServerIP $re
18c0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d moteServerPort]}
18d0: 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 msg] == 0} {...
18e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
18f0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 commandSocket -t
1900: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
1910: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
1920: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
1930: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
1940: 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 tReason $msg...
1950: 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 set doTestsWi
1960: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
1970: 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ...}.. } else
1980: 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 {...set noRemot
1990: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 eTestReason "$ms
19a0: 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 g $::tcltest::tc
19b0: 6c 74 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 ltest"...set doT
19c0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
19d0: 72 76 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d rver 0.. }..}
19e0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 . } else {..f
19f0: 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 configure $comma
1a00: 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c ndSocket -transl
1a10: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
1a20: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d ering line. }
1a30: 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 .}..# Some tests
1a40: 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 are run only if
1a50: 20 77 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 we are doing te
1a60: 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 sting against a
1a70: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 remote server..s
1a80: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 et ::tcltest::te
1a90: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f stConstraints(do
1aa0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1ab0: 65 72 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 erver) $doTestsW
1ac0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a ithRemoteServer.
1ad0: 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 if {$doTestsWith
1ae0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1af0: 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 0} {. if {[st
1b00: 72 69 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a ring first s $::
1b10: 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 tcltest::verbose
1b20: 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 ] != -1} {. .
1b30: 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 puts "Skipping t
1b40: 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 ests with remote
1b50: 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 server. See tes
1b60: 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 ts/socket.test f
1b70: 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 or"..puts "infor
1b80: 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f mation on how to
1b90: 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 run remote serv
1ba0: 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 er."..puts "Reas
1bb0: 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 on for not doing
1bc0: 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 remote tests: $
1bd0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
1be0: 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 on". }.}..#.#
1bf0: 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 If we do the te
1c00: 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f sts, define a co
1c10: 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 mmand to send a
1c20: 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 command to the.#
1c30: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a remote server..
1c40: 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 #..if {$doTestsW
1c50: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1c60: 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 == 1} {. proc
1c70: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d sendCommand {c}
1c80: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 {..global comma
1c90: 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b ndSocket...if {[
1ca0: 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b eof $commandSock
1cb0: 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f et]} {.. erro
1cc0: 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 r "remote server
1cd0: 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d disappeared"..}
1ce0: 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 ...if {[catch {p
1cf0: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
1d00: 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 et $c} msg]} {..
1d10: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1d20: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1d30: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 ared: $msg"..}..
1d40: 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 if {[catch {puts
1d50: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
1d60: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1d70: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 r--Marker--"} ms
1d80: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 g]} {.. error
1d90: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1da0: 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 disappeared: $ms
1db0: 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 g"..}...set resp
1dc0: 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b ""..while {1} {
1dd0: 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b .. set line [
1de0: 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gets $commandSoc
1df0: 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 ket].. if {[e
1e00: 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 of $commandSocke
1e10: 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 t]} {...error "r
1e20: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
1e30: 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d appeared".. }
1e40: 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e .. if {[strin
1e50: 67 20 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 g compare $line
1e60: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1e70: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d r--Marker--"] ==
1e80: 20 30 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 0} {...if {[str
1e90: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
1ea0: 64 65 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 dex $resp 0] err
1eb0: 6f 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 or] == 0} {...
1ec0: 20 20 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 error [lindex
1ed0: 24 72 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 $resp 1]...} els
1ee0: 65 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e e {... return
1ef0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1f00: 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 ]...}.. } els
1f10: 65 20 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 e {...append res
1f20: 70 20 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 p $line "\n"..
1f30: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 }..}. }..
1f40: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c sendCommand [l
1f50: 69 73 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b ist proc dputs [
1f60: 69 6e 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d info args dputs]
1f70: 20 5b 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74 [info body dput
1f80: 73 5d 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 s]].. proc se
1f90: 6e 64 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20 ndCertValues {}
1fa0: 7b 0a 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20 {..# We need to
1fb0: 62 65 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20 be able to send
1fc0: 63 65 72 74 69 66 69 63 61 74 65 20 76 61 6c 75 certificate valu
1fd0: 65 73 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a es that normaliz
1fe0: 65 0a 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61 e..# filenames a
1ff0: 63 72 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a cross platforms.
2000: 09 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 .sendCommand {..
2010: 20 20 20 20 73 65 74 20 63 65 72 74 73 44 69 72 set certsDir
2020: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c .[file join [fil
2030: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 e dirname [info
2040: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a script]] certs].
2050: 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 43 . set serverC
2060: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
2070: 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e certsDir server.
2080: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c pem].. set cl
2090: 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a ientCert.[file j
20a0: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c oin $certsDir cl
20b0: 69 65 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 ient.pem].. s
20c0: 65 74 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65 et caCert..[file
20d0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
20e0: 63 61 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20 cacert.pem]..
20f0: 20 73 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b set serverKey.[
2100: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
2110: 44 69 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a Dir server.key].
2120: 09 20 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b . set clientK
2130: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
2140: 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b ertsDir client.k
2150: 65 79 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a ey]..}. }.}..
2160: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b test tlsIO-1.1 {
2170: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2180: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2190: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
21a0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
21b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d :socket -server}
21c0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
21d0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
21e0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
21f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
2200: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
2210: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2220: 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 sIO-1.2 {arg par
2230: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2240: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2250: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2260: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2270: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 -server foo} ms
2280: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2290: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
22a0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
22b0: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
22c0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
22d0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
22e0: 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e -1.3 {arg parsin
22f0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
2300: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
2310: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2320: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
2330: 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 yaddr} msg] $msg
2340: 0a 7d 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22 .} {1 {"-myaddr"
2350: 20 6f 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20 option must be
2360: 66 6f 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75 followed by valu
2370: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
2380: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.4 {arg parsing
2390: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
23a0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
23b0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
23c0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
23d0: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 addr 127.0.0.1}
23e0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
23f0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2400: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2410: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2420: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2430: 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 t tlsIO-1.5 {arg
2440: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2450: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2460: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2470: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2480: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
2490: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d g] $msg.} {1 {"-
24a0: 6d 79 70 6f 72 74 22 20 6f 70 74 69 6f 6e 20 6d myport" option m
24b0: 75 73 74 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 ust be followed
24c0: 62 79 20 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 by value}}..test
24d0: 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 tlsIO-1.6 {arg
24e0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
24f0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2500: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2510: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2520: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 ket -myport xxxx
2530: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2540: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2550: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2560: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2570: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2580: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 est tlsIO-1.7 {a
2590: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
25a0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
25b0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
25c0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
25d0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 socket -myport 2
25e0: 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 522} msg] $msg.}
25f0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2600: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2610: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2620: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2630: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 ..test tlsIO-1.8
2640: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2650: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2660: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
2670: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
2680: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2690: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 {tls::socket -fr
26a0: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a oboz} msg] $msg.
26b0: 7d 20 2d 6d 61 74 63 68 20 67 6c 6f 62 20 2d 72 } -match glob -r
26c0: 65 73 75 6c 74 20 7b 31 20 7b 62 61 64 20 6f 70 esult {1 {bad op
26d0: 74 69 6f 6e 20 22 2d 66 72 6f 62 6f 7a 22 3a 20 tion "-froboz":
26e0: 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 20 2a must be one of *
26f0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2700: 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .9 {arg parsing
2710: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2720: 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 nd} -constraints
2730: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 {socket} -body
2740: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2750: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2760: 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f server foo -mypo
2770: 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 rt 2521 3333} ms
2780: 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 g] $msg.} -match
2790: 20 67 6c 6f 62 20 2d 72 65 73 75 6c 74 20 7b 31 glob -result {1
27a0: 20 7b 62 61 64 20 6f 70 74 69 6f 6e 20 22 2d 6d {bad option "-m
27b0: 79 70 6f 72 74 22 3a 20 6d 75 73 74 20 62 65 20 yport": must be
27c0: 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 one of *}}..test
27d0: 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 tlsIO-1.10 {arg
27e0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
27f0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2800: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2810: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2820: 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d cket host 2528 -
2830: 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a junk} msg] $msg.
2840: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2850: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2860: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2870: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2880: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2890: 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 11 {arg parsing
28a0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
28b0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
28c0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
28d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
28e0: 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 ver callback 252
28f0: 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 0 --} msg] $msg.
2900: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2910: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2920: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2930: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
2940: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
2950: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 st tlsIO-1.12 {a
2960: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2970: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2980: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2990: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
29a0: 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f socket foo badpo
29b0: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
29c0: 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 {1 {expected int
29d0: 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 eger but got "ba
29e0: 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 dport"}}..test t
29f0: 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f lsIO-2.1 {tcp co
2a00: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
2a10: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2a20: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2a30: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2a40: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2a50: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
2a60: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
2a70: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
2a80: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
2a90: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2aa0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2ab0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
2ac0: 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 t"]. }. pu
2ad0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2ae0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2af0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
2b00: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2b10: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2b20: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2b30: 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 Key 8828 \]".
2b40: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2b50: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2b60: 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 dr port} {..
2b70: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
2b80: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
2b90: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2ba0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2bb0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2bc0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2bd0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 lose $f..puts $x
2be0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2bf0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2c00: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
2c10: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
2c20: 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f script] 2> /dev/
2c30: 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 null" r]. get
2c40: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
2c50: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2c60: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
2c70: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
2c80: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
2c90: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
2ca0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 127.0.0.1 8828}
2cb0: 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 msg]} {.
2cc0: 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d set x $msg. }
2cd0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
2ce0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
2cf0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
2d00: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
2d10: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2d20: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
2d30: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
2d40: 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 eady done {}}..i
2d50: 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 f [info exists p
2d60: 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 20 ort] {. incr
2d70: 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 port.} else {.
2d80: 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 set port [expr
2d90: 20 7b 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 {$tlsServerPort
2da0: 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a + [pid]%1024}].
2db0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
2dc0: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
2dd0: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f n with client po
2de0: 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 rt specified} {s
2df0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2e00: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2e10: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2e20: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2e30: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
2e40: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
2e50: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
2e60: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
2e70: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2e80: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2e90: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
2ea0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2eb0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2ec0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2ed0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2ee0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2ef0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2f00: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2f10: 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 ey 8829 \]".
2f20: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2f30: 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 accept {sock add
2f40: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
2f50: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
2f60: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
2f70: 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 "[gets $sock] $p
2f80: 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 ort".
2f90: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
2fa0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
2fb0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
2fc0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2fd0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2fe0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
2ff0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3000: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3010: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3020: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3030: 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 ] 2> /dev/null"
3040: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
3050: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 . global port
3060: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
3070: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
3080: 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 port $port \..-c
3090: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
30a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
30b0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
30c0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
30d0: 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d .0.1 8829} sock]
30e0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
30f0: 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b x $sock..catch {
3100: 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b close [tls::sock
3110: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
3120: 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 9]}. } else {
3130: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
3140: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
3150: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
3160: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3170: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
3180: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3190: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
31a0: 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 t x.} [list read
31b0: 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d y "hello $port"]
31c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 ..test tlsIO-2.3
31d0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
31e0: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 with client int
31f0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
3200: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3210: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3220: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3230: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3240: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3250: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3260: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
3270: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3280: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3290: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
32a0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
32b0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
32c0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
32d0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
32e0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
32f0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3300: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3310: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3320: 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a verKey 8830 \]".
3330: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3340: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
3350: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
3360: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3370: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
3380: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3390: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 ] $addr".
33a0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
33b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
33c0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
33d0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
33e0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
33f0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3400: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3410: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3420: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3430: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3440: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 ript] 2> /dev/nu
3450: 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 ll" r]. gets
3460: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
3470: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
3480: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 -myaddr 127.0.0
3490: 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 .1 \..-certfile
34a0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
34b0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
34c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
34d0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 ey 127.0.0.1 883
34e0: 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 0} sock]} {.
34f0: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
3500: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
3510: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
3520: 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c hello..catch {fl
3530: 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 ush $sock}.
3540: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
3550: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
3560: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3580: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3590: 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e {hello 127.0.0.
35a0: 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 1}}..test tlsIO-
35b0: 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.4 {tcp connect
35c0: 69 6f 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 ion with server
35d0: 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 interface specif
35e0: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
35f0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3600: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3610: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3620: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3630: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
3640: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
3650: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3660: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3670: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3680: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3690: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
36a0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
36b0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
36c0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
36d0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
36e0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
36f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3700: 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 serverKey -myadd
3710: 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 r [info hostname
3720: 5d 20 38 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 ] 8831 \]". p
3730: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3740: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3750: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3760: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3770: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3780: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 [gets $sock]".
3790: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
37a0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 $sock.
37b0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
37c0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
37d0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
37e0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
37f0: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
3800: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3810: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3820: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3830: 73 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 st script] 2> /d
3840: 65 76 2f 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 ev/null" r].
3850: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
3860: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3870: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
3880: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
3890: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
38a0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
38b0: 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d ey [info hostnam
38c0: 65 5d 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 e] 8831} sock]}
38d0: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
38e0: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
38f0: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
3900: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
3910: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
3920: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3930: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3940: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3950: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3960: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3970: 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ello}..test tlsI
3980: 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 O-2.5 {tcp conne
3990: 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e ction with redun
39a0: 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 dant server port
39b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
39c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
39d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
39e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
39f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3a00: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3a10: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
3a20: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3a30: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3a40: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3a50: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3a60: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3a70: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3a80: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3a90: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3aa0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3ab0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3ac0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3ad0: 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a verKey 8832 \]".
3ae0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3af0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
3b00: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
3b10: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3b20: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
3b30: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3b40: 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 ]". c
3b50: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3b60: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3b70: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3b80: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3b90: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3ba0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3bb0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3bc0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3bd0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3be0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 tcltest script]
3bf0: 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 2> /dev/null" r]
3c00: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
3c10: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
3c20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3c30: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3c40: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3c50: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3c60: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3c70: 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 1 8832} sock]} {
3c80: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
3c90: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
3ca0: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
3cb0: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
3cc0: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
3cd0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
3ce0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
3cf0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3d00: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3d10: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 et x.} {ready he
3d20: 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d llo}.test tlsIO-
3d30: 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.6 {tcp connect
3d40: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ion} {socket} {.
3d50: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f set status o
3d60: 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 k. if {![catc
3d70: 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 h {set sock [tls
3d80: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
3d90: 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 .1 8833]}]} {..i
3da0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 f {![catch {gets
3db0: 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 $sock}]} {..
3dc0: 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b set status brok
3dd0: 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f en..}..close $so
3de0: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ck. }. set
3df0: 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 status.} ok..te
3e00: 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 st tlsIO-2.7 {ec
3e10: 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c ho server, one l
3e20: 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ine} {socket std
3e30: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3e40: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3e50: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3e60: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3e70: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
3e80: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
3e90: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3ea0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3eb0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3ec0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3ed0: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3ee0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3ef0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3f00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3f10: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3f20: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3f30: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3f40: 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c serverKey 8834 \
3f50: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
3f60: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
3f70: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
3f80: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
3f90: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3fa0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3fb0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3fc0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3fd0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3fe0: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3ff0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
4000: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
4010: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
4020: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
4030: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
4040: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
4050: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
4070: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
4080: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
4090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40a0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
40b0: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
40c0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
40d0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
40e0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
40f0: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
4100: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
4110: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4120: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
4130: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
4140: 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c pt] 2> /dev/null
4150: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
4160: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
4170: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
4180: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4190: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
41a0: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
41b0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
41c0: 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 834]. fconfig
41d0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
41e0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
41f0: 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 ion lf. puts
4200: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
4210: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 ghijklmnop".
4220: 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 after 1000. s
4230: 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 et x [gets $s].
4240: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
4250: 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a set y [gets $f].
4260: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4270: 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b list $x $y.} {{
4280: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
4290: 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 klmnop} done}..t
42a0: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 est tlsIO-2.8 {e
42b0: 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 cho server, loop
42c0: 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 50 times, singl
42d0: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 e connection} {s
42e0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
42f0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
4300: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
4310: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
4320: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
4330: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
4340: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
4350: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
4360: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4370: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
4380: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4390: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
43a0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
43b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
43c0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 $serverKey 8835
43d0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
43e0: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
43f0: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
4400: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
4410: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
4420: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
4430: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
4440: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
4450: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
4460: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
4470: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
4480: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
4490: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
44a0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
44b0: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
44c0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
44d0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
44e0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
4500: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
4510: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
4520: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
4530: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4540: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
4550: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
4560: 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 set i 0..puts re
4570: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
4580: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
4590: 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 x done"]..vwait
45a0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
45b0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
45c0: 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 f..puts "done $i
45d0: 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 ". }. clos
45e0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
45f0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4600: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4610: 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 script] 2> /dev
4620: 2f 6e 75 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 /null" r]. ge
4630: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
4640: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4650: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4660: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4670: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4680: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
4690: 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 20 66 63 0.1 8835]. fc
46a0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
46b0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
46c0: 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 catch {..for {se
46d0: 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d t x 0} {$x < 50}
46e0: 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 {incr x} {..
46f0: 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 puts $s "hello
4700: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
4710: 22 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 ".. gets $s..
4720: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 }. }. clos
4730: 65 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b e $s. catch {
4740: 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 7d set x [gets $f]}
4750: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4760: 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 set x.} {done
4770: 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 50}..test tlsIO-
4780: 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 2.9 {socket conf
4790: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
47a0: 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 dio} {. set s
47b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
47c0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
47d0: 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 8]. removeFil
47e0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
47f0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4800: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
4810: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
4820: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
4830: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
4840: 6e 65 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ne $f {..package
4850: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c require tls..tl
4860: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4870: 72 20 61 63 63 65 70 74 20 38 38 32 38 0a 20 20 r accept 8828.
4880: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4890: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
48a0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
48b0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
48c0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
48d0: 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 s $f. after 1
48e0: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 00. set x [li
48f0: 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 st [catch {close
4900: 20 24 66 7d 20 6d 73 67 5d 20 5b 73 74 72 69 6e $f} msg] [strin
4910: 67 20 72 61 6e 67 65 20 24 6d 73 67 20 30 20 34 g range $msg 0 4
4920: 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 3]]. close $s
4930: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
4940: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
4950: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
4960: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
4970: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 .test tlsIO-2.10
4980: 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 {close on accep
4990: 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b t, accepted sock
49a0: 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 et lives} {socke
49b0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e t} {. set don
49c0: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
49d0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
49e0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
49f0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 ut"]. set ss
4a00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
4a10: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4a20: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4a30: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4a40: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 t \..-keyfile $s
4a50: 65 72 76 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 erverKey 8830].
4a60: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
4a70: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
4a80: 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 ss..close $ss..
4a90: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4aa0: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
4ab0: 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 "..fconfigure $s
4ac0: 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d -trans lf. }
4ad0: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
4ae0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 {s} {..global d
4af0: 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c one..gets $s..cl
4b00: 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 ose $s..set done
4b10: 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 1. }. set
4b20: 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 cs [tls::socket
4b30: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4b40: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4b50: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4b60: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 le $clientKey [i
4b70: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
4b80: 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 30]. close $c
4b90: 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e s.. vwait don
4ba0: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
4bb0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
4bc0: 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 t done.} 1..test
4bd0: 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 tlsIO-2.11 {det
4be0: 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d ecting new data}
4bf0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
4c00: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
4c10: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f p} {..global so
4c20: 63 6b 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 ck..# when doing
4c30: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
4c40: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
4c50: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
4c60: 65 64 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d ed..# to be non-
4c70: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
4c80: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 TLS handshake.
4c90: 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a Also make sure.
4ca0: 09 23 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 .# to return the
4cb0: 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 channel to line
4cc0: 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e buffering mode.
4cd0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
4ce0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
4cf0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 fering line..set
4d00: 20 73 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 sock $s..fileev
4d10: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
4d20: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
4d30: 6b 65 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 ke $s]. }..
4d40: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
4d50: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4d60: 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ept \.. -cert
4d70: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4d80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4d90: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4da0: 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 rKey 8400]. s
4db0: 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 et sock "". s
4dc0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
4dd0: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4de0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4df0: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4e00: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4e10: 31 32 37 2e 30 2e 30 2e 31 20 38 34 30 30 5d 0a 127.0.0.1 8400].
4e20: 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 # when doing
4e30: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
4e40: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
4e50: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
4e60: 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e ed. # to be n
4e70: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
4e80: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
4e90: 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 e Also make sur
4ea0: 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 e to. # retur
4eb0: 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f n the channel to
4ec0: 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 line buffering
4ed0: 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 mode (TLS sets i
4ee0: 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 t to 'none')..
4ef0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
4f00: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
4f10: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
4f20: 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 vwait sock.
4f30: 70 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 puts $s2 one.
4f40: 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 23 flush $s2. #
4f50: 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 need update to
4f60: 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e complete TLS han
4f70: 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 dshake in-proces
4f80: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 s. update.
4f90: 20 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 after 500. f
4fa0: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
4fb0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
4fc0: 73 65 74 20 72 65 73 75 6c 74 20 61 3a 5b 67 65 set result a:[ge
4fd0: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 ts $sock]. la
4fe0: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 62 3a 5b ppend result b:[
4ff0: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
5000: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
5010: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
5020: 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 puts $s2 two.
5030: 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 flush $s2.
5040: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
5050: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
5060: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
5070: 63 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 c:[gets $sock].
5080: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5090: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a ock -blocking 1.
50a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
50b0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
50c0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 lose $sock. s
50d0: 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f et result.} {a:o
50e0: 6e 65 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 ne b: c:two}..te
50f0: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 st tlsIO-2.12 {t
5100: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e cp connection; n
5110: 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 20 73 o certificates s
5120: 70 65 63 69 66 69 65 64 7d 20 5c 0a 09 7b 73 6f pecified} \..{so
5130: 63 6b 65 74 20 73 74 64 69 6f 20 75 6e 69 78 4f cket stdio unixO
5140: 6e 6c 79 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 nly} {. # The
5150: 72 65 20 69 73 20 61 20 64 65 62 75 67 20 61 73 re is a debug as
5160: 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f sertion on Windo
5170: 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 ws/SSL that caus
5180: 65 73 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 es a crash when
5190: 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 the. # certif
51a0: 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 icate isn't spec
51b0: 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 ified.. remov
51c0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
51d0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
51e0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
51f0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
5200: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
5210: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
5220: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
5230: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
5240: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
5250: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5260: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
5270: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5280: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
5290: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
52a0: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
52b0: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
52c0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
52d0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
52e0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
52f0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5300: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
5310: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
5320: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5330: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
5340: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5350: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5360: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 ript] 2> /dev/nu
5370: 6c 6c 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 ll" r]. gets
5380: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
5390: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
53a0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
53b0: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
53c0: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
53d0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
53e0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
53f0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
5400: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5410: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
5420: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
5430: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
5440: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
5450: 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b test tlsIO-3.1 {
5460: 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d socket conflict}
5470: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5480: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
5490: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
54a0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
54b0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
54c0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
54d0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
54e0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
54f0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
5500: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
5510: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
5520: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5530: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
5540: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
5550: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5560: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
5570: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
5580: 74 73 20 24 66 20 7b 0a 09 70 75 74 73 20 72 65 ts $f {..puts re
5590: 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a ady..gets stdin.
55a0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
55b0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
55c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
55d0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
55e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
55f0: 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2> /dev/null" r
5600: 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 +]. gets $f.
5610: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
5620: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5630: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
5640: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5650: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5660: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5670: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
5680: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 er accept 8828}
5690: 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 msg] \...$msg].
56a0: 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 puts $f bye.
56b0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
56c0: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
56d0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
56e0: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
56f0: 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 y in use}}..test
5700: 20 74 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 tlsIO-3.2 {serv
5710: 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 er with several
5720: 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 clients} {socket
5730: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
5740: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
5750: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5760: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
5770: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
5780: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
5790: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
57a0: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
57b0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 uire tls..set t1
57c0: 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 [after 30000 "s
57d0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
57e0: 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 ..set t2 [after
57f0: 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 31000 "set x tim
5800: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 ed_out"]..set t3
5810: 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 [after 32000 "s
5820: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
5830: 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a ..set counter 0.
5840: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
5850: 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a f "set s \[tls::
5860: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
5870: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
5880: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
5890: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
58a0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
58b0: 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 8828 \]". put
58c0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
58d0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
58e0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
58f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
5900: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
5910: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5920: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 ering line..}..p
5930: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
5940: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
5950: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c set l
5960: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
5970: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
5980: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
5990: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
59a0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
59b0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
59c0: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
59d0: 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 e {.
59e0: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
59f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
5a00: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
5a10: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5a20: 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 ncel $t1..vwait
5a30: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5a40: 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 $t2..vwait x..af
5a50: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 ter cancel $t3..
5a60: 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 close $s..puts $
5a70: 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 x. }. clos
5a80: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
5a90: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5aa0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5ab0: 20 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 script] 2> /dev
5ac0: 2f 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 73 /null" r+]. s
5ad0: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 et x [gets $f].
5ae0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
5af0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5b00: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5b10: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5b20: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5b30: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
5b40: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 27.0.0.1 8828].
5b50: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5b60: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
5b70: 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c e. set s2 [tl
5b80: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
5b90: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5ba0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5bb0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5bc0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
5bd0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 127.0.0.1 8828
5be0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
5bf0: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
5c00: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
5c10: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5c20: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
5c30: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5c40: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5c50: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5c60: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
5c70: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
5c80: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
5c90: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
5ca0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
5cb0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
5cc0: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
5cd0: 74 6c 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 tlsIO-3.2,s1..ge
5ce0: 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 ts $s1..puts $s2
5cf0: 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 hello,tlsIO-3.2
5d00: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
5d10: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c uts $s3 hello,tl
5d20: 73 49 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 sIO-3.2,s3..gets
5d30: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 $s3. }. c
5d40: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
5d50: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
5d60: 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 $s3. lappend
5d70: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
5d80: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5d90: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
5da0: 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 e}..test tlsIO-4
5db0: 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 .1 {server with
5dc0: 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d several clients}
5dd0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5de0: 7b 0a 20 20 20 20 23 20 68 61 76 65 20 73 65 65 {. # have see
5df0: 6e 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 n intermittent h
5e00: 61 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a angs on Windows.
5e10: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5e20: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5e30: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5e40: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
5e50: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
5e60: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
5e70: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
5e80: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5e90: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5ea0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5eb0: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
5ec0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
5ed0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5ee0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5ef0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
5f00: 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 0.0.1 8828 \]".
5f10: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 puts $f {..fc
5f20: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5f30: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 fering line..for
5f40: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
5f50: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
5f60: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 .. puts $s he
5f70: 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 llo.. gets $s
5f80: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 ..}..close $s..p
5f90: 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 uts bye..gets st
5fa0: 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c din. }. cl
5fb0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 ose $f. set p
5fc0: 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 1 [open "|[list
5fd0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5fe0: 65 73 74 20 73 63 72 69 70 74 5d 20 32 3e 20 2f est script] 2> /
5ff0: 64 65 76 2f 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 dev/null" r+].
6000: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 fconfigure $p1
6010: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
6020: 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 . set p2 [ope
6030: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
6040: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
6050: 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 ript] 2> /dev/nu
6060: 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e ll" r+]. fcon
6070: 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 figure $p2 -buff
6080: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
6090: 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c et p3 [open "|[l
60a0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
60b0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 tcltest script]
60c0: 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 2b 2> /dev/null" r+
60d0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
60e0: 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 $p3 -buffering
60f0: 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 line. proc ac
6100: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6110: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
6120: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 uffering line..f
6130: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
6140: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
6150: 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s]. }. pr
6160: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 oc echo {s} {..g
6170: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
6180: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
6190: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
61a0: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
61b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
61c0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
61d0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c one. } el
61e0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
61f0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
6200: 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }. }.
6210: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
6220: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6230: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 _out"]. set t
6240: 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 2 [after 31000 "
6250: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6260: 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 ]. set t3 [af
6270: 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 ter 32000 "set x
6280: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6290: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
62a0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
62b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
62c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
62d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
62e0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
62f0: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
6300: 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 . puts $p1 op
6310: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 en. puts $p2
6320: 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 open. puts $p
6330: 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 3 open. vwait
6340: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
6350: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
6360: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a fter cancel $t1.
6370: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6380: 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 $t2. after c
6390: 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c ancel $t3. cl
63a0: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c ose $s. set l
63b0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
63c0: 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 l [list p1 [gets
63d0: 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p1] $x]. la
63e0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 ppend l [list p2
63f0: 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a [gets $p2] $x].
6400: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6410: 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 ist p3 [gets $p3
6420: 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 ] $x]. puts $
6430: 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 p1 bye. puts
6440: 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p2 bye. puts
6450: 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f $p3 bye. clo
6460: 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 se $p1. close
6470: 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $p2. close $
6480: 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b p3. set l.} {
6490: 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 {p1 bye done} {p
64a0: 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 2 bye done} {p3
64b0: 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 bye done}}..test
64c0: 20 74 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 65 tlsIO-4.2 {byte
64d0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
64e0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
64f0: 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d htons} {socket}
6500: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b 0a {. set x ok.
6510: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
6520: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6530: 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 7d ver dodo 0x3000}
6540: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 msg]} {..set x
6550: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
6560: 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 {..close $msg.
6570: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
6580: 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 ok..test tlsIO-5
6590: 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .1 {byte order p
65a0: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
65b0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
65c0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f \..{socket unixO
65d0: 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 nly notRoot} {.
65e0: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
65f0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6600: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 not owner}. i
6610: 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a f {![catch {tls:
6620: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6630: 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d 20 dodo 0x1} msg]}
6640: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
6650: 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 {htons problem,
6660: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
6670: 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 owed, are you ru
6680: 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 nning as SU?}..c
6690: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
66a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
66b0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
66c0: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 t: not owner}.te
66d0: 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 st tlsIO-5.2 {by
66e0: 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d te order problem
66f0: 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 s, socket number
6700: 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 s, htons} {socke
6710: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
6720: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
6730: 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 cket: port numbe
6740: 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 r too high}.
6750: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
6760: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6770: 20 64 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 6d dodo 0x10000} m
6780: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 sg]} {..set x {p
6790: 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 ort resolution p
67a0: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
67b0: 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 e disallowed}..c
67c0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
67d0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 set x.} {cou
67e0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
67f0: 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 t: port number t
6800: 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 20 74 6c oo high}.test tl
6810: 73 49 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 sIO-5.3 {byte or
6820: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
6830: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
6840: 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ons} \..{socket
6850: 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 unixOnly notRoot
6860: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 } {. set x {c
6870: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
6880: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
6890: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
68a0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
68b0: 72 76 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 rver dodo 21} ms
68c0: 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 g]} {..set x {ht
68d0: 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f ons problem, sho
68e0: 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 uld be disallowe
68f0: 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 d, are you runni
6900: 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 ng as SU?}..clos
6910: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
6920: 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e set x.} {couldn
6930: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6940: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 not owner}..test
6950: 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 tlsIO-6.1 {acce
6960: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
6970: 72 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f r} {socket stdio
6980: 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 20 } {. # There
6990: 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65 72 is a debug asser
69a0: 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 2f tion on Windows/
69b0: 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 20 SSL that causes
69c0: 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 65 a crash when the
69d0: 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63 61 . # certifica
69e0: 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 69 te isn't specifi
69f0: 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 ed.. removeFi
6a00: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6a10: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6a20: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6a30: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
6a40: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
6a50: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
6a60: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
6a70: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
6a80: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
6a90: 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a s $f [list tls::
6aa0: 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 socket -cafile $
6ab0: 63 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 caCert 127.0.0.1
6ac0: 20 38 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 8848]. close
6ad0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
6ae0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6af0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6b00: 73 63 72 69 70 74 5d 20 32 3e 20 2f 64 65 76 2f script] 2> /dev/
6b10: 6e 75 6c 6c 22 20 72 2b 5d 0a 20 20 20 20 70 72 null" r+]. pr
6b20: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
6b30: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
6b40: 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 x $args. }.
6b50: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
6b60: 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 s a p} {expr 10
6b70: 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 73 20 5b / 0}. set s [
6b80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6b90: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
6ba0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
6bb0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
6bc0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6bd0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 34 38 $serverKey 8848
6be0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 ]. puts $f he
6bf0: 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 llo. close $f
6c00: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
6c10: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
6c20: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
6c30: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
6c40: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
6c50: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
6c60: 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 rename bgerr
6c70: 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a or {}. set x.
6c80: 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 } {{divide by ze
6c90: 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ro}}..test tlsIO
6ca0: 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.1 {testing so
6cb0: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
6cc0: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 tions} {socket s
6cd0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
6ce0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6cf0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6d00: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6d10: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
6d20: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
6d30: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
6d40: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
6d50: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
6d60: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 puts $f [list t
6d70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6d80: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 er accept \..
6d90: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
6da0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6db0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6dc0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 30 5d $serverKey 8820]
6dd0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6de0: 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 proc accept args
6df0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
6e00: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
6e10: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
6e20: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
6e30: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
6e40: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 imed_out"]..vwai
6e50: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
6e60: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
6e70: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6e80: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6e90: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6ea0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 20 tcltest script]
6eb0: 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c 22 20 72 5d 2> /dev/null" r]
6ec0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6ed0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6ee0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6ef0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6f00: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6f10: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6f20: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
6f30: 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 0.0.1 8820].
6f40: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
6f50: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
6f60: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6f70: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6f80: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6f90: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
6fa0: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
6fb0: 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 0] 127.0.0.1].
6fc0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6fd0: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
6fe0: 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a dex $p 2] 8820].
6ff0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
7000: 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 length $p].} {0
7010: 30 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 0 3}..test tlsIO
7020: 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.2 {testing so
7030: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
7040: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 tions} {socket s
7050: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
7060: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
7070: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
7080: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
7090: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
70a0: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
70b0: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
70c0: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
70d0: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
70e0: 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 puts $f "tls::s
70f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
7100: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
7110: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
7120: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7130: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
7140: 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 821". puts $f
7150: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
7160: 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 args {.. glob
7170: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
7180: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
7190: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
71a0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
71b0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
71c0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
71d0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
71e0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
71f0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
7200: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
7210: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
7220: 70 74 5d 20 32 3e 20 2f 64 65 76 2f 6e 75 6c 6c pt] 2> /dev/null
7230: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
7240: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7250: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7260: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
7270: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7280: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7290: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
72a0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 127.0.0.1 8821].
72b0: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
72c0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
72d0: 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 me]. close $s
72e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
72f0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
7300: 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 append l [llengt
7310: 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e h $p]. lappen
7320: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 d l [lindex $p 0
7330: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
7340: 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c [string equal [l
7350: 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 index $p 2] 8821
7360: 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 ].} {3 127.0.0.1
7370: 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 0}..test tlsIO-
7380: 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.3 {testing soc
7390: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
73a0: 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ions} {socket} {
73b0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
73c0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
73d0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
73e0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
73f0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7400: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
7410: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 5d ver accept 8822]
7420: 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 6c 65 6e . set l [llen
7430: 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 gth [fconfigure
7440: 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]]. close $
7450: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 s. update.
7460: 20 23 20 41 20 62 75 67 20 66 69 78 65 64 20 69 # A bug fixed i
7470: 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 66 6f 72 n fconfigure for
7480: 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 74 68 69 8.3.4+ make thi
7490: 73 20 72 65 74 75 72 6e 20 31 34 20 6e 6f 72 6d s return 14 norm
74a0: 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 75 74 20 ally,. # but
74b0: 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 65 72 73 12 in older vers
74c0: 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 72 20 7b ions.. expr {
74d0: 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 28 24 6c $l >= 12 && (($l
74e0: 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 31 % 2) == 0)}.} 1
74f0: 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 ..# bug report #
7500: 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 5812 fconfigure
7510: 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 doesn't return v
7520: 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e alue for '-sockn
7530: 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f ame'..test tlsIO
7540: 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.4 {testing so
7550: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
7560: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 tions} {socket}
7570: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
7580: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7590: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
75a0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
75b0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
75c0: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
75d0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 33 rver accept 8823
75e0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
75f0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
7600: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 bal x..set x [fc
7610: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 onfigure $s -soc
7620: 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 kname]..close $s
7630: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7640: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 1 [tls::socket \
7650: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
7660: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
7670: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7680: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 $clientKey \.
7690: 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d .[info hostnam
76a0: 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 73 65 74 e] 8823]. set
76b0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
76c0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
76d0: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
76e0: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
76f0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
7700: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
7710: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 e $s1. set l
7720: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
7730: 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b [lindex $x 2] [
7740: 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 38 llength $x].} {8
7750: 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 823 3}..# bug re
7760: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
7770: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
7780: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
7790: 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 -sockname'..test
77a0: 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 73 74 tlsIO-7.5 {test
77b0: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
77c0: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
77d0: 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 7d 20 7b cket unixOrPc} {
77e0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
77f0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7800: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7810: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7820: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7830: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
7840: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
7850: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
7860: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7870: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
7880: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
7890: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
78a0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
78b0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
78c0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
78d0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
78e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
78f0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7900: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
7910: 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 73 65 0.1 8829]. se
7920: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7930: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
7940: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
7950: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
7960: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
7970: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7980: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
7990: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
79a0: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 l [lindex $x 0]
79b0: 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c [lindex $x 2] [l
79c0: 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 length $x].} {12
79d0: 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 7d 0a 7.0.0.1 8829 3}.
79e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e 31 20 .test tlsIO-8.1
79f0: 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 {testing -async
7a00: 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d flag on sockets}
7a10: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
7a20: 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 74 65 73 # NOTE: This tes
7a30: 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e 20 73 6f t may fail on so
7a40: 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e 34 20 73 me Solaris 2.4 s
7a50: 79 73 74 65 6d 73 2e 0a 20 20 20 20 23 20 53 65 ystems.. # Se
7a60: 65 20 6e 6f 74 65 73 20 69 6e 20 54 63 6c 27 73 e notes in Tcl's
7a70: 20 73 6f 63 6b 65 74 2e 74 65 73 74 2e 0a 20 20 socket.test..
7a80: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7a90: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
7aa0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
7ab0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7ac0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7ad0: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
7ae0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 30 rver accept 8830
7af0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
7b00: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
7b10: 62 61 6c 20 78 0a 09 23 20 77 68 65 6e 20 64 6f bal x..# when do
7b20: 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 ing an in-proces
7b30: 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 s client/server
7b40: 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 test, both sides
7b50: 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 20 6e need..# to be n
7b60: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
7b70: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
7b80: 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 e. Also make su
7b90: 72 65 0a 09 23 20 74 6f 20 72 65 74 75 72 6e 20 re..# to return
7ba0: 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c the channel to l
7bb0: 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f ine buffering mo
7bc0: 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 de...fconfigure
7bd0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
7be0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
7bf0: 70 75 74 73 20 24 73 20 62 79 65 0a 09 23 20 4f puts $s bye..# O
7c00: 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 30 2e 39 2e nly OpenSSL 0.9.
7c10: 35 61 20 6f 6e 20 57 69 6e 64 6f 77 73 20 73 65 5a on Windows se
7c20: 65 6d 73 20 74 6f 20 6e 65 65 64 20 74 68 65 20 ems to need the
7c30: 61 66 74 65 72 20 28 64 65 6c 61 79 65 64 29 0a after (delayed).
7c40: 09 23 20 63 6c 6f 73 65 2c 20 62 75 74 20 69 74 .# close, but it
7c50: 20 77 6f 72 6b 73 20 6a 75 73 74 20 74 68 65 20 works just the
7c60: 73 61 6d 65 20 66 6f 72 20 61 6c 6c 20 6f 74 68 same for all oth
7c70: 65 72 73 2e 20 2d 68 6f 62 62 73 0a 09 61 66 74 ers. -hobbs..aft
7c80: 65 72 20 35 30 30 20 63 6c 6f 73 65 20 24 73 0a er 500 close $s.
7c90: 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 .set x done.
7ca0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
7cb0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
7cc0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
7cd0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
7ce0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
7cf0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
7d00: 20 20 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 -async [info h
7d10: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 ostname] 8830].
7d20: 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 # when doing
7d30: 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c an in-process cl
7d40: 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 ient/server test
7d50: 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 , both sides nee
7d60: 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f d. # to be no
7d70: 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 n-blocking for t
7d80: 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 he TLS handshake
7d90: 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 Also make sure
7da0: 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e to. # return
7db0: 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 the channel to
7dc0: 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d line buffering m
7dd0: 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 ode (TLS sets it
7de0: 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 to 'none')..
7df0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 fconfigure $s1
7e00: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
7e10: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
7e20: 76 77 61 69 74 20 78 0a 20 20 20 20 23 20 54 4c vwait x. # TL
7e30: 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 S handshaking ne
7e40: 65 64 73 20 6f 6e 65 20 62 79 74 65 20 66 72 6f eds one byte fro
7e50: 6d 20 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a m the client....
7e60: 20 20 20 20 70 75 74 73 20 24 73 31 20 61 0a 20 puts $s1 a.
7e70: 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 # need update
7e80: 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 to complete TLS
7e90: 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 handshake in-pr
7ea0: 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 ocess. update
7eb0: 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 . set z [gets
7ec0: 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s1]. close
7ed0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
7ee0: 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 . set z.} bye
7ef0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 ..test tlsIO-9.1
7f00: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
7f10: 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b us events} {sock
7f20: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 et} {. set le
7f30: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
7f40: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
7f50: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
7f60: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
7f70: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
7f80: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
7f90: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
7fa0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
7fb0: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
7fc0: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
7fd0: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
7fe0: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
7ff0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
8000: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
8010: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
8020: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
8030: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
8040: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
8050: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
8060: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
8070: 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 ocking 0..fileev
8080: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
8090: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
80a0: 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 ke $s readable r
80b0: 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 eadlittle \...-b
80c0: 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 uffering none].
80d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
80e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
80f0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
8100: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
8110: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8120: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
8130: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
8140: 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 8831]. set
8150: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
8160: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8170: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8180: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8190: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
81a0: 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f \.. [info ho
81b0: 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 stname] 8831].
81c0: 20 20 23 20 54 68 69 73 20 64 69 66 66 65 72 73 # This differs
81d0: 20 66 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 from socket-9.1
81e0: 20 69 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 in that both si
81f0: 64 65 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 des need to be.
8200: 20 20 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e # non-blockin
8210: 67 20 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 g because of TLS
8220: 27 20 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 ' required hands
8230: 68 61 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 hake. fconfig
8240: 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 ure $c -blocking
8250: 20 30 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 0. puts -non
8260: 65 77 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 ewline $c 012345
8270: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
8280: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
8290: 38 39 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 890123456789.
82a0: 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 close $c. se
82b0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
82c0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
82d0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
82e0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
82f0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
8300: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
8310: 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 list $spuriou
8320: 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a s $len.} {0 50}.
8330: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 .test tlsIO-9.2
8340: 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 {testing async w
8350: 72 69 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 rite, fileevents
8360: 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 , flush on close
8370: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
8380: 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 set firstblock
8390: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 [string repeat a
83a0: 20 33 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 31]. set sec
83b0: 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 ondblock [string
83c0: 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 5d repeat b 65535]
83d0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
83e0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
83f0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
8400: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
8410: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
8420: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
8430: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
8440: 61 62 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c able \...-transl
8450: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
8460: 73 69 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 size 16384 -buff
8470: 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 ering line].
8480: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 }. proc reada
8490: 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c ble {s} {..set l
84a0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 [gets $s]..dput
84b0: 73 20 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 s "got \"[string
84c0: 20 72 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 replace $l 10 e
84d0: 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 nd-3 ...]\" \...
84e0: 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 ([string length
84f0: 24 6c 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 $l]) from $s"..f
8500: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
8510: 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 able {}..after 1
8520: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 000 respond $s.
8530: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
8540: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f spond {s} {..glo
8550: 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 bal firstblock..
8560: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8570: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 tring replace $f
8580: 69 72 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 irstblock 10 end
8590: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
85a0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 string length $f
85b0: 69 72 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e irstblock]) down
85c0: 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 $s"..puts -none
85d0: 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 wline $s $firstb
85e0: 6c 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 lock..after 1000
85f0: 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 writedata $s.
8600: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 }. proc wri
8610: 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c tedata {s} {..gl
8620: 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b obal secondblock
8630: 0a 09 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 ..dputs "send \"
8640: 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 [string replace
8650: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 $secondblock 10
8660: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
8670: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
8680: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 $secondblock])
8690: 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d down $s"..puts -
86a0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
86b0: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 condblock..close
86c0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
86d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
86e0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
86f0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
8700: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8710: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8720: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
8730: 20 61 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 accept 8832].
8740: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
8750: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8760: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8770: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8780: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8790: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e ntKey \.. [in
87a0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
87b0: 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 2]. fconfigur
87c0: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
87d0: 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 -trans lf -buff
87e0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
87f0: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 et count 0. p
8800: 75 74 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 20 uts $c hello.
8810: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
8820: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
8830: 20 64 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 20 done..set data
8840: 5b 72 65 61 64 20 24 73 5d 0a 09 64 70 75 74 73 [read $s]..dputs
8850: 20 22 72 65 61 64 20 5c 22 5b 73 74 72 69 6e 67 "read \"[string
8860: 20 72 65 70 6c 61 63 65 20 24 64 61 74 61 20 31 replace $data 1
8870: 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0 end-3 ...]\" \
8880: 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 ...([string leng
8890: 74 68 20 24 64 61 74 61 5d 29 20 66 72 6f 6d 20 th $data]) from
88a0: 24 73 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 $s"..incr count
88b0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
88c0: 64 61 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 data]..if {[eof
88d0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
88e0: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
88f0: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
8900: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
8910: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
8920: 24 63 22 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 $c". set done
8930: 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 0. set timer
8940: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
8950: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
8960: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
8970: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
8980: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
8990: 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 lose $s. list
89a0: 20 24 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 $count $done.}
89b0: 7b 36 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 20 {65566 1}..test
89c0: 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 tlsIO-9.3 {testi
89d0: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
89e0: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 s} {unexplainedF
89f0: 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 7b ailure socket} {
8a00: 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 . # HOBBS: ne
8a10: 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 ver worked corre
8a20: 63 74 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 6f ctly. proc co
8a30: 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b unt_to_eof {s} {
8a40: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 ..global count d
8a50: 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c one timer..set l
8a60: 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b [gets $s]..if {
8a70: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
8a80: 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 incr count..
8a90: 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d if {$count > 9}
8aa0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
8ab0: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 set done true...
8ac0: 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 set count {eof i
8ad0: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
8ae0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
8af0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
8b00: 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 proc timerpr
8b10: 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 oc {} {..global
8b20: 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 done count c..se
8b30: 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 t done true..set
8b40: 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 count {timer we
8b50: 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e nt off, eof is n
8b60: 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 ot sticky}..clos
8b70: 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 e $c. }..
8b80: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
8b90: 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 set done false.
8ba0: 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 proc write_th
8bb0: 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 en_close {s} {..
8bc0: 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f puts $s bye..clo
8bd0: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
8be0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8bf0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
8c00: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
8c10: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8c20: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
8c30: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 ..fileevent $s w
8c40: 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f ritable [list do
8c50: 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 20 77 72 _handshake $s wr
8c60: 69 74 61 62 6c 65 20 77 72 69 74 65 5f 74 68 65 itable write_the
8c70: 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 66 n_close \...-buf
8c80: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
8c90: 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 nslation lf].
8ca0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
8cb0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
8cc0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
8cd0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8ce0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8cf0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
8d00: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
8d10: 20 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 8833]. set c
8d20: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8d30: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8d40: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8d50: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8d60: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
8d70: 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 .. [info host
8d80: 6e 61 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 name] 8833].
8d90: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 fconfigure $c -b
8da0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
8db0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
8dc0: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 lation lf. fi
8dd0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
8de0: 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f ble "count_to_eo
8df0: 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 f $c". set ti
8e00: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
8e10: 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 timerproc]. v
8e20: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c wait done. cl
8e30: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 ose $s. set c
8e40: 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 ount.} {eof is s
8e50: 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 ticky}..removeFi
8e60: 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 le script..test
8e70: 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 tlsIO-10.1 {test
8e80: 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70 ing socket accep
8e90: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
8ea0: 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b handling} {sock
8eb0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f et} {. set go
8ec0: 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f terror 0. pro
8ed0: 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b c bgerror args {
8ee0: 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b global goterror;
8ef0: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d set goterror 1}
8f00: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
8f10: 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 :socket -cafile
8f20: 24 63 61 43 65 72 74 20 2d 73 65 72 76 65 72 20 $caCert -server
8f30: 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 20 20 accept 8898].
8f40: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
8f50: 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 a p} {close $s;
8f60: 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 error}. set c
8f70: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
8f80: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 32 afile $caCert 12
8f90: 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 20 7.0.0.1 8898].
8fa0: 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72 vwait goterror
8fb0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
8fc0: 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 close $c. s
8fd0: 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a et goterror.} 1.
8fe0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
8ff0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
9000: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9010: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9020: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
9030: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
9040: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
9050: 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 ocket9_1_test_se
9060: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
9070: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
9080: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
9090: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
90a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
90b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
90c0: 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 834]..proc accep
90d0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
90e0: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
90f0: 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 $s.. puts $s
9100: 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 done.. close
9110: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
9120: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9130: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9140: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9150: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9160: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9170: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9180: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 5d teServerIP 8834]
9190: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
91a0: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
91b0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
91c0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
91d0: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_1_test_server}
91e0: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e . set r.} don
91f0: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 e..test tlsIO-11
9200: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
9210: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
9220: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9230: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9240: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
9250: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a exists port]} {.
9260: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d .incr port. }
9270: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 else {..set por
9280: 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 t [expr {$tlsSer
9290: 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 verPort + [pid]%
92a0: 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 1024}]. }.
92b0: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
92c0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
92d0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 {..set socket9_2
92e0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
92f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
9300: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
9310: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9320: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9330: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9340: 76 65 72 4b 65 79 20 38 38 33 35 5d 0a 09 70 72 verKey 8835]..pr
9350: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
9360: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9370: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9380: 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 20 puts $s $p..
9390: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
93a0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
93b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
93c0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
93d0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
93e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
93f0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9400: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24 -myport $port $
9410: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9420: 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 835]. set r [
9430: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
9440: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
9450: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
9460: 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 cket9_2_test_ser
9470: 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 ver}. if {$r
9480: 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 == $port} {..set
9490: 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d result ok. }
94a0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 else {..set res
94b0: 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d ult broken. }
94c0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
94d0: 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f } ok..test tlsIO
94e0: 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f -11.3 {trying to
94f0: 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 connect, no ser
9500: 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ver} {socket doT
9510: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9520: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9530: 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 status ok. if
9540: 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 {![catch {set s
9550: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
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 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
95b0: 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 7b verIp 8836]}]} {
95c0: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 ..if {![catch {g
95d0: 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 ets $s}]} {..
95e0: 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b set status brok
95f0: 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a en..}..close $s.
9600: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 }. set st
9610: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 atus.} ok..test
9620: 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f tlsIO-11.4 {remo
9630: 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e te echo, one lin
9640: 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 e} {socket doTes
9650: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9660: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
9670: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
9680: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
9690: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f socket10_6_test_
96a0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
96b0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
96c0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
96d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
96e0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
96f0: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 y \...-server ac
9700: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 cept 8836]..proc
9710: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
9720: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
9730: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 shake $s.. fi
9740: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
9750: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
9760: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
9770: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
9780: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
9790: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
97a0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
97b0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
97c0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
97d0: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
97e0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
97f0: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
9800: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
9810: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
9820: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9830: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9840: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9850: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9860: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9870: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
9880: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9890: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
98a0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
98b0: 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 66 line. puts $f
98c0: 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72 hello. set r
98d0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
98e0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
98f0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9900: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f socket10_6_test_
9910: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9920: 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 r.} hello..test
9930: 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f tlsIO-11.5 {remo
9940: 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 te echo, 50 line
9950: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
9960: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9970: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
9980: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
9990: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
99a0: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
99b0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
99c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
99d0: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
99e0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
99f0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9a00: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9a10: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
9a20: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9a30: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9a40: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
9a50: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
9a60: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
9a70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9a80: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
9a90: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
9aa0: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
9ab0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
9ac0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
9ad0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
9ae0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
9af0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
9b00: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
9b10: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9b20: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
9b30: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9b40: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9b50: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9b60: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9b70: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9b80: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
9b90: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
9ba0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
9bb0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9bc0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 6e . for {set cn
9bd0: 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d t 0} {$cnt < 50}
9be0: 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70 {incr cnt} {..p
9bf0: 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24 uts $f "hello, $
9c00: 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e cnt"..if {[strin
9c10: 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 20 g compare [gets
9c20: 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 $f] "hello, $cnt
9c30: 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 "] != 0} {..
9c40: 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 break..}. }.
9c50: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
9c60: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9c70: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 se $socket10_7_t
9c80: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
9c90: 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 set cnt.} 50..#
9ca0: 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 Macintosh socket
9cb0: 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 s can have more
9cc0: 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 than one server
9cd0: 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 per port.if {$tc
9ce0: 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 l_platform(platf
9cf0: 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f orm) == "macinto
9d00: 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 sh"} {. set c
9d10: 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 onflictResult {0
9d20: 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 8836}.} else {.
9d30: 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 set conflict
9d40: 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 Result {1 {could
9d50: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
9d60: 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 address already
9d70: 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 in use}}.}..tes
9d80: 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f t tlsIO-11.6 {so
9d90: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
9da0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9db0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9dc0: 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c {. set s1 [tl
9dd0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9de0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
9df0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9e00: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9e10: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
9e20: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
9e30: 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 8836]. if {[
9e40: 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 catch {set s2 [t
9e50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9e60: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
9e70: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9e80: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9e90: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9ea0: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9eb0: 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b t 8836]} msg]} {
9ec0: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 ..set result [li
9ed0: 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d st 1 $msg]. }
9ee0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 else {..set res
9ef0: 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e ult [list 0 [lin
9f00: 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 dex [fconfigure
9f10: 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 $s2 -sockname] 2
9f20: 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 ]]..close $s2.
9f30: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
9f40: 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 1. set result
9f50: 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 .} $conflictResu
9f60: 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 lt..test tlsIO-1
9f70: 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 1.7 {server with
9f80: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
9f90: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9fa0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9fb0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
9fc0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
9fd0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
9fe0: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
9ff0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
a000: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
a010: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
a020: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a030: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
a040: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
a050: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 ept 8836]..proc
a060: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a070: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
a080: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
a090: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 ine.. fileeve
a0a0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
a0b0: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d list echo $s]..}
a0c0: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
a0d0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
a0e0: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
a0f0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
a100: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
a110: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
a120: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
a130: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
a140: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a150: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a160: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a170: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a180: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a190: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a1a0: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
a1b0: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
a1c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
a1d0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
a1e0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a1f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a200: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a210: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a220: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a230: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
a240: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
a250: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
a260: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
a270: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
a280: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
a290: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
a2a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a2b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a2c0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
a2d0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
a2e0: 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 onfigure $s3 -bu
a2f0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
a300: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
a310: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
a320: 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 i} {..puts $s1 h
a330: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c ello,tlsIO-11.7,
a340: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
a350: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 ts $s2 hello,tls
a360: 49 4f 2d 31 31 2e 37 2c 73 32 0a 09 67 65 74 73 IO-11.7,s2..gets
a370: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
a380: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c ello,tlsIO-11.7,
a390: 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 s3..gets $s3.
a3a0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 }. close $s1
a3b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 . close $s2.
a3c0: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 close $s3.
a3d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a3e0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f ose $socket10_9_
a3f0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
a400: 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 set i.} 100
a410: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a420: 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 8 {client with s
a430: 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 everal servers}
a440: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a450: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a460: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
a470: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
a480: 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a 69 6e mmand {..tls::in
a490: 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 it -certfile $se
a4a0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
a4b0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a4c0: 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 73 65 e $serverKey..se
a4d0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
a4e0: 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 t -server "accep
a4f0: 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73 t 4003" 4003]..s
a500: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
a510: 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 et -server "acce
a520: 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09 pt 4004" 4004]..
a530: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a540: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a550: 65 70 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a ept 4005" 4005].
a560: 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 .proc handshake
a570: 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 69 66 {s mp} {.. if
a580: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
a590: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
a5a0: 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b elseif {[catch {
a5b0: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
a5c0: 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 s} result]} {...
a5d0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
a5e0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d e normal... }
a5f0: 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 elseif {$result
a600: 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e == 1} {...# Han
a610: 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a dshake complete.
a620: 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
a630: 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 75 74 eadable ""...put
a640: 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f 73 65 s $s $mp...close
a650: 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 $s.. }..}..p
a660: 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 roc accept {mp s
a670: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 20 54 a p} {.. # T
a680: 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 63 63 hese have to acc
a690: 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 ept non-blocking
a6a0: 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 68 61 , because the ha
a6b0: 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 20 23 ndshaking.. #
a6c0: 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 65 74 order isn't det
a6d0: 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 20 20 erministic..
a6e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
a6f0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
a700: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
a710: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
a720: 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 able [list hands
a730: 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 7d 0a hake $s $mp]..}.
a740: 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a 3a 69 }. tls::i
a750: 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 nit -certfile $c
a760: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a770: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a780: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a 20 20 le $clientKey.
a790: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
a7a0: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a7b0: 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 verIP 4003].
a7c0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
a7d0: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
a7e0: 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65 rIP 4004]. se
a7f0: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
a800: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
a810: 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 20 P 4005]. set
a820: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
a830: 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 l [gets $s1] [g
a840: 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 ets $s1] [eof $s
a850: 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 1] [gets $s2] [g
a860: 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 ets $s2] [eof $s
a870: 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 2] \..[gets $s3]
a880: 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 [gets $s3] [eof
a890: 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s3]. close
a8a0: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
a8b0: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
a8c0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a8d0: 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c {..close $s1..cl
a8e0: 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 ose $s2..close $
a8f0: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s3. }. set
a900: 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 l.} {4003 {} 1
a910: 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 4004 {} 1 4005 {
a920: 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f } 1}..test tlsIO
a930: 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 61 -11.9 {accept ca
a940: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
a950: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
a960: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
a970: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
a980: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
a990: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a9a0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a9b0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
a9c0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
a9d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
a9e0: 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 836]. proc ac
a9f0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
aa00: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 pr 10 / 0}. p
aa10: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
aa20: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
aa30: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
aa40: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
aa50: 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 es. if {[catc
aa60: 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b h {sendCommand {
aa70: 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 6e 61 .. set peerna
aa80: 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 me [fconfigure $
aa90: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 callerSocket -pe
aaa0: 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 ername].. set
aab0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
aac0: 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c \... -certfil
aad0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
aae0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
aaf0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
ab00: 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e 64 65 y \... [linde
ab10: 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 38 x $peername 0] 8
ab20: 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 836].. close
ab30: 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d $s. . }} msg]
ab40: 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 } {..close $s..e
ab50: 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a rror $msg. }.
ab60: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
ab70: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
ab80: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
ab90: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
aba0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
abb0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
abc0: 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f rename bgerro
abd0: 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d r {}. set x.}
abe0: 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 {{divide by zer
abf0: 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d o}}..test tlsIO-
ac00: 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 20 73 11.10 {testing s
ac10: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
ac20: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
ac30: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
ac40: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
ac50: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
ac60: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
ac70: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 .set socket10_12
ac80: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
ac90: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
aca0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
acb0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
acc0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
acd0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
ace0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
acf0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
ad00: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d a p} {close $s}
ad10: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
ad20: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
ad30: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
ad40: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
ad50: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ad60: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
ad70: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
ad80: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
ad90: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
ada0: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
adb0: 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 set n [fconf
adc0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
add0: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 me]. set l ""
ade0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
adf0: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c lindex $p 2] [ll
ae00: 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 ength $p] [lleng
ae10: 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 th $p]. close
ae20: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
ae30: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
ae40: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
ae50: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d ver}. set l.}
ae60: 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 65 73 {8836 3 3}..tes
ae70: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 7b 74 t tlsIO-11.11 {t
ae80: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
ae90: 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 events} {socket
aea0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
aeb0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 eServer} {. #
aec0: 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 remote equivale
aed0: 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 73 65 nt of 9.1. se
aee0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
aef0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
af00: 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 74 5f set socket_test_
af10: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
af20: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
af30: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
af40: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
af50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
af60: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
af70: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 61 6e 8836]..proc han
af80: 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 20 20 dshake {s} {..
af90: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
afa0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
afb0: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 } elseif {[cat
afc0: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
afd0: 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 ke $s} result]}
afe0: 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 {...# Some error
aff0: 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 s are normal...
b000: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 } elseif {$re
b010: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 sult == 1} {...#
b020: 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c Handshake compl
b030: 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 ete...fileevent
b040: 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 0a 09 $s writable ""..
b050: 09 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65 .after 100 write
b060: 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 some $s.. }..
b070: 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b }..proc accept {
b080: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 s a p} {.. fc
b090: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
b0a0: 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c nslation "auto l
b0b0: 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e f".. fileeven
b0c0: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c t $s writable [l
b0d0: 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73 ist handshake $s
b0e0: 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 ]..}..proc write
b0f0: 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 some {s} {..
b100: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
b110: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
b120: 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c } {...puts $s "l
b130: 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f ine $i from remo
b140: 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 te server"..
b150: 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a }.. close $s.
b160: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b170: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 len 0. set s
b180: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 purious 0. se
b190: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
b1a0: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d c readlittle {s}
b1b0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 {..global spuri
b1c0: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 ous done len..se
b1d0: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a t l [read $s 1].
b1e0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e .if {[string len
b1f0: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a gth $l] == 0} {.
b200: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 . if {![eof $
b210: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 s]} {...incr spu
b220: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 rious.. } els
b230: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 e {...close $s..
b240: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 .set done 1..
b250: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
b260: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 incr len [stri
b270: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d ng length $l]..}
b280: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
b290: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b2a0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
b2b0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
b2c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b2d0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
b2e0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
b2f0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
b300: 23 20 47 65 74 20 74 68 65 20 62 75 66 66 65 72 # Get the buffer
b310: 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a 20 20 ing corrected.
b320: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
b330: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
b340: 20 20 20 20 23 20 50 75 74 20 61 20 62 79 74 65 # Put a byte
b350: 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 6e 74 into the client
b360: 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 65 72 pipe to trigger
b370: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 TLS handshaking
b380: 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 0a 20 . puts $c a.
b390: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 fileevent $c
b3a0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 readable [list r
b3b0: 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a 20 20 eadlittle $c].
b3c0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
b3d0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
b3e0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
b3f0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
b400: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
b410: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f timer. sendCo
b420: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
b430: 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72 cket_test_server
b440: 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 }. list $spur
b450: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 ious $len.} {0 2
b460: 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 690}..test tlsIO
b470: 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 -11.12 {testing
b480: 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 EOF stickyness}
b490: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c {unexplainedFail
b4a0: 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 ure socket doTes
b4b0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
b4c0: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f er} {. # remo
b4d0: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 te equivalent of
b4e0: 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 42 53 9.3. # HOBBS
b4f0: 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 : never worked c
b500: 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 65 74 orrectly. set
b510: 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 73 counter 0. s
b520: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
b530: 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 oc count_up {s}
b540: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 {..global counte
b550: 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a r done after_id.
b560: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
b570: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
b580: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e {.. incr coun
b590: 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 6f ter.. if {$co
b5a0: 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73 unter > 9} {...s
b5b0: 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20 et done {EOF is
b5c0: 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 sticky}...after
b5d0: 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 64 cancel $after_id
b5e0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
b5f0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
b600: 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b proc timed_out {
b610: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f } {..global c do
b620: 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 69 ne..set done {ti
b630: 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20 med_out, EOF is
b640: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f not sticky}..clo
b650: 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 se $c. }.
b660: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
b670: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b680: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
b690: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 4_test_server [t
b6a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
b6b0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
b6c0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b6d0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
b6e0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
b6f0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
b700: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
b710: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
b720: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
b730: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 . after 100 c
b740: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b750: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
b760: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b770: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b780: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b790: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b7a0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
b7b0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b7c0: 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 8836]. fileev
b7d0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b7e0: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 "count_up $c".
b7f0: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b set after_id [
b800: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 after 1000 timed
b810: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 _out]. vwait
b820: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d done. sendCom
b830: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
b840: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b850: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f rver}. set do
b860: 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 ne.} {EOF is sti
b870: 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f cky}..test tlsIO
b880: 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 -11.13 {testing
b890: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 async write, asy
b8a0: 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 nc flush, async
b8b0: 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 close} \..{socke
b8c0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b8d0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b8e0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
b8f0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
b900: 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 done..set l [re
b910: 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 ad $s]..incr cou
b920: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 nt [string lengt
b930: 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 h $l]..if {[eof
b940: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
b950: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
b960: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
b970: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
b980: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b990: 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f {..set firstblo
b9a0: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 ck [string repea
b9b0: 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 65 63 t a 31]..set sec
b9c0: 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 ondblock [string
b9d0: 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 5d repeat b 65535]
b9e0: 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f ..set l [tls::so
b9f0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
ba00: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
ba10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ba20: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
ba30: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
ba40: 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 72 6f ccept 8845]..pro
ba50: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
ba60: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
ba70: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
ba80: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
ba90: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
baa0: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
bab0: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 20 size 16384 \...
bac0: 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 -buffering li
bad0: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
bae0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
baf0: 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 eadable $s"..}..
bb00: 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 proc readable {s
bb10: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
bb20: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69 gets $s].. fi
bb30: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
bb40: 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 ble {}.. afte
bb50: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 r 1000 respond $
bb60: 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f s..}..proc respo
bb70: 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c nd {s} {.. gl
bb80: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a obal firstblock.
bb90: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
bba0: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c line $s $firstbl
bbb0: 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31 ock.. after 1
bbc0: 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73 000 writedata $s
bbd0: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64 ..}..proc writed
bbe0: 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 ata {s} {.. g
bbf0: 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 lobal secondbloc
bc00: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
bc10: 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e ewline $s $secon
bc20: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 dblock.. clos
bc30: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
bc40: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
bc50: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
bc60: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
bc70: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
bc80: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
bc90: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
bca0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 34 moteServerIP 884
bcb0: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 5]. fconfigur
bcc0: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
bcd0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
bce0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
bcf0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
bd00: 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
bd10: 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 lo. fileevent
bd20: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
bd30: 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 adit $s". set
bd40: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
bd50: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
bd60: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
bd70: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
bd80: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
bd90: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
bda0: 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 {close $l}.
bdb0: 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 set count.} 6556
bdc0: 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 61 20 6..proc getdata
bdd0: 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a 20 20 {type file} {.
bde0: 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 # Read handler
bdf0: 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 on the accepted
be00: 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 6c 6f socket.. glo
be10: 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c bal x. global
be20: 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 74 20 failed. set
be30: 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 status [catch {r
be40: 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d ead $file} data]
be50: 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 75 73 . if {$status
be60: 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 78 20 != 0} {..set x
be70: 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 "read failed, er
be80: 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 0a 09 ror was $data"..
be90: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
bea0: 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ile }. } else
beb0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
bec0: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b are {} $data]} {
bed0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
bee0: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d fblocked $file]}
bef0: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 {. } elseif
bf00: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
bf10: 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a .if {$failed} {.
bf20: 09 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70 . set x "$typ
bf30: 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 e socket was inh
bf40: 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 65 20 erited"..} else
bf50: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74 {.. set x "$t
bf60: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ype socket was n
bf70: 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d ot inherited"..}
bf80: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
bf90: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
bfa0: 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70 se {..set x {imp
bfb0: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 63 ossible case}..c
bfc0: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
bfd0: 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 le }. }. r
bfe0: 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c eturn.}..test tl
bff0: 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e sIO-12.1 {testin
c000: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
c010: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d server sockets}
c020: 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b {socket exec} {
c030: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
c040: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b script1. mak
c050: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 eFile {} script2
c060: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
c070: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
c080: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
c090: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c0a0: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
c0b0: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
c0c0: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
c0d0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
c0e0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c0f0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
c100: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
c110: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c120: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c130: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
c140: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 ript2 creates th
c150: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c e server socket,
c160: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
c170: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 1,. # waits a
c180: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 second, and exi
c190: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 ts. The server
c1a0: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a socket will now.
c1b0: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 # be closed
c1c0: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 unless script1 i
c1d0: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 nherited it...
c1e0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c1f0: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c200: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c210: 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a clsh $::tcltest:
c220: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
c230: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
c240: 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f auto_path $auto_
c250: 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 path]. puts $
c260: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
c270: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
c280: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
c290: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c2a0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
c2b0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
c2c0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
c2d0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
c2e0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
c2f0: 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 73 8828\]". puts
c300: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
c310: 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 pt { file addr p
c320: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f ort } {.. clo
c330: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 se $file..}..exe
c340: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
c350: 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 &..close $f..af
c360: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 ter 1000 exit..v
c370: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c380: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c390: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 . # Launch sc
c3a0: 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 ript2 and wait 5
c3b0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 seconds.. ex
c3c0: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
c3d0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
c3e0: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
c3f0: 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 { set ok_to_proc
c400: 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 eed 1 }. vwai
c410: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a t ok_to_proceed.
c420: 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e . # If we can
c430: 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 still connect t
c440: 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 o the server, th
c450: 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 e socket got inh
c460: 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 erited... if
c470: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
c480: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
c490: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
c4a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c4b0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
c4c0: 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 y \. . 127.0.0
c4d0: 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b .1 8828} msg]} {
c4e0: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 ..set x {server
c4f0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c500: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 nherited}. }
c510: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
c520: 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 sg..set x {serve
c530: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 r socket was inh
c540: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 erited}. }..
c550: 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 set x.} {serv
c560: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
c570: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 t inherited}..te
c580: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 st tlsIO-12.2 {t
c590: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
c5a0: 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 ce of client soc
c5b0: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 kets} {socket ex
c5c0: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ec} {. makeFi
c5d0: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
c5e0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c5f0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
c600: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
c610: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
c620: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
c630: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
c640: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
c650: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
c660: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
c670: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c680: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
c690: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
c6a0: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
c6b0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c6c0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c6d0: 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 # Script2 opens
c6e0: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b the client sock
c6f0: 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f et and writes to
c700: 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 it. It then.
c710: 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 # launches scr
c720: 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 ipt1 and exits.
c730: 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 If the child pr
c740: 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 ocess inherited
c750: 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 the. # client
c760: 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 socket, the soc
c770: 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 ket will still b
c780: 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 e open... set
c790: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
c7a0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
c7b0: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 [list set tclsh
c7c0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
c7d0: 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 est]. puts $f
c7e0: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
c7f0: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
c800: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c810: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
c820: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
c830: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
c840: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
c850: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c860: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c870: 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 \.. -keyfile
c880: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
c890: 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 0.0.1 8829\]".
c8a0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 puts $f {..exe
c8b0: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
c8c0: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
c8d0: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
c8e0: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
c8f0: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c900: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
c910: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
c920: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c930: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
c940: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
c950: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
c960: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
c970: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c980: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
c990: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
c9a0: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
c9b0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
c9c0: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
c9d0: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
c9e0: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
c9f0: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
ca00: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
ca10: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
ca20: 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 erver..fconfigur
ca30: 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e e $file -blockin
ca40: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
ca50: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c file readable [l
ca60: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
ca70: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
ca80: 5c 0a 09 09 5b 6c 69 73 74 20 67 65 74 64 61 74 \...[list getdat
ca90: 61 20 63 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65 a client] -buffe
caa0: 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75 ring line]..retu
cab0: 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 rn. }.. #
cac0: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f If the socket do
cad0: 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 esn't hit end-of
cae0: 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e -file in 5 secon
caf0: 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 ds, the. # sc
cb00: 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 ript1 process mu
cb10: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 st have inherite
cb20: 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 d the client...
cb30: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
cb40: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 5b after 5000 [
cb50: 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 list set failed
cb60: 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 1].. # Launch
cb70: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f the script2 pro
cb80: 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24 cess.. exec $
cb90: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
cba0: 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 st script2 &..
cbb0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 69 66 vwait x. if
cbc0: 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 {!$failed} {..v
cbd0: 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20 wait failed.
cbe0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 }. set x.} {c
cbf0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 lient socket was
cc00: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
cc10: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 .test tlsIO-12.3
cc20: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
cc30: 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 tance of accepte
cc40: 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 d sockets} \..{s
cc50: 6f 63 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f ocket exec unixO
cc60: 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 nly} {. makeF
cc70: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 ile {} script1.
cc80: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
cc90: 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 cript2.. set
cca0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
ccb0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
ccc0: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
ccd0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
cce0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
ccf0: 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 e $f.. set f
cd00: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
cd10: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
cd20: 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a st set tclsh $::
cd30: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
cd40: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
cd50: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
cd60: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
cd70: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
cd80: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
cd90: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
cda0: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
cdb0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
cdc0: 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 accept \.. -c
cdd0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
cde0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
cdf0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
ce00: 72 76 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a rverKey 8930\]".
ce10: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
ce20: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
ce30: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
ce40: 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 . global tcls
ce50: 68 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 h.. fconfigur
ce60: 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 e $file -bufferi
ce70: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 ng line.. put
ce80: 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 s $file {test da
ce90: 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 ta on socket}..
cea0: 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 exec $tclsh s
ceb0: 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 cript1 &.. af
cec0: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d ter 1000 exit..}
ced0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
cee0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
cef0: 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 $f.. # Launch
cf00: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f the script2 pro
cf10: 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 cess and connect
cf20: 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 to it. See how
cf30: 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 long. # the
cf40: 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 socket stays ope
cf50: 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 n.. exec $::t
cf60: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
cf70: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 script2 &.. a
cf80: 66 74 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b fter 2000 set ok
cf90: 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 _to_proceed 1.
cfa0: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 vwait ok_to_pr
cfb0: 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 oceed.. set f
cfc0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
cfd0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
cfe0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
cff0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
d000: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
d010: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
d020: 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8930]. fconfi
d030: 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 gure $f -bufferi
d040: 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e ng full -blockin
d050: 67 20 30 0a 20 20 20 20 23 20 57 65 20 6e 65 65 g 0. # We nee
d060: 64 20 74 6f 20 70 75 74 20 61 20 62 79 74 65 20 d to put a byte
d070: 69 6e 74 6f 20 74 68 65 20 72 65 61 64 20 71 75 into the read qu
d080: 65 75 65 2c 20 6f 74 68 65 72 77 69 73 65 20 74 eue, otherwise t
d090: 68 65 0a 20 20 20 20 23 20 54 4c 53 20 68 61 6e he. # TLS han
d0a0: 64 73 68 61 6b 65 20 64 6f 65 73 6e 27 74 20 66 dshake doesn't f
d0b0: 69 6e 69 73 68 0a 20 20 20 20 70 75 74 73 20 24 inish. puts $
d0c0: 66 20 61 3b 20 66 6c 75 73 68 20 24 66 0a 20 20 f a; flush $f.
d0d0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 fileevent $f r
d0e0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 eadable [list ge
d0f0: 74 64 61 74 61 20 61 63 63 65 70 74 65 64 20 24 tdata accepted $
d100: 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 f].. # If the
d110: 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c socket is still
d120: 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 open after 5 se
d130: 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 conds, the scrip
d140: 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 t1 process. #
d150: 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 must have inher
d160: 69 74 65 64 20 74 68 65 20 61 63 63 65 70 74 65 ited the accepte
d170: 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 d socket... s
d180: 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 et failed 0.
d190: 61 66 74 65 72 20 35 30 30 30 20 73 65 74 20 66 after 5000 set f
d1a0: 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 76 77 61 ailed 1.. vwa
d1b0: 69 74 20 78 0a 20 20 20 20 73 65 74 20 78 0a 7d it x. set x.}
d1c0: 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 {accepted socke
d1d0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
d1e0: 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ted}..test tlsIO
d1f0: 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 -13.1 {Testing u
d200: 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 se of shared soc
d210: 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 ket between two
d220: 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 threads} \..{soc
d230: 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 ket testthread}
d240: 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e {. # HOBBS: n
d250: 65 76 65 72 20 74 65 73 74 65 64 0a 20 20 20 20 ever tested.
d260: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
d270: 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 70 t. threadReap
d280: 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b .. makeFile {
d290: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
d2a0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 quire tls..set f
d2b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
d2c0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
d2d0: 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 8]..proc accept
d2e0: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
d2f0: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
d300: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
d310: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
d320: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
d330: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
d340: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
d350: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
d360: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
d370: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
d380: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
d390: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
d3a0: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
d3b0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
d3c0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
d3d0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
d3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
d3f0: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
d400: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
d410: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
d420: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d430: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
d440: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
d450: 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 set i 0..vwait x
d460: 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 ..close $f...# t
d470: 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 hread cleans its
d480: 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 elf up...testthr
d490: 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 ead exit. } s
d4a0: 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23 cript. . #
d4b0: 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 64 create a thread
d4c0: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 74 . set servert
d4d0: 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 hread [testthrea
d4e0: 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 d create { sourc
d4f0: 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 e script } ].
d500: 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20 update. .
d510: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 after 1000.
d520: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
d530: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
d540: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
d550: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
d560: 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 line.. catch
d570: 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c {..puts $s "hell
d580: 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 o"..gets $s resu
d590: 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f lt. }. clo
d5a0: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 se $s. update
d5b0: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
d5c0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
d5d0: 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d ult [threadReap]
d5e0: 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 65 . . set re
d5f0: 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 sult..} {hello 1
d600: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }..test tlsIO-14
d610: 2e 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .1 {test tls::un
d620: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d630: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
d640: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 ch {tls::unimpor
d650: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
d660: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
d670: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
d680: 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 :unimport channe
d690: 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d l"}}.test tlsIO-
d6a0: 31 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 3a 3a 14.2 {test tls::
d6b0: 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 unimport} {socke
d6c0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
d6d0: 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 atch {tls::unimp
d6e0: 6f 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d 73 67 ort foo bar} msg
d6f0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
d700: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
d710: 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 d be "tls::unimp
d720: 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 ort channel"}}.t
d730: 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b est tlsIO-14.3 {
d740: 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f test tls::unimpo
d750: 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 rt} {socket} {.
d760: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
d770: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 6f tls::unimport bo
d780: 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d gus} msg] $msg.}
d790: 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 69 6e {1 {can not fin
d7a0: 64 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 20 d channel named
d7b0: 22 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 20 74 "bogus"}}.test t
d7c0: 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 74 20 lsIO-14.4 {test
d7d0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b tls::unimport} {
d7e0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 socket} {. #
d7f0: 73 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 20 64 stdin can take d
d800: 69 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 20 61 ifferent names a
d810: 73 20 74 68 65 20 22 74 6f 70 22 20 63 68 61 6e s the "top" chan
d820: 6e 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 nel. list [ca
d830: 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f tch {tls::unimpo
d840: 72 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d 20 5c rt stdin} msg] \
d850: 0a 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 ..[string match
d860: 7b 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 2a 22 {bad channel "*"
d870: 3a 20 6e 6f 74 20 61 20 54 4c 53 20 63 68 61 6e : not a TLS chan
d880: 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b 31 20 nel} $msg].} {1
d890: 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 1}.test tlsIO-14
d8a0: 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .5 {test tls::un
d8b0: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d8c0: 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 {. set len 0
d8d0: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
d8e0: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
d8f0: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
d900: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
d910: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
d920: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
d930: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
d940: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
d950: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
d960: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
d970: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
d980: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
d990: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
d9a0: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
d9b0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
d9c0: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
d9d0: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
d9e0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
d9f0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
da00: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
da10: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
da20: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
da30: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
da40: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
da50: 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 little \...-buff
da60: 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 ering none].
da70: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
da80: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
da90: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
daa0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
dab0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
dac0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
dad0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
dae0: 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 8831]. set c
daf0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
db00: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
db10: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
db20: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
db30: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
db40: 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e . [info hostn
db50: 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 23 ame] 8831]. #
db60: 20 6f 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e 74 only the client
db70: 20 67 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 gets tls::impor
db80: 74 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b 74 t. set res [t
db90: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 5d ls::unimport $c]
dba0: 0a 20 20 20 20 6c 69 73 74 20 24 72 65 73 20 5b . list $res [
dbb0: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d catch {close $c}
dbc0: 20 65 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b 63 err] $err \..[c
dbd0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 20 atch {close $s}
dbe0: 65 72 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 err] $err.} {{}
dbf0: 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 74 0 {} 0 {}}..test
dc00: 20 74 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 7b tls-bug58-1.0 {
dc10: 74 65 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e 65 test protocol ne
dc20: 67 6f 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 72 gotiation failur
dc30: 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 e} {socket} {.
dc40: 20 20 23 20 46 6f 6c 6c 6f 77 69 6e 67 20 63 6f # Following co
dc50: 64 65 20 69 73 20 62 61 73 65 64 20 6f 6e 20 77 de is based on w
dc60: 68 61 74 20 77 61 73 20 72 65 70 6f 72 74 65 64 hat was reported
dc70: 20 69 6e 20 62 75 67 20 23 35 38 2e 20 50 72 69 in bug #58. Pri
dc80: 6f 72 0a 20 20 20 20 23 20 74 6f 20 66 69 78 20 or. # to fix
dc90: 74 68 65 20 70 72 6f 67 72 61 6d 20 77 6f 75 6c the program woul
dca0: 64 20 63 72 61 73 68 20 77 69 74 68 20 61 20 73 d crash with a s
dcb0: 65 67 66 61 75 6c 74 2e 0a 20 20 20 20 70 72 6f egfault.. pro
dcc0: 63 20 41 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 c Accept {sock a
dcd0: 72 67 73 7d 20 7b 0a 20 20 20 20 20 20 20 20 66 rgs} {. f
dce0: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
dcf0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 3b 0a 20 20 20 -blocking 0;.
dd00: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
dd10: 73 6f 63 6b 20 72 65 61 64 61 62 6c 65 20 5b 6c sock readable [l
dd20: 69 73 74 20 48 61 6e 64 73 68 61 6b 65 20 24 73 ist Handshake $s
dd30: 6f 63 6b 5d 0a 20 20 20 20 7d 20 0a 20 20 20 20 ock]. } .
dd40: 70 72 6f 63 20 48 61 6e 64 73 68 61 6b 65 20 7b proc Handshake {
dd50: 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 20 20 20 20 sock} {.
dd60: 73 65 74 20 3a 3a 64 6f 6e 65 20 48 41 4e 44 0a set ::done HAND.
dd70: 20 20 20 20 20 20 20 20 63 61 74 63 68 20 7b 74 catch {t
dd80: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
dd90: 6f 63 6b 7d 20 6d 73 67 0a 20 20 20 20 20 20 20 ock} msg.
dda0: 20 73 65 74 20 3a 3a 64 6f 6e 65 20 24 6d 73 67 set ::done $msg
ddb0: 0a 20 20 20 20 7d 20 0a 20 20 20 20 23 20 4e 4f . } . # NO
ddc0: 54 45 3a 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 TE: when doing a
ddd0: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
dde0: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
ddf0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
de00: 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e . # to be non
de10: 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 -blocking for th
de20: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 0a e TLS handshake.
de30: 0a 20 20 20 20 23 20 53 65 72 76 65 72 20 2d 20 . # Server -
de40: 4f 6e 6c 79 20 61 63 63 65 70 74 20 54 4c 53 20 Only accept TLS
de50: 31 2e 32 0a 20 20 20 20 73 65 74 20 73 20 5b 74 1.2. set s [t
de60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 20 20 20 ls::socket \.
de70: 20 20 20 20 20 20 20 20 20 20 20 20 2d 63 65 72 -cer
de80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
de90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
dea0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
deb0: 65 72 4b 65 79 20 5c 0a 20 20 20 20 20 20 20 20 erKey \.
dec0: 20 20 20 20 20 20 20 2d 72 65 71 75 65 73 74 20 -request
ded0: 30 20 2d 72 65 71 75 69 72 65 20 30 20 2d 73 73 0 -require 0 -ss
dee0: 6c 32 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c l2 0 -ssl3 0 -tl
def0: 73 31 20 30 20 2d 74 6c 73 31 2e 31 20 30 20 2d s1 0 -tls1.1 0 -
df00: 74 6c 73 31 2e 32 20 31 20 5c 0a 20 20 20 20 20 tls1.2 1 \.
df10: 20 20 20 20 20 20 20 20 20 20 2d 73 65 72 76 65 -serve
df20: 72 20 41 63 63 65 70 74 20 38 38 33 31 5d 0a 20 r Accept 8831].
df30: 20 20 20 23 20 43 6c 69 65 6e 74 20 2d 20 4f 6e # Client - On
df40: 6c 79 20 70 72 6f 70 6f 73 65 20 54 4c 53 31 2e ly propose TLS1.
df50: 30 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 0. set c [tls
df60: 3a 3a 73 6f 63 6b 65 74 20 2d 61 73 79 6e 63 20 ::socket -async
df70: 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 \.
df80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
df90: 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 \.
dfa0: 20 20 2d 72 65 71 75 65 73 74 20 30 20 2d 72 65 -request 0 -re
dfb0: 71 75 69 72 65 20 30 20 2d 73 73 6c 32 20 30 20 quire 0 -ssl2 0
dfc0: 2d 73 73 6c 33 20 30 20 2d 74 6c 73 31 20 31 20 -ssl3 0 -tls1 1
dfd0: 2d 74 6c 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e -tls1.1 0 -tls1.
dfe0: 32 20 30 20 5c 0a 20 20 20 20 20 20 20 20 20 20 2 0 \.
dff0: 20 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e [info hostn
e000: 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 66 ame] 8831]. f
e010: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
e020: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
e030: 73 20 24 63 20 61 20 3b 20 66 6c 75 73 68 20 24 s $c a ; flush $
e040: 63 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 c. after 5000
e050: 20 5b 6c 69 73 74 20 73 65 74 20 3a 3a 64 6f 6e [list set ::don
e060: 65 20 74 69 6d 65 6f 75 74 5d 0a 20 20 20 20 76 e timeout]. v
e070: 77 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 wait ::done.
e080: 73 77 69 74 63 68 20 2d 65 78 61 63 74 20 2d 2d switch -exact --
e090: 20 24 3a 3a 64 6f 6e 65 20 7b 0a 20 20 20 20 20 $::done {.
e0a0: 20 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 "handshake fa
e0b0: 69 6c 65 64 3a 20 77 72 6f 6e 67 20 73 73 6c 20 iled: wrong ssl
e0c0: 76 65 72 73 69 6f 6e 22 20 7b 0a 20 20 20 20 20 version" {.
e0d0: 20 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e set ::don
e0e0: 65 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 e "handshake fai
e0f0: 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 led: wrong versi
e100: 6f 6e 20 6e 75 6d 62 65 72 22 0a 20 20 20 20 20 on number".
e110: 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 }. }. s
e120: 65 74 20 3a 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e et ::done.} {han
e130: 64 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 dshake failed: w
e140: 72 6f 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d rong version num
e150: 62 65 72 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a ber}..# cleanup.
e160: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 if {[string matc
e170: 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 h sock* $command
e180: 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a Socket] == 1} {.
e190: 20 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 puts $command
e1a0: 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 Socket exit. f
e1b0: 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lush $commandSoc
e1c0: 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f ket.}.catch {clo
e1d0: 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 se $commandSocke
e1e0: 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 t}.catch {close
e1f0: 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d $remoteProcChan}
e200: 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 .::tcltest::clea
e210: 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 nupTests.flush s
e220: 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a tdout.return.