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 22 20 emoteServerIP]"
1810: 77 2b 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 w+]} msg] == 0}
1820: 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a 09 {...after 1000..
1830: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 .if {[catch {set
1840: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b commandSocket [
1850: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 tls::socket -caf
1860: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
1870: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
1880: 6e 74 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 ntCert -keyfile
1890: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 $clientKey \....
18a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
18b0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
18c0: 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b t]} msg] == 0} {
18d0: 0a 09 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ... fconfigur
18e0: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
18f0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
1900: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
1910: 6e 65 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 ne...} else {...
1920: 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 set noRemote
1930: 54 65 73 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a TestReason $msg.
1940: 09 09 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 .. set doTest
1950: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1960: 72 20 30 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 r 0...}.. } e
1970: 6c 73 65 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 lse {...set noRe
1980: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 moteTestReason "
1990: 24 6d 73 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a $msg $::tcltest:
19a0: 3a 74 63 6c 74 65 73 74 22 0a 09 09 73 65 74 20 :tcltest"...set
19b0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
19c0: 65 53 65 72 76 65 72 20 30 0a 09 20 20 20 20 7d eServer 0.. }
19d0: 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ..}. } else {
19e0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f ..fconfigure $co
19f0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
1a00: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
1a10: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
1a20: 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 }.}..# Some te
1a30: 73 74 73 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 sts are run only
1a40: 20 69 66 20 77 65 20 61 72 65 20 64 6f 69 6e 67 if we are doing
1a50: 20 74 65 73 74 69 6e 67 20 61 67 61 69 6e 73 74 testing against
1a60: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
1a70: 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a ..set ::tcltest:
1a80: 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 :testConstraints
1a90: 28 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f (doTestsWithRemo
1aa0: 74 65 53 65 72 76 65 72 29 20 24 64 6f 54 65 73 teServer) $doTes
1ab0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1ac0: 65 72 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 er.if {$doTestsW
1ad0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1ae0: 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b == 0} {. if {
1af0: 5b 73 74 72 69 6e 67 20 66 69 72 73 74 20 73 20 [string first s
1b00: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 $::tcltest::verb
1b10: 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 ose] != -1} {.
1b20: 20 20 09 70 75 74 73 20 22 53 6b 69 70 70 69 6e .puts "Skippin
1b30: 67 20 74 65 73 74 73 20 77 69 74 68 20 72 65 6d g tests with rem
1b40: 6f 74 65 20 73 65 72 76 65 72 2e 20 53 65 65 20 ote server. See
1b50: 74 65 73 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 tests/socket.tes
1b60: 74 20 66 6f 72 22 0a 09 70 75 74 73 20 22 69 6e t for"..puts "in
1b70: 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 formation on how
1b80: 20 74 6f 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 to run remote s
1b90: 65 72 76 65 72 2e 22 0a 09 70 75 74 73 20 22 52 erver."..puts "R
1ba0: 65 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f eason for not do
1bb0: 69 6e 67 20 72 65 6d 6f 74 65 20 74 65 73 74 73 ing remote tests
1bc0: 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 : $noRemoteTestR
1bd0: 65 61 73 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a eason". }.}..
1be0: 23 0a 23 20 49 66 20 77 65 20 64 6f 20 74 68 65 #.# If we do the
1bf0: 20 74 65 73 74 73 2c 20 64 65 66 69 6e 65 20 61 tests, define a
1c00: 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 command to send
1c10: 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 a command to th
1c20: 65 0a 23 20 72 65 6d 6f 74 65 20 73 65 72 76 65 e.# remote serve
1c30: 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 r..#..if {$doTes
1c40: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1c50: 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 er == 1} {. p
1c60: 72 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 roc sendCommand
1c70: 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {c} {..global co
1c80: 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 mmandSocket...if
1c90: 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 {[eof $commandS
1ca0: 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 ocket]} {.. e
1cb0: 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 rror "remote ser
1cc0: 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 22 ver disappeared"
1cd0: 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 ..}...if {[catch
1ce0: 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 {puts $commandS
1cf0: 6f 63 6b 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 ocket $c} msg]}
1d00: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 {.. error "re
1d10: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1d20: 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 ppeared: $msg"..
1d30: 7d 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 }..if {[catch {p
1d40: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
1d50: 65 74 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 et "--Marker--Ma
1d60: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d rker--Marker--"}
1d70: 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 msg]} {.. er
1d80: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
1d90: 65 72 20 64 69 73 61 70 70 65 61 72 65 64 3a 20 er disappeared:
1da0: 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 $msg"..}...set r
1db0: 65 73 70 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 esp ""..while {1
1dc0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 69 6e } {.. set lin
1dd0: 65 20 5b 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 e [gets $command
1de0: 53 6f 63 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 Socket].. if
1df0: 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f {[eof $commandSo
1e00: 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 cket]} {...error
1e10: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1e20: 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 20 20 disappeared"..
1e30: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 }.. if {[st
1e40: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 6c 69 ring compare $li
1e50: 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 ne "--Marker--Ma
1e60: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d rker--Marker--"]
1e70: 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 66 20 7b 5b == 0} {...if {[
1e80: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
1e90: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 30 5d 20 lindex $resp 0]
1ea0: 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 error] == 0} {..
1eb0: 09 20 20 20 20 65 72 72 6f 72 20 5b 6c 69 6e 64 . error [lind
1ec0: 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 20 ex $resp 1]...}
1ed0: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 72 65 74 else {... ret
1ee0: 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 urn [lindex $res
1ef0: 70 20 31 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 p 1]...}.. }
1f00: 65 6c 73 65 20 7b 0a 09 09 61 70 70 65 6e 64 20 else {...append
1f10: 72 65 73 70 20 24 6c 69 6e 65 20 22 5c 6e 22 0a resp $line "\n".
1f20: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
1f30: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
1f40: 20 5b 6c 69 73 74 20 70 72 6f 63 20 64 70 75 74 [list proc dput
1f50: 73 20 5b 69 6e 66 6f 20 61 72 67 73 20 64 70 75 s [info args dpu
1f60: 74 73 5d 20 5b 69 6e 66 6f 20 62 6f 64 79 20 64 ts] [info body d
1f70: 70 75 74 73 5d 5d 0a 0a 20 20 20 20 70 72 6f 63 puts]].. proc
1f80: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 20 sendCertValues
1f90: 7b 7d 20 7b 0a 09 23 20 57 65 20 6e 65 65 64 20 {} {..# We need
1fa0: 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 73 65 to be able to se
1fb0: 6e 64 20 63 65 72 74 69 66 69 63 61 74 65 20 76 nd certificate v
1fc0: 61 6c 75 65 73 20 74 68 61 74 20 6e 6f 72 6d 61 alues that norma
1fd0: 6c 69 7a 65 0a 09 23 20 66 69 6c 65 6e 61 6d 65 lize..# filename
1fe0: 73 20 61 63 72 6f 73 73 20 70 6c 61 74 66 6f 72 s across platfor
1ff0: 6d 73 0a 09 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 ms..sendCommand
2000: 7b 0a 09 20 20 20 20 73 65 74 20 63 65 72 74 73 {.. set certs
2010: 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b Dir.[file join [
2020: 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e file dirname [in
2030: 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 72 74 fo script]] cert
2040: 73 5d 0a 09 20 20 20 20 73 65 74 20 73 65 72 76 s].. set serv
2050: 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 erCert.[file joi
2060: 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 n $certsDir serv
2070: 65 72 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 er.pem].. set
2080: 20 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 6c clientCert.[fil
2090: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
20a0: 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 09 20 20 client.pem]..
20b0: 20 20 73 65 74 20 63 61 43 65 72 74 09 09 5b 66 set caCert..[f
20c0: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
20d0: 69 72 20 63 61 63 65 72 74 2e 70 65 6d 5d 0a 09 ir cacert.pem]..
20e0: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 4b 65 set serverKe
20f0: 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 y.[file join $ce
2100: 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 6b 65 rtsDir server.ke
2110: 79 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 y].. set clie
2120: 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e ntKey.[file join
2130: 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e $certsDir clien
2140: 74 2e 6b 65 79 5d 0a 09 7d 0a 20 20 20 20 7d 0a t.key]..}. }.
2150: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2160: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
2170: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2180: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2190: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
21a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
21b0: 65 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 er} msg] $msg.}
21c0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
21d0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
21e0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
21f0: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
2200: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
2210: 20 74 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 tlsIO-1.2 {arg
2220: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2230: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2240: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2250: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2260: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d ket -server foo}
2270: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2280: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2290: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
22a0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
22b0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
22c0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
22d0: 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 sIO-1.3 {arg par
22e0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
22f0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2300: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2310: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2320: 20 2d 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 -myaddr} msg] $
2330: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2340: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2350: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2360: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2370: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2380: 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 O-1.4 {arg parsi
2390: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
23a0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
23b0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
23c0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
23d0: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
23e0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
23f0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2400: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2410: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2420: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2430: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 est tlsIO-1.5 {a
2440: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2450: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2460: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2470: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2480: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 socket -myport}
2490: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
24a0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
24b0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
24c0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
24d0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
24e0: 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 t tlsIO-1.6 {arg
24f0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2500: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2510: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2520: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2530: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 cket -myport xxx
2540: 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b x} msg] $msg.} {
2550: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2560: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2570: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
2580: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2590: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b test tlsIO-1.7 {
25a0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
25b0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
25c0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
25d0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
25e0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
25f0: 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 2522} msg] $msg.
2600: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2610: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2620: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2630: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2640: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2650: 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 8 {arg parsing f
2660: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2670: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2680: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2690: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 ls::socket -frob
26a0: 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 oz} msg] $msg.}
26b0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
26c0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
26d0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
26e0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
26f0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 .test tlsIO-1.9
2700: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2710: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2720: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2730: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2740: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2750: 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 foo -myport 252
2760: 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 1 3333} msg] $ms
2770: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2780: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2790: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
27a0: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
27b0: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
27c0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 test tlsIO-1.10
27d0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
27e0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
27f0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2800: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2810: 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 ::socket host 25
2820: 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 28 -junk} msg] $
2830: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2840: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2850: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2860: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2870: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2880: 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 O-1.11 {arg pars
2890: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
28a0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
28b0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
28c0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
28d0: 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b -server callback
28e0: 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 2520 --} msg] $
28f0: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2900: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2910: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2920: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2930: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
2940: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2950: 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 2 {arg parsing f
2960: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2970: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2980: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2990: 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 ls::socket foo b
29a0: 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 adport} msg] $ms
29b0: 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 g.} {1 {expected
29c0: 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 integer but got
29d0: 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 "badport"}}..te
29e0: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 st tlsIO-2.1 {tc
29f0: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
2a00: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2a10: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2a20: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2a30: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2a40: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
2a50: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
2a60: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
2a70: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
2a80: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2a90: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2aa0: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
2ab0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 d_out"]. }.
2ac0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
2ad0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
2ae0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
2af0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
2b00: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2b10: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
2b20: 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 rverKey 8828 \]"
2b30: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2b40: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
2b50: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
2b60: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
2b70: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
2b80: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2b90: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
2ba0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2bb0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2bc0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
2bd0: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
2be0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2bf0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
2c00: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
2c10: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
2c20: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
2c30: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
2c40: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
2c50: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
2c60: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2c70: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
2c80: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
2c90: 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 8828} msg]} {.
2ca0: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 set x $ms
2cb0: 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 g. } else {.
2cc0: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
2cd0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
2ce0: 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 close $msg.
2cf0: 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 }. lappend
2d00: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2d10: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2d20: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
2d30: 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 {}}..if [info e
2d40: 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 xists port] {.
2d50: 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c incr port.} el
2d60: 73 65 20 7b 0a 20 20 20 20 73 65 74 20 70 6f 72 se {. set por
2d70: 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 t [expr {$tlsSer
2d80: 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 verPort + [pid]%
2d90: 31 30 32 34 7d 5d 0a 7d 0a 0a 74 65 73 74 20 74 1024}].}..test t
2da0: 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f lsIO-2.2 {tcp co
2db0: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c nnection with cl
2dc0: 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 ient port specif
2dd0: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
2de0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
2df0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
2e00: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
2e10: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
2e20: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
2e30: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
2e40: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2e50: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
2e60: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
2e70: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
2e80: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
2e90: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
2ea0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
2eb0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
2ec0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
2ed0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
2ee0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
2ef0: 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 20 5c serverKey 8829 \
2f00: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
2f10: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
2f20: 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ock addr port} {
2f30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f . glo
2f40: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
2f50: 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 puts "[gets $s
2f60: 6f 63 6b 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 ock] $port".
2f70: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
2f80: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
2f90: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
2fa0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
2fb0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
2fc0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
2fd0: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
2fe0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
2ff0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3000: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3010: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3020: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 gets $f x. g
3030: 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 lobal port. i
3040: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3050: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 socket -myport $
3060: 70 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c port \..-certfil
3070: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3080: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3090: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
30a0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
30b0: 38 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 829} sock]} {.
30c0: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
30d0: 6b 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 k..catch {close
30e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
30f0: 2e 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 .0.0.1 8829]}.
3100: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
3110: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
3120: 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b llo..flush $sock
3130: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
3140: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
3150: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3160: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3170: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
3180: 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c [list ready "hel
3190: 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 lo $port"]..test
31a0: 20 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 tlsIO-2.3 {tcp
31b0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
31c0: 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 client interface
31d0: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
31e0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
31f0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3200: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3210: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3220: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
3230: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
3240: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
3250: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
3260: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
3270: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3280: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3290: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
32a0: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
32b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
32c0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
32d0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
32e0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
32f0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3300: 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 8830 \]". pu
3310: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
3320: 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 cept {sock addr
3330: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
3340: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
3350: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
3360: 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 gets $sock] $add
3370: 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 r". c
3380: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3390: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
33a0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
33b0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
33c0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
33d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
33e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
33f0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3400: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3410: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3420: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
3430: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
3440: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
3450: 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 yaddr 127.0.0.1
3460: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
3470: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3480: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3490: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
34a0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 127.0.0.1 8830}
34b0: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
34c0: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
34d0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
34e0: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
34f0: 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 lo..catch {flush
3500: 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 $sock}.
3510: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
3520: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
3530: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3540: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3550: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 et x.} {ready {h
3560: 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d ello 127.0.0.1}}
3570: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 ..test tlsIO-2.4
3580: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
3590: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
35a0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
35b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
35c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
35d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
35e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
35f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3600: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3610: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
3620: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3630: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3640: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3650: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3660: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3670: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3680: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3690: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
36a0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
36b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
36c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
36d0: 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b verKey -myaddr [
36e0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
36f0: 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 831 \]". puts
3700: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
3710: 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f pt {sock addr po
3720: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
3730: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
3740: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
3750: 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 ts $sock]".
3760: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
3770: 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 ck. s
3780: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
3790: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
37a0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
37b0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
37c0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
37d0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
37e0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
37f0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3800: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3810: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
3820: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3830: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
3840: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
3850: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
3860: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
3870: 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d ey [info hostnam
3880: 65 5d 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 e] 8831} sock]}
3890: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
38a0: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
38b0: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
38c0: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
38d0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
38e0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
38f0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3900: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3910: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3920: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3930: 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ello}..test tlsI
3940: 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 O-2.5 {tcp conne
3950: 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e ction with redun
3960: 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 dant server port
3970: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3980: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3990: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
39a0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
39b0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
39c0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
39d0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
39e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
39f0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3a00: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3a10: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3a20: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3a30: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3a40: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3a50: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3a60: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3a70: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3a80: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3a90: 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a verKey 8832 \]".
3aa0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3ab0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
3ac0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
3ad0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3ae0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
3af0: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3b00: 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 ]". c
3b10: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3b20: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3b30: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3b40: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3b50: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3b60: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3b70: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3b80: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3b90: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3ba0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3bb0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
3bc0: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
3bd0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 {tls::socket -c
3be0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
3bf0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3c00: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
3c10: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
3c20: 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d .0.1 8832} sock]
3c30: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
3c40: 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c x $sock. } el
3c50: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
3c60: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
3c70: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
3c80: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
3c90: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
3ca0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3cb0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3cc0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3cd0: 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 hello}.test tls
3ce0: 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e IO-2.6 {tcp conn
3cf0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d ection} {socket}
3d00: 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 {. set statu
3d10: 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 s ok. if {![c
3d20: 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b atch {set sock [
3d30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
3d40: 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0.0.1 8833]}]} {
3d50: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 ..if {![catch {g
3d60: 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 ets $sock}]} {..
3d70: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 set status b
3d80: 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 roken..}..close
3d90: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3da0: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
3db0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 .test tlsIO-2.7
3dc0: 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e {echo server, on
3dd0: 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 e line} {socket
3de0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3df0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3e00: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3e10: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3e20: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
3e30: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
3e40: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
3e50: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
3e60: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
3e70: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
3e80: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
3e90: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
3ea0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
3eb0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
3ec0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
3ed0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
3ee0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
3ef0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
3f00: 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 4 \]". puts $
3f10: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3f20: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
3f30: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
3f40: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
3f50: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
3f60: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3f70: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
3f80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3f90: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
3fa0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
3fb0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
3fd0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
3ff0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
4000: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
4010: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4020: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
4030: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
4040: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
4050: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
4060: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
4070: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
4080: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
4090: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
40a0: 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a e $f..puts done.
40b0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
40c0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
40d0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
40e0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
40f0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
4100: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
4110: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4120: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4130: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4140: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4150: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
4160: 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 66 .0.1 8834]. f
4170: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
4180: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
4190: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
41a0: 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 puts $s "hello
41b0: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
41c0: 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 ". after 1000
41d0: 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 . set x [gets
41e0: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
41f0: 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 s. set y [get
4200: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
4210: 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 $f. list $x $
4220: 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 y.} {{hello abcd
4230: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f efghijklmnop} do
4240: 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ne}..test tlsIO-
4250: 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.8 {echo server
4260: 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c , loop 50 times,
4270: 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 single connecti
4280: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
4290: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b o} {. set f [
42a0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
42b0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
42c0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
42d0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
42e0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
42f0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4300: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
4310: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
4320: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4330: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
4340: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
4350: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4360: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
4370: 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 y 8835 \]". p
4380: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
4390: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
43b0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
43c0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
43d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
43e0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
43f0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
4400: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
4410: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
4420: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
4430: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
4440: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
4450: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
4480: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
4490: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
44a0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
44c0: 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 se { ..
44d0: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
44e0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
44f0: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
4500: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 }..}..set i 0..p
4510: 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 uts ready..set t
4520: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
4530: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
4540: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
4550: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
4560: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 lose $f..puts "d
4570: 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 one $i". }.
4580: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4590: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
45a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
45b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
45c0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
45d0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
45e0: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
45f0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4600: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4610: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4620: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 ey 127.0.0.1 883
4630: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 5]. fconfigur
4640: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
4650: 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b line. catch {
4660: 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 ..for {set x 0}
4670: 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 {$x < 50} {incr
4680: 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 x} {.. puts $
4690: 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 s "hello abcdefg
46a0: 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 hijklmnop"..
46b0: 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d gets $s..}. }
46c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
46d0: 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b catch {set x [
46e0: 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c gets $f]}. cl
46f0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
4700: 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 .} {done 50}..te
4710: 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f st tlsIO-2.9 {so
4720: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
4730: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
4740: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4750: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4760: 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 ccept 8828].
4770: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
4780: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
4790: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
47a0: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
47b0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
47c0: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
47d0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b -nonewline $f {
47e0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
47f0: 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b e tls..tls::sock
4800: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4810: 74 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 20 20 t 8828. }.
4820: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4830: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
4840: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
4850: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
4860: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
4870: 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 after 100.
4880: 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 set x [list [cat
4890: 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 ch {close $f} ms
48a0: 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 g] [string range
48b0: 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 20 $msg 0 43]].
48c0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
48d0: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
48e0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
48f0: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4900: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
4910: 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 lsIO-2.10 {close
4920: 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 on accept, acce
4930: 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 pted socket live
4940: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
4950: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
4960: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
4970: 72 20 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 20000 "set don
4980: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
4990: 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 set ss [tls::s
49a0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
49b0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
49c0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
49d0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
49e0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
49f0: 79 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 y 8830]. proc
4a00: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
4a10: 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c {..global ss..cl
4a20: 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 ose $ss..fileeve
4a30: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
4a40: 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e readit $s"..fcon
4a50: 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 figure $s -trans
4a60: 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 lf. }. pr
4a70: 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a oc readit {s} {.
4a80: 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 .global done..ge
4a90: 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a ts $s..close $s.
4aa0: 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 .set done 1.
4ab0: 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c }. set cs [tl
4ac0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
4ad0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
4ae0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4af0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
4b00: 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 entKey [info hos
4b10: 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 tname] 8830].
4b20: 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 close $cs..
4b30: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
4b40: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
4b50: 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a er. set done.
4b60: 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d } 1..test tlsIO-
4b70: 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 2.11 {detecting
4b80: 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 new data} {socke
4b90: 74 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 t} {. proc ac
4ba0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
4bb0: 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 global sock..# w
4bc0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
4bd0: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
4be0: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
4bf0: 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 sides need..# t
4c00: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
4c10: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
4c20: 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d ndshake. Also m
4c30: 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 ake sure..# to r
4c40: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
4c50: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
4c60: 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 ing mode...fconf
4c70: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
4c80: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
4c90: 6c 69 6e 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 line..set sock $
4ca0: 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 s..fileevent $s
4cb0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 readable [list d
4cc0: 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a o_handshake $s].
4cd0: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 }.. set s
4ce0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
4cf0: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
4d00: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
4d10: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
4d20: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
4d30: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 34 le $serverKey 84
4d40: 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 00]. set sock
4d50: 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b "". set s2 [
4d60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
4d70: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
4d80: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4d90: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
4da0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
4db0: 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 23 20 77 .1 8400]. # w
4dc0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
4dd0: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
4de0: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
4df0: 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 sides need.
4e00: 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 # to be non-bloc
4e10: 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 king for the TLS
4e20: 20 68 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f handshake Also
4e30: 20 6d 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 make sure to.
4e40: 20 20 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 # return the c
4e50: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
4e60: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 uffering mode (T
4e70: 4c 53 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e LS sets it to 'n
4e80: 6f 6e 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 one').. fconf
4e90: 69 67 75 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b igure $s2 -block
4ea0: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
4eb0: 20 6c 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 line. vwait
4ec0: 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 sock. puts $s
4ed0: 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 2 one. flush
4ee0: 24 73 32 0a 20 20 20 20 23 20 6e 65 65 64 20 75 $s2. # need u
4ef0: 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 pdate to complet
4f00: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
4f10: 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 in-process. u
4f20: 70 64 61 74 65 0a 20 20 20 20 61 66 74 65 72 20 pdate. after
4f30: 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 500. fconfigu
4f40: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4f50: 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 ng 0. set res
4f60: 75 6c 74 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 ult a:[gets $soc
4f70: 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 k]. lappend r
4f80: 65 73 75 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 esult b:[gets $s
4f90: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
4fa0: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4fb0: 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 ing 1. puts $
4fc0: 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 s2 two. flush
4fd0: 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 $s2. fconfig
4fe0: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4ff0: 69 6e 67 20 31 0a 20 20 20 20 6c 61 70 70 65 6e ing 1. lappen
5000: 64 20 72 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 d result c:[gets
5010: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e $sock]. fcon
5020: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
5030: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f ocking 1. clo
5040: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
5050: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
5060: 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 ock. set resu
5070: 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 lt.} {a:one b: c
5080: 3a 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 :two}..test tlsI
5090: 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e O-2.12 {tcp conn
50a0: 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 ection; no certi
50b0: 66 69 63 61 74 65 73 20 73 70 65 63 69 66 69 65 ficates specifie
50c0: 64 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 74 d} \..{socket st
50d0: 64 69 6f 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a dio unixOnly} {.
50e0: 20 20 20 20 23 20 54 68 65 72 65 20 69 73 20 61 # There is a
50f0: 20 64 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e debug assertion
5100: 20 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 on Windows/SSL
5110: 74 68 61 74 20 63 61 75 73 65 73 20 61 20 63 72 that causes a cr
5120: 61 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 ash when the.
5130: 20 23 20 63 65 72 74 69 66 69 63 61 74 65 20 69 # certificate i
5140: 73 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a sn't specified..
5150: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5160: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5170: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5180: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
5190: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
51a0: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
51b0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
51c0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
51d0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
51e0: 20 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 2000 "set x tim
51f0: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 ed_out"]..set f
5200: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
5210: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 rver accept 8828
5220: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
5230: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
5240: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
5250: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
5260: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
5270: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 e $file..}..puts
5280: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
5290: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
52a0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
52b0: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
52c0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
52d0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
52e0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
52f0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5300: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
5310: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
5320: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 {tls::socket 127
5330: 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 .0.0.1 8828} msg
5340: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
5350: 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c x $msg. } el
5360: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 se {. lap
5370: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
5380: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
5390: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 msg. }. la
53a0: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
53b0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
53c0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
53d0: 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 y done {}}..test
53e0: 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b tlsIO-3.1 {sock
53f0: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
5400: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
5410: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
5420: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
5430: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
5440: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
5450: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
5460: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
5470: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
5480: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
5490: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
54a0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
54b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
54c0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
54d0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
54e0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
54f0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
5500: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
5510: 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a f {..puts ready.
5520: 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f .gets stdin..clo
5530: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
5540: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5550: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5560: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5570: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
5580: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
5590: 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 set x [list [c
55a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
55b0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
55c0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
55d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
55e0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
55f0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
5600: 72 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d r accept 8828} m
5610: 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 sg] \...$msg].
5620: 20 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 puts $f bye.
5630: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
5640: 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 et x.} {1 {could
5650: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5660: 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 address already
5670: 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 in use}}..test
5680: 74 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 tlsIO-3.2 {serve
5690: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
56a0: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
56b0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
56c0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
56d0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
56e0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
56f0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
5700: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
5710: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
5720: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
5730: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 ire tls..set t1
5740: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
5750: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5760: 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 .set t2 [after 3
5770: 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 1000 "set x time
5780: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 d_out"]..set t3
5790: 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 [after 32000 "se
57a0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
57b0: 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 .set counter 0.
57c0: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
57d0: 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 "set s \[tls::s
57e0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
57f0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
5800: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
5810: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5820: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
5830: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
5840: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
5850: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
5860: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
5870: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
5880: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
5890: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
58a0: 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 ring line..}..pr
58b0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
58c0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
58d0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
58e0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
58f0: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
5900: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
5910: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
5920: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5930: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5940: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
5950: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
5960: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
5970: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
5980: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
5990: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
59a0: 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 cel $t1..vwait x
59b0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
59c0: 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t2..vwait x..aft
59d0: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 er cancel $t3..c
59e0: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 lose $s..puts $x
59f0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
5a00: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
5a10: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5a20: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5a30: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5a40: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d set x [gets $f]
5a50: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
5a60: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5a70: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5a80: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5a90: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5aa0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5ab0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
5ac0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5ad0: 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s1 -buffering l
5ae0: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b ine. set s2 [
5af0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5b00: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5b10: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5b20: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5b30: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
5b40: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
5b50: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
5b60: 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e re $s2 -bufferin
5b70: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
5b80: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
5b90: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5ba0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
5bb0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5bc0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
5bd0: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
5be0: 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 8828]. fconf
5bf0: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
5c00: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
5c10: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
5c20: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
5c30: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
5c40: 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 o,tlsIO-3.2,s1..
5c50: 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 gets $s1..puts $
5c60: 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 s2 hello,tlsIO-3
5c70: 2e 32 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a .2,s2..gets $s2.
5c80: 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c .puts $s3 hello,
5c90: 74 6c 73 49 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 tlsIO-3.2,s3..ge
5ca0: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
5cb0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
5cc0: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
5cd0: 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 se $s3. lappe
5ce0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
5cf0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5d00: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
5d10: 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f one}..test tlsIO
5d20: 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 -4.1 {server wit
5d30: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
5d40: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
5d50: 7d 20 7b 0a 20 20 20 20 23 20 68 61 76 65 20 73 } {. # have s
5d60: 65 65 6e 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 een intermittent
5d70: 20 68 61 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 hangs on Window
5d80: 73 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 s. removeFile
5d90: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5da0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
5db0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
5dc0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
5dd0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
5de0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
5df0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
5e00: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 ..gets stdin.
5e10: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
5e20: 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set s \[tls::soc
5e30: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
5e40: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5e50: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5e60: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
5e70: 37 2e 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 7.0.0.1 8828 \]"
5e80: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5e90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
5ea0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 uffering line..f
5eb0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
5ec0: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
5ed0: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
5ee0: 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 hello.. gets
5ef0: 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a $s..}..close $s.
5f00: 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 .puts bye..gets
5f10: 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 stdin. }.
5f20: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5f30: 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p1 [open "|[lis
5f40: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5f50: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5f60: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5f70: 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 e $p1 -buffering
5f80: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 line. set p2
5f90: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5fa0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5fb0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5fc0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5fd0: 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p2 -buffering li
5fe0: 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f ne. set p3 [o
5ff0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6000: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6010: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
6020: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 fconfigure $p3
6030: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
6040: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6050: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
6060: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
6070: 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 ing line..fileev
6080: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
6090: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
60a0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 }. proc ec
60b0: 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ho {s} {..global
60c0: 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c x. set l
60d0: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
60e0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
60f0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 {. c
6100: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
6110: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
6120: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
6130: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
6140: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d $s $l. }
6150: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
6160: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
6170: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6180: 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 ]. set t2 [af
6190: 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 ter 31000 "set x
61a0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
61b0: 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 set t3 [after 3
61c0: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
61d0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
61e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
61f0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
6200: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6210: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6220: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6230: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
6240: 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 ccept 8828].
6250: 70 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 puts $p1 open.
6260: 20 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a puts $p2 open.
6270: 20 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 puts $p3 ope
6280: 6e 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 n. vwait x.
6290: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 vwait x. vw
62a0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
62b0: 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 cancel $t1. a
62c0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a fter cancel $t2.
62d0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
62e0: 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 $t3. close $
62f0: 73 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 s. set l "".
6300: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
6310: 73 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d st p1 [gets $p1]
6320: 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $x]. lappend
6330: 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 l [list p2 [get
6340: 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c s $p2] $x]. l
6350: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
6360: 33 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 3 [gets $p3] $x]
6370: 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 . puts $p1 by
6380: 65 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 e. puts $p2 b
6390: 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 ye. puts $p3
63a0: 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 bye. close $p
63b0: 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 1. close $p2.
63c0: 20 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 close $p3.
63d0: 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 set l.} {{p1 b
63e0: 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 ye done} {p2 bye
63f0: 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 done} {p3 bye d
6400: 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 one}}..test tlsI
6410: 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-4.2 {byte orde
6420: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
6430: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
6440: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
6450: 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 set x ok. i
6460: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
6470: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
6480: 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d odo 0x3000} msg]
6490: 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a } {..set x $msg.
64a0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
64b0: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
64c0: 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 set x.} ok..t
64d0: 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 est tlsIO-5.1 {b
64e0: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
64f0: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
6500: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
6510: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
6520: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
6530: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
6540: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6550: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
6560: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
6570: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
6580: 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 0x1} msg]} {.
6590: 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e set x {hton
65a0: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
65b0: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
65c0: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
65d0: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
65e0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
65f0: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
6600: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
6610: 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c t owner}.test tl
6620: 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 sIO-5.2 {byte or
6630: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
6640: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
6650: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
6660: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
6670: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
6680: 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f port number too
6690: 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 high}. if {!
66a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
66b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
66c0: 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 0x10000} msg]}
66d0: 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 {..set x {port r
66e0: 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 esolution proble
66f0: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6700: 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 allowed}..close
6710: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
6720: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
6730: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
6740: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
6750: 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 gh}.test tlsIO-5
6760: 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .3 {byte order p
6770: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
6780: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
6790: 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f \..{socket unixO
67a0: 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 nly notRoot} {.
67b0: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
67c0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
67d0: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 not owner}. i
67e0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a f {![catch {tls:
67f0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6800: 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b dodo 21} msg]} {
6810: 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 ..set x {htons p
6820: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
6830: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
6840: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
6850: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
6860: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6870: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
6880: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6890: 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 wner}..test tlsI
68a0: 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 O-6.1 {accept ca
68b0: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
68c0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
68d0: 20 20 20 23 20 54 68 65 72 65 20 69 73 20 61 20 # There is a
68e0: 64 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 debug assertion
68f0: 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 on Windows/SSL t
6900: 68 61 74 20 63 61 75 73 65 73 20 61 20 63 72 61 hat causes a cra
6910: 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 sh when the.
6920: 23 20 63 65 72 74 69 66 69 63 61 74 65 20 69 73 # certificate is
6930: 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 n't specified..
6940: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
6950: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
6960: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
6970: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
6980: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
6990: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
69a0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
69b0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
69c0: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 s..gets stdin.
69d0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
69e0: 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 [list tls::socke
69f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6a00: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 t 127.0.0.1 8848
6a10: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
6a20: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6a30: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6a40: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6a50: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 t]" r+]. proc
6a60: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a bgerror args {.
6a70: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
6a80: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
6a90: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6aa0: 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 a p} {expr 10 /
6ab0: 30 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 0}. set s [tl
6ac0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6ad0: 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 r accept \..
6ae0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
6af0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
6b00: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6b10: 73 65 72 76 65 72 4b 65 79 20 38 38 34 38 5d 0a serverKey 8848].
6b20: 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c puts $f hell
6b30: 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 o. close $f.
6b40: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6b50: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
6b60: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6b70: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
6b80: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6b90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6ba0: 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 rename bgerror
6bb0: 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 {}. set x.}
6bc0: 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f {{divide by zero
6bd0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 }}..test tlsIO-7
6be0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .1 {testing sock
6bf0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6c00: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ons} {socket std
6c10: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
6c20: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
6c30: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
6c40: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
6c50: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
6c60: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
6c70: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
6c80: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
6c90: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
6ca0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 uts $f [list tls
6cb0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6cc0: 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d accept \.. -
6cd0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6ce0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6cf0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6d00: 65 72 76 65 72 4b 65 79 20 38 38 32 30 5d 0a 20 erverKey 8820].
6d10: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
6d20: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
6d30: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
6d40: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
6d50: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
6d60: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
6d70: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
6d80: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
6d90: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
6da0: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
6db0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6dc0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6dd0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6de0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6df0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
6e00: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6e10: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
6e20: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
6e30: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6e40: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
6e50: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
6e60: 2e 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 .0.0.1 8820].
6e70: 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 set p [fconfigu
6e80: 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d re $s -peername]
6e90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6ea0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6eb0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
6ec0: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f end l [string co
6ed0: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 mpare [lindex $p
6ee0: 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 0] 127.0.0.1].
6ef0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
6f00: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
6f10: 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d ndex $p 2] 8820]
6f20: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6f30: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 llength $p].} {0
6f40: 20 30 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 0 3}..test tlsI
6f50: 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 O-7.2 {testing s
6f60: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
6f70: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
6f80: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
6f90: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
6fa0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
6fb0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
6fc0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
6fd0: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
6fe0: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
6ff0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
7000: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
7010: 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a puts $f "tls::
7020: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
7030: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
7040: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7050: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7060: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7070: 38 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 8821". puts $
7080: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
7090: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
70a0: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
70b0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
70c0: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
70d0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
70e0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
70f0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
7100: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
7110: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
7120: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
7130: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
7140: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
7150: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
7160: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
7170: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
7180: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
7190: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
71a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
71b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
71c0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
71d0: 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 21]. set p [f
71e0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
71f0: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ckname]. clos
7200: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
7210: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
7220: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
7230: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 ength $p]. la
7240: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
7250: 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e $p 0]. lappen
7260: 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 d l [string equa
7270: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 l [lindex $p 2]
7280: 38 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 8821].} {3 127.0
7290: 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c .0.1 0}..test tl
72a0: 73 49 4f 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-7.3 {testing
72b0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
72c0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
72d0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
72e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
72f0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7300: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7310: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7320: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
7330: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
7340: 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 822]. set l [
7350: 6c 6c 65 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 llength [fconfig
7360: 75 72 65 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f ure $s]]. clo
7370: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 se $s. update
7380: 0a 20 20 20 20 23 20 41 20 62 75 67 20 66 69 78 . # A bug fix
7390: 65 64 20 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 ed in fconfigure
73a0: 20 66 6f 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 for 8.3.4+ make
73b0: 20 74 68 69 73 20 72 65 74 75 72 6e 20 31 34 20 this return 14
73c0: 6e 6f 72 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 normally,. #
73d0: 62 75 74 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 but 12 in older
73e0: 76 65 72 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 versions.. ex
73f0: 70 72 20 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 pr {$l >= 12 &&
7400: 28 28 24 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d (($l % 2) == 0)}
7410: 0a 7d 20 31 0a 0a 23 20 62 75 67 20 72 65 70 6f .} 1..# bug repo
7420: 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 rt #5812 fconfig
7430: 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 ure doesn't retu
7440: 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 rn value for '-s
7450: 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 ockname'..test t
7460: 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e lsIO-7.4 {testin
7470: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
7480: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
7490: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 et} {. set s
74a0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
74b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
74c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
74d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
74e0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
74f0: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
7500: 38 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 8823]. proc a
7510: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7520: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
7530: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
7540: 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 -sockname]..clos
7550: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $s. }. s
7560: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
7570: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7580: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
7590: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
75a0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
75b0: 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 \. .[info hos
75c0: 74 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 tname] 8823].
75d0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
75e0: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
75f0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
7600: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
7610: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
7620: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
7630: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
7640: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
7650: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 nd l [lindex $x
7660: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 2] [llength $x].
7670: 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 } {8823 3}..# bu
7680: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
7690: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
76a0: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
76b0: 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a or '-sockname'..
76c0: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b test tlsIO-7.5 {
76d0: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
76e0: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
76f0: 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 {socket unixOrP
7700: 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b c} {. set s [
7710: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
7720: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
7730: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
7740: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7750: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
7760: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
7770: 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 8829]. pro
7780: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
7790: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
77a0: 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t x [fconfigure
77b0: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 $s -sockname]..c
77c0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
77d0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
77e0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
77f0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
7800: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7810: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
7820: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
7830: 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 7.0.0.1 8829].
7840: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
7850: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
7860: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
7870: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
7880: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
7890: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
78a0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
78b0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
78c0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 end l [lindex $x
78d0: 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 0] [lindex $x 2
78e0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
78f0: 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 {127.0.0.1 8829
7900: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
7910: 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 8.1 {testing -as
7920: 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b ync flag on sock
7930: 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ets} {socket} {.
7940: 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 # NOTE: This
7950: 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f test may fail o
7960: 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 n some Solaris 2
7970: 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 20 20 .4 systems..
7980: 23 20 53 65 65 20 6e 6f 74 65 73 20 69 6e 20 54 # See notes in T
7990: 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 73 74 cl's socket.test
79a0: 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 .. set s [tls
79b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
79c0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
79d0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
79e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
79f0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
7a00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7a10: 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 8830]. proc a
7a20: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7a30: 09 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 68 65 .global x..# whe
7a40: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
7a50: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
7a60: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
7a70: 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 ides need..# to
7a80: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
7a90: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
7aa0: 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b shake. Also mak
7ab0: 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 e sure..# to ret
7ac0: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
7ad0: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
7ae0: 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 g mode...fconfig
7af0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
7b00: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
7b10: 6e 65 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a ne..puts $s bye.
7b20: 09 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 4c 20 .# Only OpenSSL
7b30: 30 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 6f 77 0.9.5a on Window
7b40: 73 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 64 20 s seems to need
7b50: 74 68 65 20 61 66 74 65 72 20 28 64 65 6c 61 79 the after (delay
7b60: 65 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 62 75 ed)..# close, bu
7b70: 74 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 74 20 t it works just
7b80: 74 68 65 20 73 61 6d 65 20 66 6f 72 20 61 6c 6c the same for all
7b90: 20 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 73 0a others. -hobbs.
7ba0: 09 61 66 74 65 72 20 35 30 30 20 63 6c 6f 73 65 .after 500 close
7bb0: 20 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a $s..set x done.
7bc0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
7bd0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7be0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7bf0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7c00: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7c10: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7c20: 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 5b 69 6e .. -async [in
7c30: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
7c40: 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 6f 0]. # when do
7c50: 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 ing an in-proces
7c60: 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 s client/server
7c70: 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 test, both sides
7c80: 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 need. # to b
7c90: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
7ca0: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
7cb0: 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 hake Also make
7cc0: 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 65 sure to. # re
7cd0: 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c turn the channel
7ce0: 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 to line bufferi
7cf0: 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 ng mode (TLS set
7d00: 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e s it to 'none').
7d10: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
7d20: 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s1 -blocking 0
7d30: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7d40: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
7d50: 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e # TLS handshakin
7d60: 67 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 74 65 g needs one byte
7d70: 20 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 6e 74 from the client
7d80: 2e 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 73 31 .... puts $s1
7d90: 20 61 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 a. # need up
7da0: 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 date to complete
7db0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 TLS handshake i
7dc0: 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 n-process. up
7dd0: 64 61 74 65 0a 20 20 20 20 73 65 74 20 7a 20 5b date. set z [
7de0: 67 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c gets $s1]. cl
7df0: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
7e00: 20 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d $s1. set z.}
7e10: 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f bye..test tlsIO
7e20: 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 -9.1 {testing sp
7e30: 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b urious events} {
7e40: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
7e50: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
7e60: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
7e70: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
7e80: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
7e90: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
7ea0: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
7eb0: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
7ec0: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
7ed0: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
7ee0: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
7ef0: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
7f00: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
7f10: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
7f20: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
7f30: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
7f40: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
7f50: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
7f60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
7f70: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7f80: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
7f90: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 -blocking 0..fi
7fa0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7fb0: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
7fc0: 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 dshake $s readab
7fd0: 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a le readlittle \.
7fe0: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e ..-buffering non
7ff0: 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 e]. }. set
8000: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8010: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8020: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
8030: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8040: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
8050: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
8060: 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 accept 8831].
8070: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8080: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8090: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
80a0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
80b0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
80c0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 tKey \.. [inf
80d0: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 o hostname] 8831
80e0: 5d 0a 20 20 20 20 23 20 54 68 69 73 20 64 69 66 ]. # This dif
80f0: 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b 65 74 fers from socket
8100: 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 62 6f 74 -9.1 in that bot
8110: 68 20 73 69 64 65 73 20 6e 65 65 64 20 74 6f 20 h sides need to
8120: 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 6c 6f be. # non-blo
8130: 63 6b 69 6e 67 20 62 65 63 61 75 73 65 20 6f 66 cking because of
8140: 20 54 4c 53 27 20 72 65 71 75 69 72 65 64 20 68 TLS' required h
8150: 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 63 6f andshake. fco
8160: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 nfigure $c -bloc
8170: 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 king 0. puts
8180: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 -nonewline $c 01
8190: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
81a0: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
81b0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
81c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 . close $c.
81d0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
81e0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
81f0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
8200: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
8210: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
8220: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
8230: 24 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 $s. list $spu
8240: 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 rious $len.} {0
8250: 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 50}..test tlsIO-
8260: 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 9.2 {testing asy
8270: 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 nc write, fileev
8280: 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 ents, flush on c
8290: 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b lose} {socket} {
82a0: 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 62 6c . set firstbl
82b0: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
82c0: 61 74 20 61 20 33 31 5d 0a 20 20 20 20 73 65 74 at a 31]. set
82d0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 secondblock [st
82e0: 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 ring repeat b 65
82f0: 35 33 35 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 535]. proc ac
8300: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8310: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8320: 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 locking 0..filee
8330: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
8340: 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 [list do_handsh
8350: 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 ake $s readable
8360: 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 2d 74 72 readable \...-tr
8370: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
8380: 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 2d ffersize 16384 -
8390: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a buffering line].
83a0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
83b0: 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 eadable {s} {..s
83c0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
83d0: 64 70 75 74 73 20 22 67 6f 74 20 5c 22 5b 73 74 dputs "got \"[st
83e0: 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 6c 20 ring replace $l
83f0: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8400: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8410: 67 74 68 20 24 6c 5d 29 20 66 72 6f 6d 20 24 73 gth $l]) from $s
8420: 22 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 "..fileevent $s
8430: 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 readable {}..aft
8440: 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 er 1000 respond
8450: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f $s. }. pro
8460: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
8470: 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f .global firstblo
8480: 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e 64 20 ck..dputs "send
8490: 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 \"[string replac
84a0: 65 20 24 66 69 72 73 74 62 6c 6f 63 6b 20 31 30 e $firstblock 10
84b0: 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a end-3 ...]\" \.
84c0: 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 ..([string lengt
84d0: 68 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d 29 20 h $firstblock])
84e0: 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d down $s"..puts -
84f0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 nonewline $s $fi
8500: 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 72 20 rstblock..after
8510: 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 1000 writedata $
8520: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
8530: 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b writedata {s} {
8540: 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 ..global secondb
8550: 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e lock..dputs "sen
8560: 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c d \"[string repl
8570: 61 63 65 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b ace $secondblock
8580: 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 10 end-3 ...]\"
8590: 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 \...([string le
85a0: 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 6c 6f 63 ngth $secondbloc
85b0: 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 k]) down $s"..pu
85c0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
85d0: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 $secondblock..c
85e0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
85f0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8600: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8610: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
8620: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8630: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
8640: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
8650: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 32 rver accept 8832
8660: 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 ]. set c [tls
8670: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8680: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
8690: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
86a0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
86b0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
86c0: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
86d0: 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 8832]. fconf
86e0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
86f0: 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d ng 0 -trans lf -
8700: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
8710: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
8720: 20 20 20 70 75 74 73 20 24 63 20 68 65 6c 6c 6f puts $c hello
8730: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
8740: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
8750: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 ount done..set d
8760: 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 ata [read $s]..d
8770: 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b 73 74 puts "read \"[st
8780: 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 64 61 ring replace $da
8790: 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ta 10 end-3 ...]
87a0: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
87b0: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 20 66 length $data]) f
87c0: 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 6f rom $s"..incr co
87d0: 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 unt [string leng
87e0: 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b th $data]..if {[
87f0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
8800: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
8810: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
8820: 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 }. fileevent
8830: 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $c readable "rea
8840: 64 69 74 20 24 63 22 0a 20 20 20 20 73 65 74 20 dit $c". set
8850: 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 done 0. set t
8860: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
8870: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
8880: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
8890: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
88a0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
88b0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
88c0: 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e list $count $don
88d0: 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 e.} {65566 1}..t
88e0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 est tlsIO-9.3 {t
88f0: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
8900: 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 yness} {unexplai
8910: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
8920: 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 t} {. # HOBBS
8930: 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 : never worked c
8940: 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 70 72 6f orrectly. pro
8950: 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b c count_to_eof {
8960: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
8970: 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 nt done timer..s
8980: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
8990: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
89a0: 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a . incr count.
89b0: 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 . if {$count
89c0: 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 > 9} {...close $
89d0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 s...set done tru
89e0: 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 e...set count {e
89f0: 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 of is sticky}...
8a00: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
8a10: 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 mer.. }..}.
8a20: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d }. proc tim
8a30: 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f erproc {} {..glo
8a40: 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 bal done count c
8a50: 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
8a60: 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 .set count {time
8a70: 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 r went off, eof
8a80: 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 is not sticky}..
8a90: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a close $c. }..
8aa0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a set count 0.
8ab0: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c set done fal
8ac0: 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 se. proc writ
8ad0: 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d e_then_close {s}
8ae0: 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a {..puts $s bye.
8af0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
8b00: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
8b10: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
8b20: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
8b30: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
8b40: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
8b50: 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 n lf..fileevent
8b60: 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 $s writable [lis
8b70: 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 t do_handshake $
8b80: 73 20 77 72 69 74 61 62 6c 65 20 77 72 69 74 65 s writable write
8b90: 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 _then_close \...
8ba0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
8bb0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d -translation lf]
8bc0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8bd0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8be0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8bf0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
8c00: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8c10: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8c20: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
8c30: 63 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 cept 8833]. s
8c40: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
8c50: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
8c60: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
8c70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8c80: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
8c90: 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 ey \.. [info
8ca0: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 33 5d 0a hostname] 8833].
8cb0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8cc0: 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 c -blocking 0 -b
8cd0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
8ce0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
8cf0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
8d00: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 eadable "count_t
8d10: 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 o_eof $c". se
8d20: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
8d30: 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 000 timerproc].
8d40: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
8d50: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
8d60: 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 et count.} {eof
8d70: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f is sticky}..remo
8d80: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 veFile script..t
8d90: 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b est tlsIO-10.1 {
8da0: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 testing socket a
8db0: 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 ccept callback e
8dc0: 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b rror handling} {
8dd0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
8de0: 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 t goterror 0.
8df0: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
8e00: 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 gs {global goter
8e10: 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f ror; set goterro
8e20: 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b r 1}. set s [
8e30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 tls::socket -caf
8e40: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 73 65 72 ile $caCert -ser
8e50: 76 65 72 20 61 63 63 65 70 74 20 38 38 39 38 5d ver accept 8898]
8e60: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
8e70: 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 {s a p} {close
8e80: 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 $s; error}. s
8e90: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
8ea0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8eb0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 t 127.0.0.1 8898
8ec0: 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 ]. vwait gote
8ed0: 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 rror. close $
8ee0: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 s. close $c.
8ef0: 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a set goterror.
8f00: 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d } 1..test tlsIO-
8f10: 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 11.1 {tcp connec
8f20: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f tion} {socket do
8f30: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8f40: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
8f50: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
8f60: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
8f70: 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 et socket9_1_tes
8f80: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
8f90: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
8fa0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
8fb0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8fc0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8fd0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8fe0: 65 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 ey 8834]..proc a
8ff0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
9000: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9010: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
9020: 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c $s done.. cl
9030: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
9040: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
9050: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9060: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9070: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9080: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9090: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
90a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
90b0: 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 834]. set r [
90c0: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
90d0: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
90e0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
90f0: 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 cket9_1_test_ser
9100: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d ver}. set r.}
9110: 20 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 done..test tlsI
9120: 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 O-11.2 {client s
9130: 70 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 pecifies its por
9140: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
9150: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9160: 65 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 er} {. if {[i
9170: 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d nfo exists port]
9180: 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 } {..incr port.
9190: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
91a0: 20 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 6c port [expr {$tl
91b0: 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 sServerPort + [p
91c0: 69 64 5d 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d id]%1024}]. }
91d0: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
91e0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
91f0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9200: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
9210: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
9220: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
9230: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
9240: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9250: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9260: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 5d $serverKey 8835]
9270: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
9280: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
9290: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
92a0: 20 20 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 puts $s $p..
92b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
92c0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
92d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
92e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
92f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9300: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9310: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9320: 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f . -myport $po
9330: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
9340: 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 IP 8835]. set
9350: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
9360: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
9370: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9380: 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 $socket9_2_test
9390: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 _server}. if
93a0: 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a {$r == $port} {.
93b0: 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 .set result ok.
93c0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
93d0: 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 result broken.
93e0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 }. set res
93f0: 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 ult.} ok..test t
9400: 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e lsIO-11.3 {tryin
9410: 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f g to connect, no
9420: 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 server} {socket
9430: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9440: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9450: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
9460: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
9470: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
9480: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9490: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
94a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
94b0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
94c0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
94d0: 65 53 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d eServerIp 8836]}
94e0: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
94f0: 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a h {gets $s}]} {.
9500: 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
9510: 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 broken..}..close
9520: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
9530: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
9540: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b est tlsIO-11.4 {
9550: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 remote echo, one
9560: 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 line} {socket d
9570: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9580: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
9590: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
95a0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
95b0: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 set socket10_6_t
95c0: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
95d0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
95e0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
95f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9600: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
9610: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
9620: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 r accept 8836]..
9630: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
9640: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
9650: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
9660: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
9670: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
9680: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
9690: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
96a0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
96b0: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
96c0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
96d0: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
96e0: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
96f0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
9700: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
9710: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
9720: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
9730: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
9740: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9750: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9760: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9770: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9780: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9790: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
97a0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
97b0: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
97c0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
97d0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
97e0: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
97f0: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
9800: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
9810: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9820: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
9830: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
9840: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 set r.} hello..t
9850: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b est tlsIO-11.5 {
9860: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 remote echo, 50
9870: 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 lines} {socket d
9880: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9890: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
98a0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
98b0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
98c0: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 set socket10_7_t
98d0: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
98e0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
98f0: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
9900: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9910: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9920: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9930: 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 rKey 8836]..proc
9940: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
9950: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
9960: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 shake $s.. fi
9970: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
9980: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
9990: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
99a0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
99b0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
99c0: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
99d0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
99e0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
99f0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
9a00: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
9a10: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
9a20: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
9a30: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
9a40: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
9a50: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9a60: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9a70: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9a80: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9a90: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9aa0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
9ab0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9ac0: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
9ad0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
9ae0: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
9af0: 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c t cnt 0} {$cnt <
9b00: 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 50} {incr cnt}
9b10: 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c {..puts $f "hell
9b20: 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 o, $cnt"..if {[s
9b30: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 tring compare [g
9b40: 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 ets $f] "hello,
9b50: 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 $cnt"] != 0} {..
9b60: 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 break..}.
9b70: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
9b80: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9b90: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
9ba0: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _7_test_server}.
9bb0: 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 set cnt.} 50
9bc0: 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f ..# Macintosh so
9bd0: 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d ckets can have m
9be0: 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 ore than one ser
9bf0: 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 ver per port.if
9c00: 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 {$tcl_platform(p
9c10: 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 latform) == "mac
9c20: 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 intosh"} {. s
9c30: 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c et conflictResul
9c40: 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 t {0 8836}.} els
9c50: 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 e {. set conf
9c60: 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 lictResult {1 {c
9c70: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
9c80: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
9c90: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a eady in use}}.}.
9ca0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 .test tlsIO-11.6
9cb0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
9cc0: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
9cd0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9ce0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 er} {. set s1
9cf0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9d00: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9d10: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9d20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9d30: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
9d40: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
9d50: 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 69 cept 8836]. i
9d60: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 f {[catch {set s
9d70: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
9d80: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9d90: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
9da0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9db0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
9dc0: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
9dd0: 63 63 65 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 ccept 8836]} msg
9de0: 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 ]} {..set result
9df0: 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 [list 1 $msg].
9e00: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
9e10: 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 result [list 0
9e20: 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 [lindex [fconfig
9e30: 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d ure $s2 -socknam
9e40: 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 e] 2]]..close $s
9e50: 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 2. }. clos
9e60: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 e $s1. set re
9e70: 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 sult.} $conflict
9e80: 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 Result..test tls
9e90: 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 IO-11.7 {server
9ea0: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
9eb0: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ents} {socket do
9ec0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9ed0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9ee0: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9ef0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9f00: 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 et socket10_9_te
9f10: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9f20: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
9f30: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9f40: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9f50: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9f60: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
9f70: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
9f80: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9f90: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
9fa0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
9fb0: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
9fc0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9fd0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
9fe0: 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 ]..}..proc echo
9ff0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
a000: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
a010: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a020: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a030: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
a040: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
a050: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
a060: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a070: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a080: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
a090: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a0a0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
a0b0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
a0c0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
a0d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d fconfigure $s1 -
a0e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
a0f0: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
a100: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
a110: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a120: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a130: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a140: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a150: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a160: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
a170: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
a180: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
a190: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
a1a0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a1b0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a1c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a1d0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a1e0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a1f0: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
a200: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
a210: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a220: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
a230: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
a240: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
a250: 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 s1 hello,tlsIO-1
a260: 31 2e 37 2c 73 31 0a 09 67 65 74 73 20 24 73 31 1.7,s1..gets $s1
a270: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
a280: 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 32 0a 09 ,tlsIO-11.7,s2..
a290: 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 gets $s2..puts $
a2a0: 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 s3 hello,tlsIO-1
a2b0: 31 2e 37 2c 73 33 0a 09 67 65 74 73 20 24 73 33 1.7,s3..gets $s3
a2c0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
a2d0: 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s1. close $
a2e0: 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 s2. close $s3
a2f0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a300: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
a310: 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0_9_test_server}
a320: 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 . set i.} 100
a330: 20 20 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f ..test tlsIO
a340: 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 -11.8 {client wi
a350: 74 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 th several serve
a360: 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 rs} {socket doTe
a370: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
a380: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
a390: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
a3a0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 ndCommand {..tls
a3b0: 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 ::init -certfile
a3c0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
a3d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a3e0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
a3f0: 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 ..set s1 [tls::s
a400: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
a410: 63 63 65 70 74 20 34 30 30 33 22 20 34 30 30 33 ccept 4003" 4003
a420: 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a ]..set s2 [tls::
a430: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 socket -server "
a440: 61 63 63 65 70 74 20 34 30 30 34 22 20 34 30 30 accept 4004" 400
a450: 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 4]..set s3 [tls:
a460: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
a470: 22 61 63 63 65 70 74 20 34 30 30 35 22 20 34 30 "accept 4005" 40
a480: 30 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 05]..proc handsh
a490: 61 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 ake {s mp} {..
a4a0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
a4b0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
a4c0: 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 } elseif {[cat
a4d0: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
a4e0: 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 ke $s} result]}
a4f0: 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 {...# Some error
a500: 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 s are normal...
a510: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 } elseif {$re
a520: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 sult == 1} {...#
a530: 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c Handshake compl
a540: 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 ete...fileevent
a550: 24 73 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 $s readable ""..
a560: 09 70 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 .puts $s $mp...c
a570: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 lose $s.. }..
a580: 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b }..proc accept {
a590: 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 mp s a p} {..
a5a0: 20 23 20 54 68 65 73 65 20 68 61 76 65 20 74 6f # These have to
a5b0: 20 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 accept non-bloc
a5c0: 6b 69 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 king, because th
a5d0: 65 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 e handshaking..
a5e0: 20 20 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 # order isn't
a5f0: 20 64 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 deterministic..
a600: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
a610: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 s -blocking 0 -b
a620: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
a630: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
a640: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 readable [list h
a650: 61 6e 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d andshake $s $mp]
a660: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c ..}. }. tl
a670: 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c s::init -certfil
a680: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
a690: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a6a0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
a6b0: 79 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c y. set s1 [tl
a6c0: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
a6d0: 65 53 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a eServerIP 4003].
a6e0: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
a6f0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
a700: 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 erverIP 4004].
a710: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
a720: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a730: 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 verIP 4005].
a740: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
a750: 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 pend l [gets $s1
a760: 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f ] [gets $s1] [eo
a770: 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 f $s1] [gets $s2
a780: 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f ] [gets $s2] [eo
a790: 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 f $s2] \..[gets
a7a0: 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 $s3] [gets $s3]
a7b0: 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c [eof $s3]. cl
a7c0: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
a7d0: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
a7e0: 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s3. sendComm
a7f0: 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 and {..close $s1
a800: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f ..close $s2..clo
a810: 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 se $s3. }.
a820: 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b set l.} {4003 {
a830: 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 } 1 4004 {} 1 40
a840: 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 05 {} 1}..test t
a850: 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 lsIO-11.9 {accep
a860: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
a870: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
a880: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
a890: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b r} {. set s [
a8a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
a8b0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
a8c0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
a8d0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a8e0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
a8f0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
a900: 70 74 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f pt 8836]. pro
a910: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
a920: 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 {expr 10 / 0}.
a930: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
a940: 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 args {..global x
a950: 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 ..set x $args.
a960: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 }. sendCert
a970: 56 61 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b Values. if {[
a980: 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 catch {sendComma
a990: 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 nd {.. set pe
a9a0: 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 ername [fconfigu
a9b0: 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 re $callerSocket
a9c0: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 -peername]..
a9d0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a9e0: 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 ket \... -cer
a9f0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
aa00: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
aa10: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
aa20: 6e 74 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c ntKey \... [l
aa30: 69 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 index $peername
aa40: 30 5d 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 0] 8836].. cl
aa50: 6f 73 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 ose $s. . }}
aa60: 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 msg]} {..close $
aa70: 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 s..error $msg.
aa80: 20 20 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 }. set time
aa90: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
aaa0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
aab0: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
aac0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
aad0: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
aae0: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
aaf0: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
ab00: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
ab10: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c zero}}..test tl
ab20: 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 sIO-11.10 {testi
ab30: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
ab40: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
ab50: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
ab60: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
ab70: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
ab80: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
ab90: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
aba0: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
abb0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
abc0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
abd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
abe0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
abf0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
ac00: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
ac10: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
ac20: 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 t {s a p} {close
ac30: 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s}. }. s
ac40: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
ac50: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
ac60: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
ac70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ac80: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
ac90: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
aca0: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
acb0: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
acc0: 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 igure $s -peerna
acd0: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 me]. set n [f
ace0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
acf0: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 ckname]. set
ad00: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
ad10: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d l [lindex $p 2]
ad20: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c [llength $p] [l
ad30: 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 length $p]. c
ad40: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
ad50: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
ad60: 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 socket10_12_test
ad70: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
ad80: 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d 0a l.} {8836 3 3}.
ad90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
ada0: 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 1 {testing spuri
adb0: 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 ous events} {soc
adc0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
add0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
ade0: 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 # remote equi
adf0: 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 20 valent of 9.1.
ae00: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
ae10: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
ae20: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f 74 {..set socket_t
ae30: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
ae40: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
ae50: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
ae60: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
ae70: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
ae80: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
ae90: 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 rKey 8836]..proc
aea0: 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b handshake {s} {
aeb0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
aec0: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
aed0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b .. } elseif {
aee0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e [catch {tls::han
aef0: 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c dshake $s} resul
af00: 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 t]} {...# Some e
af10: 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c rrors are normal
af20: 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 ... } elseif
af30: 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b {$result == 1} {
af40: 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 ...# Handshake c
af50: 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 omplete...fileev
af60: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
af70: 22 22 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 ""...after 100 w
af80: 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 ritesome $s..
af90: 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 }..}..proc acce
afa0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
afb0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
afc0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 -translation "au
afd0: 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 to lf".. file
afe0: 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c event $s writabl
aff0: 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b e [list handshak
b000: 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 e $s]..}..proc w
b010: 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 ritesome {s} {..
b020: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
b030: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
b040: 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 cr i} {...puts $
b050: 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 s "line $i from
b060: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 remote server"..
b070: 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 }.. close
b080: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
b090: 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 set len 0. s
b0a0: 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 et spurious 0.
b0b0: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
b0c0: 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 proc readlittle
b0d0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
b0e0: 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e purious done len
b0f0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b100: 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 1]..if {[string
b110: 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 length $l] == 0
b120: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 } {.. if {![e
b130: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 of $s]} {...incr
b140: 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d spurious.. }
b150: 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 else {...close
b160: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a $s...set done 1.
b170: 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b . }..} else {
b180: 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b .. incr len [
b190: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
b1a0: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 ]..}. }. s
b1b0: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
b1c0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
b1d0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
b1e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b1f0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
b200: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
b210: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
b220: 20 20 20 20 23 20 47 65 74 20 74 68 65 20 62 75 # Get the bu
b230: 66 66 65 72 69 6e 67 20 63 6f 72 72 65 63 74 65 ffering correcte
b240: 64 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 d. fconfigure
b250: 20 24 63 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $c -buffering l
b260: 69 6e 65 0a 20 20 20 20 23 20 50 75 74 20 61 20 ine. # Put a
b270: 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 63 6c byte into the cl
b280: 69 65 6e 74 20 70 69 70 65 20 74 6f 20 74 72 69 ient pipe to tri
b290: 67 67 65 72 20 54 4c 53 20 68 61 6e 64 73 68 61 gger TLS handsha
b2a0: 6b 69 6e 67 0a 20 20 20 20 70 75 74 73 20 24 63 king. puts $c
b2b0: 20 61 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 a. fileevent
b2c0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $c readable [li
b2d0: 73 74 20 72 65 61 64 6c 69 74 74 6c 65 20 24 63 st readlittle $c
b2e0: 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ]. set timer
b2f0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
b300: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
b310: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
b320: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
b330: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
b340: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
b350: 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 $socket_test_se
b360: 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 rver}. list $
b370: 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 spurious $len.}
b380: 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 {0 2690}..test t
b390: 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 lsIO-11.12 {test
b3a0: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
b3b0: 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ss} {unexplained
b3c0: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 Failure socket d
b3d0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
b3e0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 Server} {. #
b3f0: 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e remote equivalen
b400: 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 t of 9.3. # H
b410: 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b OBBS: never work
b420: 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 ed correctly.
b430: 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 set counter 0.
b440: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
b450: 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 proc count_up
b460: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
b470: 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 unter done after
b480: 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 _id..set l [gets
b490: 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $s]..if {[eof $
b4a0: 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 s]} {.. incr
b4b0: 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 counter.. if
b4c0: 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b {$counter > 9} {
b4d0: 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 ...set done {EOF
b4e0: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
b4f0: 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 ter cancel $afte
b500: 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a r_id...close $s.
b510: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
b520: 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f proc timed_o
b530: 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 ut {} {..global
b540: 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 c done..set done
b550: 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 {timed_out, EOF
b560: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
b570: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a .close $c. }.
b580: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
b590: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
b5a0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
b5b0: 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 10_14_test_serve
b5c0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
b5d0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
b5e0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
b5f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b600: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
b610: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
b620: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
b630: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
b640: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
b650: 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 $s.. after 1
b660: 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 00 close $s..}.
b670: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b }. set c [
b680: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
b690: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
b6a0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
b6b0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b6c0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
b6d0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
b6e0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 rIP 8836]. fi
b6f0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
b700: 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 ble "count_up $c
b710: 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 5f ". set after_
b720: 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 id [after 1000 t
b730: 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 imed_out]. vw
b740: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e ait done. sen
b750: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
b760: 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 $socket10_14_tes
b770: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
b780: 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 t done.} {EOF is
b790: 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 sticky}..test t
b7a0: 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 lsIO-11.13 {test
b7b0: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
b7c0: 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 async flush, as
b7d0: 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 ync close} \..{s
b7e0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
b7f0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
b800: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
b810: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
b820: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c ount done..set l
b830: 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 [read $s]..incr
b840: 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c count [string l
b850: 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b ength $l]..if {[
b860: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
b870: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
b880: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
b890: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
b8a0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
b8b0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 mand {..set firs
b8c0: 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 tblock [string r
b8d0: 65 70 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 epeat a 31]..set
b8e0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 secondblock [st
b8f0: 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 ring repeat b 65
b900: 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 535]..set l [tls
b910: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
b920: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
b930: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
b940: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
b950: 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 verKey \...-serv
b960: 65 72 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a er accept 8845].
b970: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
b980: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
b990: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
b9a0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
b9b0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
b9c0: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
b9d0: 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c ffersize 16384 \
b9e0: 0a 09 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e ... -bufferin
b9f0: 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 g line.. file
ba00: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
ba10: 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a e "readable $s".
ba20: 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c .}..proc readabl
ba30: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 e {s} {.. set
ba40: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
ba50: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
ba60: 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 eadable {}..
ba70: 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f after 1000 respo
ba80: 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 nd $s..}..proc r
ba90: 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 espond {s} {..
baa0: 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c global firstbl
bab0: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
bac0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 onewline $s $fir
bad0: 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 stblock.. aft
bae0: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
baf0: 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 a $s..}..proc wr
bb00: 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 itedata {s} {..
bb10: 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 global second
bb20: 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 block.. puts
bb30: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 -nonewline $s $s
bb40: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 econdblock..
bb50: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
bb60: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
bb70: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
bb80: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
bb90: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
bba0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
bbb0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
bbc0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
bbd0: 20 38 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 8845]. fconf
bbe0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
bbf0: 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f ng 0 -translatio
bc00: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
bc10: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 line. set cou
bc20: 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 nt 0. puts $s
bc30: 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 hello. filee
bc40: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
bc50: 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 "readit $s".
bc60: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
bc70: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
bc80: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
bc90: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
bca0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
bcb0: 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d imer. sendCom
bcc0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a mand {close $l}.
bcd0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
bce0: 36 35 35 36 36 0a 0a 70 72 6f 63 20 67 65 74 64 65566..proc getd
bcf0: 61 74 61 20 7b 74 79 70 65 20 66 69 6c 65 7d 20 ata {type file}
bd00: 7b 0a 20 20 20 20 23 20 52 65 61 64 20 68 61 6e {. # Read han
bd10: 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 dler on the acce
bd20: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 20 20 20 pted socket..
bd30: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 67 6c global x. gl
bd40: 6f 62 61 6c 20 66 61 69 6c 65 64 0a 20 20 20 20 obal failed.
bd50: 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 set status [catc
bd60: 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 h {read $file} d
bd70: 61 74 61 5d 0a 20 20 20 20 69 66 20 7b 24 73 74 ata]. if {$st
bd80: 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 73 65 atus != 0} {..se
bd90: 74 20 78 20 22 72 65 61 64 20 66 61 69 6c 65 64 t x "read failed
bda0: 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 , error was $dat
bdb0: 61 22 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 a"..catch { clos
bdc0: 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 e $file }. }
bdd0: 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 elseif {[string
bde0: 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 compare {} $data
bdf0: 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 ]} {. } elsei
be00: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
be10: 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 le]} {. } els
be20: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
be30: 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 6c 65 64 } {..if {$failed
be40: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 } {.. set x "
be50: 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 $type socket was
be60: 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d 20 65 inherited"..} e
be70: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
be80: 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 "$type socket w
be90: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
bea0: 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c "..}..catch { cl
beb0: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 ose $file }.
bec0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 78 20 } else {..set x
bed0: 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 {impossible case
bee0: 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 }..catch { close
bef0: 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 $file }. }.
bf00: 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 return.}..tes
bf10: 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 t tlsIO-12.1 {te
bf20: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
bf30: 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b e of server sock
bf40: 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 ets} {socket exe
bf50: 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c c} {. makeFil
bf60: 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 e {} script1.
bf70: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
bf80: 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 ipt2.. # Scri
bf90: 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 pt1 is just a 10
bfa0: 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 second delay.
bfb0: 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f If the server so
bfc0: 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e cket. # is in
bfd0: 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c herited, it will
bfe0: 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f be held open fo
bff0: 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 r 10 seconds..
c000: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c010: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
c020: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
c030: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
c040: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
c050: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
c060: 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 65 # Script2 create
c070: 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 s the server soc
c080: 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 ket, launches sc
c090: 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 ript1,. # wai
c0a0: 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 ts a second, and
c0b0: 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 exits. The ser
c0c0: 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 ver socket will
c0d0: 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f now. # be clo
c0e0: 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 sed unless scrip
c0f0: 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e t1 inherited it.
c100: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c110: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
c120: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
c130: 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 et tclsh $::tclt
c140: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
c150: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c160: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
c170: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
c180: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
c190: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
c1a0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
c1b0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c1c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
c1d0: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
c1e0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
c1f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c200: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
c210: 4b 65 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 Key 8828\]".
c220: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
c230: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 accept { file ad
c240: 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 dr port } {..
c250: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
c260: 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 .exec $tclsh scr
c270: 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 ipt1 &..close $f
c280: 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 ..after 1000 exi
c290: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
c2a0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c2b0: 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 $f.. # Launc
c2c0: 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 h script2 and wa
c2d0: 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 it 5 seconds..
c2e0: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
c2f0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
c300: 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 t2 &. after 5
c310: 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 000 { set ok_to_
c320: 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 proceed 1 }.
c330: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
c340: 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 eed.. # If we
c350: 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 can still conne
c360: 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 ct to the server
c370: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 , the socket got
c380: 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 inherited...
c390: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
c3a0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
c3b0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
c3c0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c3d0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
c3e0: 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 ntKey \. . 127
c3f0: 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 .0.0.1 8828} msg
c400: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 ]} {..set x {ser
c410: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
c420: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 ot inherited}.
c430: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
c440: 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 e $msg..set x {s
c450: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
c460: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
c470: 7d 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }.. set x.} {
c480: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
c490: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
c4a0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e ..test tlsIO-12.
c4b0: 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 2 {testing inher
c4c0: 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 itance of client
c4d0: 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 sockets} {socke
c4e0: 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 t exec} {. ma
c4f0: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
c500: 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 1. makeFile {
c510: 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 } script2.. #
c520: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
c530: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
c540: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
c550: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
c560: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
c570: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
c580: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
c590: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
c5a0: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
c5b0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
c5c0: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
c5d0: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c5e0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c5f0: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f . # Script2 o
c600: 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 pens the client
c610: 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 socket and write
c620: 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 s to it. It the
c630: 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 n. # launches
c640: 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 script1 and exi
c650: 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c ts. If the chil
c660: 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 d process inheri
c670: 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c ted the. # cl
c680: 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 ient socket, the
c690: 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 socket will sti
c6a0: 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 ll be open...
c6b0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c6c0: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
c6d0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
c6e0: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
c6f0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
c700: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
c710: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
c720: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
c730: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
c740: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
c750: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
c760: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
c770: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
c780: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c790: 43 65 72 74 20 5c 0a 09 20 20 20 20 2d 6b 65 79 Cert \.. -key
c7a0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
c7b0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5c 5d 127.0.0.1 8829\]
c7c0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
c7d0: 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 .exec $tclsh scr
c7e0: 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 ipt1 &..puts $f
c7f0: 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 testing..flush $
c800: 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 f..after 1000 ex
c810: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
c820: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c830: 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 e $f.. # Crea
c840: 74 65 20 74 68 65 20 73 65 72 76 65 72 20 73 6f te the server so
c850: 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 cket.. set se
c860: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
c870: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
c880: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
c890: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
c8a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
c8b0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
c8c0: 72 20 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 r accept 8829].
c8d0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
c8e0: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
c8f0: 7d 20 7b 0a 09 23 20 57 68 65 6e 20 74 68 65 20 } {..# When the
c900: 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c client connects,
c910: 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 establish the r
c920: 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f ead handler..glo
c930: 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 bal server..clos
c940: 65 20 24 73 65 72 76 65 72 0a 09 66 63 6f 6e 66 e $server..fconf
c950: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 6c 6f igure $file -blo
c960: 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 cking 0..fileeve
c970: 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c nt $file readabl
c980: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 e [list do_hands
c990: 68 61 6b 65 20 24 66 69 6c 65 20 72 65 61 64 61 hake $file reada
c9a0: 62 6c 65 20 5c 0a 09 09 5b 6c 69 73 74 20 67 65 ble \...[list ge
c9b0: 74 64 61 74 61 20 63 6c 69 65 6e 74 5d 20 2d 62 tdata client] -b
c9c0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 uffering line]..
c9d0: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 return. }..
c9e0: 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 # If the socke
c9f0: 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e t doesn't hit en
ca00: 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 d-of-file in 5 s
ca10: 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 econds, the.
ca20: 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 # script1 proces
ca30: 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 s must have inhe
ca40: 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 rited the client
ca50: 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 ... set faile
ca60: 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 d 0. after 50
ca70: 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 00 [list set fai
ca80: 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 led 1].. # La
ca90: 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 unch the script2
caa0: 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 process.. ex
cab0: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
cac0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 cltest script2 &
cad0: 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 .. vwait x.
cae0: 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 if {!$failed}
caf0: 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a {..vwait failed.
cb00: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
cb10: 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 } {client socket
cb20: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
cb30: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
cb40: 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.3 {testing in
cb50: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 heritance of acc
cb60: 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c epted sockets} \
cb70: 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 63 20 75 ..{socket exec u
cb80: 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d nixOnly} {. m
cb90: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
cba0: 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 t1. makeFile
cbb0: 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 {} script2..
cbc0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
cbd0: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
cbe0: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
cbf0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
cc00: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
cc10: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 close $f.. se
cc20: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
cc30: 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 2 w]. puts $f
cc40: 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 [list set tclsh
cc50: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
cc60: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
cc70: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
cc80: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
cc90: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
cca0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
ccb0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
ccc0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
ccd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
cce0: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
ccf0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
cd00: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
cd10: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
cd20: 20 24 73 65 72 76 65 72 4b 65 79 20 38 39 33 30 $serverKey 8930
cd30: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
cd40: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
cd50: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
cd60: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
cd70: 74 63 6c 73 68 0a 09 20 20 20 20 66 63 6f 6e 66 tclsh.. fconf
cd80: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 igure $file -buf
cd90: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
cda0: 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 puts $file {tes
cdb0: 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 t data on socket
cdc0: 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 6c }.. exec $tcl
cdd0: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 sh script1 &..
cde0: 20 20 61 66 74 65 72 20 31 30 30 30 20 65 78 69 after 1000 exi
cdf0: 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 t..}..vwait fore
ce00: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
ce10: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 ose $f.. # La
ce20: 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 unch the script2
ce30: 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e process and con
ce40: 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 nect to it. See
ce50: 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 how long. #
ce60: 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 the socket stays
ce70: 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 open.. exec
ce80: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
ce90: 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 est script2 &..
cea0: 20 20 20 61 66 74 65 72 20 32 30 30 30 20 73 65 after 2000 se
ceb0: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
cec0: 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 1. vwait ok_t
ced0: 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 o_proceed.. s
cee0: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
cef0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
cf00: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
cf10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
cf20: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
cf30: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
cf40: 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 0.1 8930]. fc
cf50: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 onfigure $f -buf
cf60: 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f fering full -blo
cf70: 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 cking 0. # We
cf80: 20 6e 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 need to put a b
cf90: 79 74 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 yte into the rea
cfa0: 64 20 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 d queue, otherwi
cfb0: 73 65 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 se the. # TLS
cfc0: 20 68 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e handshake doesn
cfd0: 27 74 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 't finish. pu
cfe0: 74 73 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 ts $f a; flush $
cff0: 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 f. fileevent
d000: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
d010: 74 20 67 65 74 64 61 74 61 20 61 63 63 65 70 74 t getdata accept
d020: 65 64 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 ed $f].. # If
d030: 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 the socket is s
d040: 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 till open after
d050: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 5 seconds, the s
d060: 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 cript1 process.
d070: 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 # must have i
d080: 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 nherited the acc
d090: 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 epted socket...
d0a0: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
d0b0: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 after 5000 s
d0c0: 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 et failed 1..
d0d0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 vwait x. set
d0e0: 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 x.} {accepted s
d0f0: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
d100: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 herited}..test t
d110: 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 73 74 69 lsIO-13.1 {Testi
d120: 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 ng use of shared
d130: 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 socket between
d140: 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 two threads} \..
d150: 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 {socket testthre
d160: 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 ad} {. # HOBB
d170: 53 3a 20 6e 65 76 65 72 20 74 65 73 74 65 64 0a S: never tested.
d180: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
d190: 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 cript. thread
d1a0: 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 Reap.. makeFi
d1b0: 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 le {. .packag
d1c0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
d1d0: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
d1e0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
d1f0: 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 8828]..proc acc
d200: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 ept {s a p} {.
d210: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 fileev
d220: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
d230: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
d240: 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 fconf
d250: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
d260: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
d270: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
d280: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c } {.. global
d290: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d2a0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
d2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
d2c0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
d2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
d2e0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
d2f0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
d300: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d310: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
d320: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
d330: 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e { .. in
d340: 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 cr i.
d350: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
d360: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
d370: 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 .}..set i 0..vwa
d380: 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a it x..close $f..
d390: 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 .# thread cleans
d3a0: 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 itself up...tes
d3b0: 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 tthread exit.
d3c0: 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 0a 20 } script. .
d3d0: 20 20 20 23 20 63 72 65 61 74 65 20 61 20 74 68 # create a th
d3e0: 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 read. set ser
d3f0: 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 verthread [testt
d400: 68 72 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 hread create { s
d410: 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d ource script } ]
d420: 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 . update.
d430: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a . after 1000.
d440: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
d450: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
d460: 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 8828]. fconf
d470: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
d480: 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 ing line.. ca
d490: 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 tch {..puts $s "
d4a0: 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 hello"..gets $s
d4b0: 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 result. }.
d4c0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 close $s. up
d4d0: 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 date.. after
d4e0: 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 2000. lappend
d4f0: 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 result [threadR
d500: 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 eap]. . se
d510: 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c t result..} {hel
d520: 6c 6f 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 lo 1}..test tlsI
d530: 4f 2d 31 34 2e 31 20 7b 74 65 73 74 20 74 6c 73 O-14.1 {test tls
d540: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 ::unimport} {soc
d550: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
d560: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 [catch {tls::uni
d570: 6d 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 mport} msg] $msg
d580: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
d590: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
d5a0: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 tls::unimport ch
d5b0: 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c annel"}}.test tl
d5c0: 73 49 4f 2d 31 34 2e 32 20 7b 74 65 73 74 20 74 sIO-14.2 {test t
d5d0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 ls::unimport} {s
d5e0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
d5f0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 t [catch {tls::u
d600: 6e 69 6d 70 6f 72 74 20 66 6f 6f 20 62 61 72 7d nimport foo bar}
d610: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
d620: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
d630: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 hould be "tls::u
d640: 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 nimport channel"
d650: 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 }}.test tlsIO-14
d660: 2e 33 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .3 {test tls::un
d670: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d680: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
d690: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 ch {tls::unimpor
d6a0: 74 20 62 6f 67 75 73 7d 20 6d 73 67 5d 20 24 6d t bogus} msg] $m
d6b0: 73 67 0a 7d 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 sg.} {1 {can not
d6c0: 20 66 69 6e 64 20 63 68 61 6e 6e 65 6c 20 6e 61 find channel na
d6d0: 6d 65 64 20 22 62 6f 67 75 73 22 7d 7d 0a 74 65 med "bogus"}}.te
d6e0: 73 74 20 74 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 st tlsIO-14.4 {t
d6f0: 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 est tls::unimpor
d700: 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 t} {socket} {.
d710: 20 20 23 20 73 74 64 69 6e 20 63 61 6e 20 74 61 # stdin can ta
d720: 6b 65 20 64 69 66 66 65 72 65 6e 74 20 6e 61 6d ke different nam
d730: 65 73 20 61 73 20 74 68 65 20 22 74 6f 70 22 20 es as the "top"
d740: 63 68 61 6e 6e 65 6c 0a 20 20 20 20 6c 69 73 74 channel. list
d750: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e [catch {tls::un
d760: 69 6d 70 6f 72 74 20 73 74 64 69 6e 7d 20 6d 73 import stdin} ms
d770: 67 5d 20 5c 0a 09 5b 73 74 72 69 6e 67 20 6d 61 g] \..[string ma
d780: 74 63 68 20 7b 62 61 64 20 63 68 61 6e 6e 65 6c tch {bad channel
d790: 20 22 2a 22 3a 20 6e 6f 74 20 61 20 54 4c 53 20 "*": not a TLS
d7a0: 63 68 61 6e 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d channel} $msg].}
d7b0: 20 7b 31 20 31 7d 0a 74 65 73 74 20 74 6c 73 49 {1 1}.test tlsI
d7c0: 4f 2d 31 34 2e 35 20 7b 74 65 73 74 20 74 6c 73 O-14.5 {test tls
d7d0: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 ::unimport} {soc
d7e0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c ket} {. set l
d7f0: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
d800: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
d810: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
d820: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
d830: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
d840: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
d850: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
d860: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
d870: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
d880: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
d890: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
d8a0: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
d8b0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
d8c0: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
d8d0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
d8e0: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
d8f0: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
d900: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
d910: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
d920: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
d930: 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 locking 0..filee
d940: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
d950: 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 [list do_handsh
d960: 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 ake $s readable
d970: 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d readlittle \...-
d980: 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a buffering none].
d990: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
d9a0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
d9b0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
d9c0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
d9d0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
d9e0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
d9f0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
da00: 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 ept 8831]. se
da10: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
da20: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
da30: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
da40: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
da50: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
da60: 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 y \.. [info h
da70: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 ostname] 8831].
da80: 20 20 20 23 20 6f 6e 6c 79 20 74 68 65 20 63 6c # only the cl
da90: 69 65 6e 74 20 67 65 74 73 20 74 6c 73 3a 3a 69 ient gets tls::i
daa0: 6d 70 6f 72 74 0a 20 20 20 20 73 65 74 20 72 65 mport. set re
dab0: 73 20 5b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 s [tls::unimport
dac0: 20 24 63 5d 0a 20 20 20 20 6c 69 73 74 20 24 72 $c]. list $r
dad0: 65 73 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 es [catch {close
dae0: 20 24 63 7d 20 65 72 72 5d 20 24 65 72 72 20 5c $c} err] $err \
daf0: 0a 09 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 ..[catch {close
db00: 24 73 7d 20 65 72 72 5d 20 24 65 72 72 0a 7d 20 $s} err] $err.}
db10: 7b 7b 7d 20 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a {{} 0 {} 0 {}}..
db20: 74 65 73 74 20 74 6c 73 2d 62 75 67 35 38 2d 31 test tls-bug58-1
db30: 2e 30 20 7b 74 65 73 74 20 70 72 6f 74 6f 63 6f .0 {test protoco
db40: 6c 20 6e 65 67 6f 74 69 61 74 69 6f 6e 20 66 61 l negotiation fa
db50: 69 6c 75 72 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 ilure} {socket}
db60: 7b 0a 20 20 20 20 23 20 46 6f 6c 6c 6f 77 69 6e {. # Followin
db70: 67 20 63 6f 64 65 20 69 73 20 62 61 73 65 64 20 g code is based
db80: 6f 6e 20 77 68 61 74 20 77 61 73 20 72 65 70 6f on what was repo
db90: 72 74 65 64 20 69 6e 20 62 75 67 20 23 35 38 2e rted in bug #58.
dba0: 20 50 72 69 6f 72 0a 20 20 20 20 23 20 74 6f 20 Prior. # to
dbb0: 66 69 78 20 74 68 65 20 70 72 6f 67 72 61 6d 20 fix the program
dbc0: 77 6f 75 6c 64 20 63 72 61 73 68 20 77 69 74 68 would crash with
dbd0: 20 61 20 73 65 67 66 61 75 6c 74 2e 0a 20 20 20 a segfault..
dbe0: 20 70 72 6f 63 20 41 63 63 65 70 74 20 7b 73 6f proc Accept {so
dbf0: 63 6b 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 20 ck args} {.
dc00: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
dc10: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 3b ock -blocking 0;
dc20: 0a 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 . fileeve
dc30: 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 62 6c nt $sock readabl
dc40: 65 20 5b 6c 69 73 74 20 48 61 6e 64 73 68 61 6b e [list Handshak
dc50: 65 20 24 73 6f 63 6b 5d 0a 20 20 20 20 7d 20 0a e $sock]. } .
dc60: 20 20 20 20 70 72 6f 63 20 48 61 6e 64 73 68 61 proc Handsha
dc70: 6b 65 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 ke {sock} {.
dc80: 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 48 set ::done H
dc90: 41 4e 44 0a 20 20 20 20 20 20 20 20 63 61 74 63 AND. catc
dca0: 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b h {tls::handshak
dcb0: 65 20 24 73 6f 63 6b 7d 20 6d 73 67 0a 20 20 20 e $sock} msg.
dcc0: 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 20 set ::done
dcd0: 24 6d 73 67 0a 20 20 20 20 7d 20 0a 20 20 20 20 $msg. } .
dce0: 23 20 4e 4f 54 45 3a 20 77 68 65 6e 20 64 6f 69 # NOTE: when doi
dcf0: 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 ng an in-process
dd00: 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 client/server t
dd10: 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 est, both sides
dd20: 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 need. # to be
dd30: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f non-blocking fo
dd40: 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 r the TLS handsh
dd50: 61 6b 65 0a 0a 20 20 20 20 23 20 53 65 72 76 65 ake.. # Serve
dd60: 72 20 2d 20 4f 6e 6c 79 20 61 63 63 65 70 74 20 r - Only accept
dd70: 54 4c 53 20 31 2e 32 0a 20 20 20 20 73 65 74 20 TLS 1.2. set
dd80: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
dd90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dda0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
ddb0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
ddc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
ddd0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
dde0: 20 20 20 20 20 20 20 20 20 20 20 2d 72 65 71 75 -requ
ddf0: 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 20 30 est 0 -require 0
de00: 20 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 -ssl2 0 -ssl3 0
de10: 20 2d 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 31 -tls1 0 -tls1.1
de20: 20 30 20 2d 74 6c 73 31 2e 32 20 31 20 5c 0a 20 0 -tls1.2 1 \.
de30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 73 -s
de40: 65 72 76 65 72 20 41 63 63 65 70 74 20 38 38 33 erver Accept 883
de50: 31 5d 0a 20 20 20 20 23 20 43 6c 69 65 6e 74 20 1]. # Client
de60: 2d 20 4f 6e 6c 79 20 70 72 6f 70 6f 73 65 20 54 - Only propose T
de70: 4c 53 31 2e 30 0a 20 20 20 20 73 65 74 20 63 20 LS1.0. set c
de80: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 61 73 [tls::socket -as
de90: 79 6e 63 20 5c 0a 20 20 20 20 20 20 20 20 20 20 ync \.
dea0: 20 20 20 20 20 2d 63 61 66 69 6c 65 20 24 63 61 -cafile $ca
deb0: 43 65 72 74 20 5c 0a 20 20 20 20 20 20 20 20 20 Cert \.
dec0: 20 20 20 20 20 20 2d 72 65 71 75 65 73 74 20 30 -request 0
ded0: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 73 73 6c -require 0 -ssl
dee0: 32 20 30 20 2d 73 73 6c 33 20 30 20 2d 74 6c 73 2 0 -ssl3 0 -tls
def0: 31 20 31 20 2d 74 6c 73 31 2e 31 20 30 20 2d 74 1 1 -tls1.1 0 -t
df00: 6c 73 31 2e 32 20 30 20 5c 0a 20 20 20 20 20 20 ls1.2 0 \.
df10: 20 20 20 20 20 20 20 20 20 5b 69 6e 66 6f 20 68 [info h
df20: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 ostname] 8831].
df30: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
df40: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
df50: 20 70 75 74 73 20 24 63 20 61 20 3b 20 66 6c 75 puts $c a ; flu
df60: 73 68 20 24 63 0a 20 20 20 20 61 66 74 65 72 20 sh $c. after
df70: 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 3a 5000 [list set :
df80: 3a 64 6f 6e 65 20 74 69 6d 65 6f 75 74 5d 0a 20 :done timeout].
df90: 20 20 20 76 77 61 69 74 20 3a 3a 64 6f 6e 65 0a vwait ::done.
dfa0: 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 0a 7d set ::done.}
dfb0: 20 7b 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c {handshake fail
dfc0: 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f ed: wrong versio
dfd0: 6e 20 6e 75 6d 62 65 72 7d 0a 0a 23 20 63 6c 65 n number}..# cle
dfe0: 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 anup.if {[string
dff0: 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f match sock* $co
e000: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 mmandSocket] ==
e010: 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 1} {. puts $co
e020: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 mmandSocket exit
e030: 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 . flush $comma
e040: 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 ndSocket.}.catch
e050: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
e060: 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 Socket}.catch {c
e070: 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 lose $remoteProc
e080: 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a Chan}.::tcltest:
e090: 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c :cleanupTests.fl
e0a0: 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 ush stdout.retur
e0b0: 6e 0a n.