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 22 2d 6d 79 61 64 msg.} {1 {"-myad
2340: 64 72 22 20 6f 70 74 69 6f 6e 20 6d 75 73 74 20 dr" option must
2350: 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 20 76 be followed by v
2360: 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 alue}}..test tls
2370: 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 73 IO-1.4 {arg pars
2380: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2390: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
23a0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
23b0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
23c0: 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e -myaddr 127.0.0.
23d0: 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 1} msg] $msg.} {
23e0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
23f0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2400: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
2410: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2420: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b test tlsIO-1.5 {
2430: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2440: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2450: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2460: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2470: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d :socket -myport}
2480: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2490: 7b 22 2d 6d 79 70 6f 72 74 22 20 6f 70 74 69 6f {"-myport" optio
24a0: 6e 20 6d 75 73 74 20 62 65 20 66 6f 6c 6c 6f 77 n must be follow
24b0: 65 64 20 62 79 20 76 61 6c 75 65 7d 7d 0a 0a 74 ed by value}}..t
24c0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 est tlsIO-1.6 {a
24d0: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
24e0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
24f0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2500: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2510: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 socket -myport x
2520: 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d xxx} msg] $msg.}
2530: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2540: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2550: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2560: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2570: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 ..test tlsIO-1.7
2580: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2590: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
25a0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
25b0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
25c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
25d0: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
25e0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
25f0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2600: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2610: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2620: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2630: 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.8 {arg parsing
2640: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2650: 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 and} -constraint
2660: 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 s {socket} -body
2670: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2680: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2690: 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d -froboz} msg] $m
26a0: 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 6c 6f 62 sg.} -match glob
26b0: 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b 62 61 64 -result {1 {bad
26c0: 20 6f 70 74 69 6f 6e 20 22 2d 66 72 6f 62 6f 7a option "-froboz
26d0: 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f ": must be one o
26e0: 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 f *}}..test tlsI
26f0: 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 72 73 69 O-1.9 {arg parsi
2700: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2710: 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 mmand} -constrai
2720: 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f nts {socket} -bo
2730: 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 dy {. list [c
2740: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2750: 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d t -server foo -m
2760: 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 33 7d yport 2521 3333}
2770: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d 61 msg] $msg.} -ma
2780: 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 75 6c 74 tch glob -result
2790: 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 6f 6e 20 {1 {bad option
27a0: 22 2d 6d 79 70 6f 72 74 22 3a 20 6d 75 73 74 20 "-myport": must
27b0: 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a 74 be one of *}}..t
27c0: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b est tlsIO-1.10 {
27d0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
27e0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
27f0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2800: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2810: 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 32 :socket host 252
2820: 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 8 -junk} msg] $m
2830: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
2840: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
2850: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
2860: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
2870: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
2880: 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 69 -1.11 {arg parsi
2890: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
28a0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
28b0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
28c0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
28d0: 73 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 server callback
28e0: 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 2520 --} msg] $m
28f0: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
2900: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
2910: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 "tls::socket -s
2920: 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f erver command ?o
2930: 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a ptions? port"}}.
2940: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 .test tlsIO-1.12
2950: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2960: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2970: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2980: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2990: 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 s::socket foo ba
29a0: 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 dport} msg] $msg
29b0: 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 20 .} {1 {expected
29c0: 69 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 20 integer but got
29d0: 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 "badport"}}..tes
29e0: 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 t tlsIO-2.1 {tcp
29f0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
2a00: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
2a10: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
2a20: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
2a30: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
2a40: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
2a50: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
2a60: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
2a70: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
2a80: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2a90: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2aa0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
2ab0: 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 _out"]. }.
2ac0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2ad0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2ae0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2af0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2b00: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2b10: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2b20: 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
2b30: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2b40: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
2b50: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
2b60: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
2b70: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
2b80: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
2b90: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
2ba0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2bb0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2bc0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
2bd0: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
2be0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2bf0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
2c00: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
2c10: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
2c20: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
2c30: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
2c40: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
2c50: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
2c60: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
2c70: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
2c80: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
2c90: 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 8828} msg]} {.
2ca0: 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 set x $msg
2cb0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
2cc0: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2cd0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2ce0: 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 close $msg.
2cf0: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
2d00: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
2d10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2d20: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
2d30: 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 {}}..if [info ex
2d40: 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 ists port] {.
2d50: 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 incr port.} els
2d60: 65 20 7b 0a 20 20 20 20 73 65 74 20 70 6f 72 74 e {. set port
2d70: 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 76 [expr {$tlsServ
2d80: 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 erPort + [pid]%1
2d90: 30 32 34 7d 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 024}].}..test tl
2da0: 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f 6e sIO-2.2 {tcp con
2db0: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 nection with cli
2dc0: 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 69 ent port specifi
2dd0: 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ed} {socket stdi
2de0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
2df0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
2e00: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
2e10: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
2e20: 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f [list set auto_
2e30: 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d path $auto_path]
2e40: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2e50: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
2e60: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2e70: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2e80: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
2e90: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
2ea0: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2eb0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2ec0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2ed0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2ee0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2ef0: 65 72 76 65 72 4b 65 79 20 38 38 32 39 20 5c 5d erverKey 8829 \]
2f00: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
2f10: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
2f20: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
2f40: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
2f50: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
2f60: 63 6b 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 ck] $port".
2f70: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
2f80: 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 ck. s
2f90: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
2fa0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2fb0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2fc0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2fd0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2fe0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2ff0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3000: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3010: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3020: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c gets $f x. gl
3030: 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 obal port. if
3040: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3050: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 ocket -myport $p
3060: 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ort \..-certfile
3070: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3080: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3090: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
30a0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
30b0: 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 29} sock]} {.
30c0: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
30d0: 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b ..catch {close [
30e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
30f0: 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 0.0.1 8829]}.
3100: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
3110: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
3120: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
3130: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
3140: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
3150: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3160: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3170: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b $f. set x.} [
3180: 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c list ready "hell
3190: 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 o $port"]..test
31a0: 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 tlsIO-2.3 {tcp c
31b0: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
31c0: 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 lient interface
31d0: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
31e0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
31f0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
3200: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
3210: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
3220: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
3230: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
3240: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
3250: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
3260: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3270: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3280: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3290: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
32a0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
32b0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
32c0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
32d0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
32e0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
32f0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3300: 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 8830 \]". put
3310: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3320: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
3330: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3340: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3350: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
3360: 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 72 ets $sock] $addr
3370: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
3380: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
3390: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
33a0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
33b0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
33c0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
33d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
33e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
33f0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3400: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3410: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3420: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
3430: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
3440: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
3450: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c addr 127.0.0.1 \
3460: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
3470: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3480: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3490: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
34a0: 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 73 27.0.0.1 8830} s
34b0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
34c0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
34d0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
34e0: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
34f0: 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 o..catch {flush
3500: 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c $sock}. l
3510: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3520: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
3530: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3540: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3550: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 t x.} {ready {he
3560: 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a llo 127.0.0.1}}.
3570: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 .test tlsIO-2.4
3580: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
3590: 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 with server inte
35a0: 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d rface specified}
35b0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
35c0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
35d0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
35e0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
35f0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
3600: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
3610: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
3620: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
3630: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3640: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
3650: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
3660: 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one"]. }.
3670: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
3680: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3690: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
36a0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
36b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
36c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
36d0: 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 6c 6f erKey -myaddr lo
36e0: 63 61 6c 68 6f 73 74 20 38 38 33 31 20 5c 5d 22 calhost 8831 \]"
36f0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3700: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 proc accept {soc
3710: 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 k addr port} {.
3720: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
3730: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
3740: 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 puts "[gets $soc
3750: 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 k]".
3760: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3770: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3780: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
3790: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
37a0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
37b0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
37c0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
37d0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
37e0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
37f0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3800: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3810: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
3820: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
3830: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
3840: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3850: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3860: 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 $clientKey loca
3870: 6c 68 6f 73 74 20 38 38 33 31 7d 20 73 6f 63 6b lhost 8831} sock
3880: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
3890: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
38a0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
38b0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
38c0: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 flush $sock.
38d0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
38e0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
38f0: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3900: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3910: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
3920: 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 y hello}..test t
3930: 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f lsIO-2.5 {tcp co
3940: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 nnection with re
3950: 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 dundant server p
3960: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ort} {socket std
3970: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3980: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3990: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
39a0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
39b0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
39c0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
39d0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
39e0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
39f0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3a00: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3a10: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3a20: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3a30: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3a40: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3a50: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3a60: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3a70: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3a80: 73 65 72 76 65 72 4b 65 79 20 38 38 33 32 20 5c serverKey 8832 \
3a90: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
3aa0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
3ab0: 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ock addr port} {
3ac0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f . glo
3ad0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
3ae0: 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 puts "[gets $s
3af0: 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 ock]".
3b00: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
3b10: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
3b20: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
3b30: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
3b40: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
3b50: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
3b60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3b70: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
3b80: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
3b90: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
3ba0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
3bb0: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
3bc0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
3bd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
3be0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
3bf0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
3c00: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
3c10: 37 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 7.0.0.1 8832} so
3c20: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
3c30: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
3c40: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
3c50: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
3c60: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
3c70: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
3c80: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
3c90: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
3ca0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3cb0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
3cc0: 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 ady hello}.test
3cd0: 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 tlsIO-2.6 {tcp c
3ce0: 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b onnection} {sock
3cf0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 et} {. set st
3d00: 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b atus ok. if {
3d10: 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 ![catch {set soc
3d20: 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 k [tls::socket 1
3d30: 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 27.0.0.1 8833]}]
3d40: 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 } {..if {![catch
3d50: 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 {gets $sock}]}
3d60: 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 {.. set statu
3d70: 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f s broken..}..clo
3d80: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3d90: 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 set status.}
3da0: 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 ok..test tlsIO-2
3db0: 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c .7 {echo server,
3dc0: 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b one line} {sock
3dd0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
3de0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
3df0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
3e00: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
3e10: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
3e20: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
3e30: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
3e40: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
3e50: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3e60: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3e70: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3e80: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3e90: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3ea0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3eb0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3ec0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3ed0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3ee0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3ef0: 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 8834 \]". put
3f00: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3f10: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 ept {s a p} {.
3f20: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 fileev
3f30: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
3f40: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
3f50: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
3f60: 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c s -translation l
3f70: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
3f80: 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f e. }..pro
3f90: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
3fa0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
3fb0: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
3fc0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fe0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
3ff0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
4000: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
4010: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
4030: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 lse {.
4040: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
4050: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
4060: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
4070: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
4080: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
4090: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 64 6f lose $f..puts do
40a0: 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ne. }. clo
40b0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
40c0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
40d0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
40e0: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
40f0: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
4100: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4110: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4120: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4130: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4140: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
4150: 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 7.0.0.1 8834].
4160: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
4170: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
4180: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
4190: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
41a0: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
41b0: 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 72 20 31 nop". after 1
41c0: 30 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 67 000. set x [g
41d0: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
41e0: 65 20 24 73 0a 20 20 20 20 73 65 74 20 79 20 5b e $s. set y [
41f0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
4200: 73 65 20 24 66 0a 20 20 20 20 6c 69 73 74 20 24 se $f. list $
4210: 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 x $y.} {{hello a
4220: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d bcdefghijklmnop}
4230: 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 done}..test tls
4240: 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 IO-2.8 {echo ser
4250: 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d ver, loop 50 tim
4260: 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 es, single conne
4270: 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 ction} {socket s
4280: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 tdio} {. set
4290: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
42a0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
42b0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
42c0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
42d0: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
42e0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
42f0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
4300: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
4310: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4320: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
4330: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4340: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4350: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4360: 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 rKey 8835 \]".
4370: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
4380: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
4390: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
43a0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
43b0: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
43c0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
43d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
43e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
43f0: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
4400: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
4410: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
4420: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
4430: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
4440: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
4450: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
4460: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
4480: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
4490: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
44a0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
44b0: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
44c0: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
44d0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
44e0: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
44f0: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
4500: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
4510: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
4520: 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 0000 "set x done
4530: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
4540: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4550: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
4560: 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d "done $i". }
4570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4580: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
4590: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
45a0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
45b0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
45c0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
45d0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
45e0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
45f0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4600: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4610: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
4620: 38 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8835]. fconfi
4630: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4640: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
4650: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
4660: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
4670: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
4680: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
4690: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
46a0: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
46b0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
46c0: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
46d0: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
46e0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
46f0: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
4700: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 .test tlsIO-2.9
4710: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
4720: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
4730: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
4740: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4750: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 r accept 8828].
4760: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4770: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4780: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4790: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
47a0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
47b0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
47c0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
47d0: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
47e0: 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 uire tls..tls::s
47f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4800: 63 65 70 74 20 38 38 32 38 0a 20 20 20 20 7d 0a cept 8828. }.
4810: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4820: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
4830: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
4840: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
4850: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
4860: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 . after 100.
4870: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
4880: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d catch {close $f}
4890: 20 6d 73 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 msg] [string ra
48a0: 6e 67 65 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a nge $msg 0 43]].
48b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
48c0: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
48d0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
48e0: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
48f0: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 dy in use}}..tes
4900: 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c t tlsIO-2.10 {cl
4910: 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 ose on accept, a
4920: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c ccepted socket l
4930: 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ives} {socket} {
4940: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
4950: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
4960: 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 fter 20000 "set
4970: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
4980: 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 . set ss [tls
4990: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
49a0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
49b0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
49c0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
49d0: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
49e0: 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 20 70 rKey 8830]. p
49f0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4a00: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a p} {..global ss.
4a10: 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 .close $ss..file
4a20: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
4a30: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 e "readit $s"..f
4a40: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
4a50: 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 ans lf. }.
4a60: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
4a70: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a {..global done.
4a80: 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 .gets $s..close
4a90: 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 $s..set done 1.
4aa0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 }. set cs
4ab0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4ac0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4ad0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4ae0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4af0: 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 clientKey localh
4b00: 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 20 63 6c ost 8830]. cl
4b10: 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 ose $cs.. vwa
4b20: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
4b30: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
4b40: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 set done.} 1
4b50: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
4b60: 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 1 {detecting new
4b70: 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 data} {socket}
4b80: 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 {. proc accep
4b90: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
4ba0: 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e bal sock..# when
4bb0: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
4bc0: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
4bd0: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
4be0: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
4bf0: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
4c00: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
4c10: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
4c20: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
4c30: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
4c40: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
4c50: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
4c60: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
4c70: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
4c80: 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 e..set sock $s..
4c90: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4ca0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
4cb0: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 andshake $s].
4cc0: 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }.. set s [t
4cd0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4ce0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 er accept \..
4cf0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
4d00: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
4d10: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
4d20: 24 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 5d $serverKey 8400]
4d30: 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 . set sock ""
4d40: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
4d50: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4d60: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4d70: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4d80: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4d90: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
4da0: 38 34 30 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 8400]. # when
4db0: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
4dc0: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
4dd0: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
4de0: 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 des need. # t
4df0: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
4e00: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
4e10: 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 ndshake Also ma
4e20: 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 ke sure to. #
4e30: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
4e40: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
4e50: 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 ering mode (TLS
4e60: 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 sets it to 'none
4e70: 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ').. fconfigu
4e80: 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 re $s2 -blocking
4e90: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
4ea0: 6e 65 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 ne. vwait soc
4eb0: 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f k. puts $s2 o
4ec0: 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 ne. flush $s2
4ed0: 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 . # need upda
4ee0: 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 te to complete T
4ef0: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d LS handshake in-
4f00: 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 process. upda
4f10: 74 65 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 te. after 500
4f20: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4f30: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4f40: 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0. set result
4f50: 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a a:[gets $sock].
4f60: 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 lappend resu
4f70: 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 6b lt b:[gets $sock
4f80: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4f90: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4fa0: 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 1. puts $s2
4fb0: 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 two. flush $s
4fc0: 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 2. fconfigure
4fd0: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4fe0: 20 31 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 1. lappend r
4ff0: 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 73 esult c:[gets $s
5000: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
5010: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
5020: 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 ing 1. close
5030: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
5040: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b . close $sock
5050: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
5060: 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 } {a:one b: c:tw
5070: 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 o}..test tlsIO-2
5080: 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 .12 {tcp connect
5090: 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 ion; no certific
50a0: 61 74 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 ates specified}
50b0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f \..{socket stdio
50c0: 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 unixOnly} {.
50d0: 20 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 # There is a de
50e0: 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e bug assertion on
50f0: 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 Windows/SSL tha
5100: 74 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 t causes a crash
5110: 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 when the. #
5120: 63 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 certificate isn'
5130: 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 t specified..
5140: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5150: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5160: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5170: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
5180: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
5190: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
51a0: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
51b0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
51c0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
51d0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
51e0: 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c out"]..set f [tl
51f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5200: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
5210: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
5220: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
5230: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
5240: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5250: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
5260: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
5270: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5280: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
5290: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
52a0: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
52b0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
52c0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
52d0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
52e0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
52f0: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
5300: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
5310: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
5320: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
5330: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
5340: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
5350: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
5360: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
5370: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
5380: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
5390: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
53a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
53b0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
53c0: 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c one {}}..test tl
53d0: 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 sIO-3.1 {socket
53e0: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
53f0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
5400: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5410: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5420: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5430: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
5440: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
5450: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
5460: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
5470: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
5480: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5490: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
54a0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
54b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
54c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
54d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
54e0: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c serverKey 8828 \
54f0: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
5500: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 ..puts ready..ge
5510: 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 ts stdin..close
5520: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
5530: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
5540: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5550: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5560: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5570: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
5580: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
5590: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c h {tls::socket \
55a0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
55b0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
55c0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
55d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
55e0: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
55f0: 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 67 5d ccept 8828} msg]
5600: 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 \...$msg]. p
5610: 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 uts $f bye. c
5620: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5630: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
5640: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
5650: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
5660: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
5670: 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 IO-3.2 {server w
5680: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
5690: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 nts} {socket std
56a0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
56b0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
56c0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
56d0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
56e0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
56f0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
5700: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5710: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
5720: 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 tls..set t1 [af
5730: 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 ter 30000 "set x
5740: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
5750: 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 t t2 [after 3100
5760: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
5770: 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 ut"]..set t3 [af
5780: 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 ter 32000 "set x
5790: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
57a0: 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 t counter 0.
57b0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
57c0: 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et s \[tls::sock
57d0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
57e0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
57f0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
5800: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5810: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
5820: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
5830: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
5840: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
5850: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
5860: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
5870: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
5880: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5890: 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 g line..}..proc
58a0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
58b0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
58c0: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
58d0: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
58e0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
58f0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
5900: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
5910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
5920: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
5930: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5950: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
5960: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
5970: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
5980: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5990: 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 $t1..vwait x..a
59a0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a fter cancel $t2.
59b0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
59c0: 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 cancel $t3..clos
59d0: 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 e $s..puts $x.
59e0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
59f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5a00: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5a10: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5a20: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 ipt]" r+]. se
5a30: 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t x [gets $f].
5a40: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
5a50: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5a60: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5a70: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5a80: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5a90: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5aa0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
5ab0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
5ac0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5ad0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
5ae0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5af0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5b00: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5b10: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5b20: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5b30: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
5b40: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5b50: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
5b60: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
5b70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5b80: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5b90: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5ba0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5bb0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
5bc0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
5bd0: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
5be0: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
5bf0: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
5c00: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
5c10: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
5c20: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 puts $s1 hello,t
5c30: 6c 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 74 lsIO-3.2,s1..get
5c40: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5c50: 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c hello,tlsIO-3.2,
5c60: 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 s2..gets $s2..pu
5c70: 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 ts $s3 hello,tls
5c80: 49 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 20 IO-3.2,s3..gets
5c90: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s3. }. cl
5ca0: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
5cb0: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
5cc0: 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $s3. lappend
5cd0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
5ce0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5cf0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
5d00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e }..test tlsIO-4.
5d10: 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 1 {server with s
5d20: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
5d30: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
5d40: 0a 20 20 20 20 23 20 68 61 76 65 20 73 65 65 6e . # have seen
5d50: 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 61 intermittent ha
5d60: 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 ngs on Windows.
5d70: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
5d80: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
5d90: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
5da0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
5db0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
5dc0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
5dd0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
5de0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
5df0: 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a ets stdin. }.
5e00: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5e10: 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s \[tls::socket
5e20: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5e30: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5e40: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5e50: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
5e60: 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 .0.1 8828 \]".
5e70: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f puts $f {..fco
5e80: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5e90: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 ering line..for
5ea0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
5eb0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
5ec0: 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
5ed0: 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a lo.. gets $s.
5ee0: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 .}..close $s..pu
5ef0: 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 ts bye..gets std
5f00: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f in. }. clo
5f10: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 se $f. set p1
5f20: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5f30: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5f40: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5f50: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5f60: 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p1 -buffering li
5f70: 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f ne. set p2 [o
5f80: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5f90: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5fa0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5fb0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 fconfigure $p2
5fc0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5fd0: 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e set p3 [open
5fe0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5ff0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6000: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
6010: 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 onfigure $p3 -bu
6020: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
6030: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6040: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
6050: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
6060: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
6070: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
6080: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
6090: 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 }. proc echo
60a0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a {s} {..global x.
60b0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
60c0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
60d0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
60e0: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
60f0: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
6100: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
6110: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
6120: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
6130: 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 $l. }.
6140: 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b }. set t1 [
6150: 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 after 30000 "set
6160: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
6170: 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 set t2 [after
6180: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
6190: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
61a0: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
61b0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
61c0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b ut"]. set s [
61d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
61e0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
61f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6200: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6210: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
6220: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
6230: 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 pt 8828]. put
6240: 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 s $p1 open. p
6250: 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 uts $p2 open.
6260: 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 puts $p3 open.
6270: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 vwait x. v
6280: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
6290: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
62a0: 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 cel $t1. afte
62b0: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 r cancel $t2.
62c0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
62d0: 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 3. close $s.
62e0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
62f0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
6300: 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 p1 [gets $p1] $x
6310: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6320: 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 [list p2 [gets $
6330: 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 p2] $x]. lapp
6340: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b end l [list p3 [
6350: 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 gets $p3] $x].
6360: 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 puts $p1 bye.
6370: 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 0a puts $p2 bye.
6380: 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 65 puts $p3 bye
6390: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 . close $p1.
63a0: 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 close $p2.
63b0: 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 close $p3. s
63c0: 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 et l.} {{p1 bye
63d0: 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f done} {p2 bye do
63e0: 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 ne} {p3 bye done
63f0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 }}..test tlsIO-4
6400: 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .2 {byte order p
6410: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
6420: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
6430: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
6440: 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b et x ok. if {
6450: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
6460: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
6470: 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0x3000} msg]} {
6480: 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 ..set x $msg.
6490: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
64a0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
64b0: 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 set x.} ok..test
64c0: 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 tlsIO-5.1 {byte
64d0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
64e0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
64f0: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
6500: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
6510: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
6520: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
6530: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
6540: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
6550: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
6560: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
6570: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
6580: 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 set x {htons p
6590: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
65a0: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
65b0: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
65c0: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
65d0: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
65e0: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
65f0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6600: 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f wner}.test tlsIO
6610: 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.2 {byte order
6620: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
6630: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
6640: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
6650: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
6660: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
6670: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
6680: 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 gh}. if {![ca
6690: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
66a0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
66b0: 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 10000} msg]} {..
66c0: 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f set x {port reso
66d0: 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 lution problem,
66e0: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
66f0: 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 owed}..close $ms
6700: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6710: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
6720: 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 en socket: port
6730: 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d number too high}
6740: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 .test tlsIO-5.3
6750: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
6760: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
6770: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 bers, htons} \..
6780: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 {socket unixOnly
6790: 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 notRoot} {.
67a0: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
67b0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
67c0: 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b owner}. if {
67d0: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
67e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
67f0: 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 o 21} msg]} {..s
6800: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
6810: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
6820: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
6830: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
6840: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
6850: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
6860: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
6870: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
6880: 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 r}..test tlsIO-6
6890: 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 .1 {accept callb
68a0: 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b ack error} {sock
68b0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
68c0: 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 # There is a deb
68d0: 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 ug assertion on
68e0: 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 Windows/SSL that
68f0: 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 causes a crash
6900: 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 when the. # c
6910: 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 ertificate isn't
6920: 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 specified..
6930: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
6940: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
6950: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
6960: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
6970: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
6980: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
6990: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
69a0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
69b0: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
69c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
69d0: 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d st tls::socket -
69e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 cafile $caCert 1
69f0: 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 5d 0a 20 27.0.0.1 8848].
6a00: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6a10: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6a20: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6a30: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6a40: 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 r+]. proc bg
6a50: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
6a60: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
6a70: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 rgs. }. pr
6a80: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6a90: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
6aa0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6ab0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6ac0: 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 ccept \.. -ce
6ad0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
6ae0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6af0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
6b00: 76 65 72 4b 65 79 20 38 38 34 38 5d 0a 20 20 20 verKey 8848].
6b10: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
6b20: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6b30: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6b40: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6b50: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6b60: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6b70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6b80: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
6b90: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
6ba0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
6bb0: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
6bc0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 .test tlsIO-7.1
6bd0: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6be0: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6bf0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
6c00: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
6c10: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
6c20: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
6c30: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
6c40: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
6c50: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
6c60: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
6c70: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6c80: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
6c90: 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 $f [list tls::s
6ca0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6cb0: 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cept \.. -cer
6cc0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
6cd0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6ce0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
6cf0: 65 72 4b 65 79 20 38 38 32 30 5d 0a 20 20 20 20 erKey 8820].
6d00: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
6d10: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
6d20: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
6d30: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
6d40: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
6d50: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6d60: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6d70: 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 out"]..vwait x..
6d80: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
6d90: 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c mer. }. cl
6da0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
6db0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
6dc0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
6dd0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
6de0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
6df0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6e00: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
6e10: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
6e20: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6e30: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
6e40: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
6e50: 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65 0.1 8820]. se
6e60: 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t p [fconfigure
6e70: 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 $s -peername].
6e80: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6e90: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6ea0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
6eb0: 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 l [string compa
6ec0: 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d re [lindex $p 0]
6ed0: 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 127.0.0.1].
6ee0: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
6ef0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
6f00: 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 x $p 2] 8820].
6f10: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 lappend l [lle
6f20: 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 ngth $p].} {0 0
6f30: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 3}..test tlsIO-7
6f40: 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .2 {testing sock
6f50: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6f60: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ons} {socket std
6f70: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
6f80: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
6f90: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
6fa0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
6fb0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
6fc0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
6fd0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
6fe0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
6ff0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
7000: 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 uts $f "tls::soc
7010: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7020: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
7030: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
7040: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7050: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
7060: 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 1". puts $f {
7070: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
7080: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
7090: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
70a0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
70b0: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
70c0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
70d0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
70e0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
70f0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
7100: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
7110: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
7120: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
7130: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
7140: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
7150: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
7160: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
7170: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
7180: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
7190: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
71a0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
71b0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 127.0.0.1 8821]
71c0: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
71d0: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
71e0: 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 ame]. close $
71f0: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 s. close $f.
7200: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
7210: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
7220: 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 th $p]. lappe
7230: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
7240: 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 0]. lappend l
7250: 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b [string equal [
7260: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 lindex $p 2] 882
7270: 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 1].} {3 127.0.0.
7280: 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 1 0}..test tlsIO
7290: 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.3 {testing so
72a0: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
72b0: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 tions} {socket}
72c0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
72d0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
72e0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
72f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7300: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7310: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
7320: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 rver accept 8822
7330: 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 6c 65 ]. set l [lle
7340: 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 72 65 ngth [fconfigure
7350: 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s]]. close
7360: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 $s. update.
7370: 20 20 23 20 41 20 62 75 67 20 66 69 78 65 64 20 # A bug fixed
7380: 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 66 6f in fconfigure fo
7390: 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 74 68 r 8.3.4+ make th
73a0: 69 73 20 72 65 74 75 72 6e 20 31 34 20 6e 6f 72 is return 14 nor
73b0: 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 75 74 mally,. # but
73c0: 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 65 72 12 in older ver
73d0: 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 72 20 sions.. expr
73e0: 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 28 24 {$l >= 12 && (($
73f0: 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 l % 2) == 0)}.}
7400: 31 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 1..# bug report
7410: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
7420: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
7430: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
7440: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
7450: 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 O-7.4 {testing s
7460: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
7470: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d ptions} {socket}
7480: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
7490: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
74a0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
74b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
74c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
74d0: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
74e0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
74f0: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
7500: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7510: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
7520: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
7530: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
7540: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
7550: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
7560: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
7570: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7580: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7590: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
75a0: 20 20 20 09 6c 6f 63 61 6c 68 6f 73 74 20 38 38 .localhost 88
75b0: 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 23]. set time
75c0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
75d0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
75e0: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
75f0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
7600: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
7610: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
7620: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
7630: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
7640: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
7650: 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 33 20 33 th $x].} {8823 3
7660: 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 }..# bug report
7670: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
7680: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
7690: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
76a0: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
76b0: 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 O-7.5 {testing s
76c0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
76d0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
76e0: 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 unixOrPc} {.
76f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
7700: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
7710: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
7720: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7730: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7740: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
7750: 65 72 20 61 63 63 65 70 74 20 38 38 32 39 5d 0a er accept 8829].
7760: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
7770: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
7780: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
7790: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
77a0: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
77b0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
77c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
77d0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
77e0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
77f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7800: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7810: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
7820: 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 829]. set tim
7830: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
7840: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
7850: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
7860: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
7870: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
7880: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
7890: 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 1. set l "".
78a0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
78b0: 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 ndex $x 0] [lind
78c0: 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $x 2] [llengt
78d0: 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 h $x].} {127.0.0
78e0: 2e 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 .1 8829 3}..test
78f0: 20 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 tlsIO-8.1 {test
7900: 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 ing -async flag
7910: 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 on sockets} {soc
7920: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 ket} {. # NOT
7930: 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 E: This test may
7940: 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f fail on some So
7950: 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d laris 2.4 system
7960: 73 2e 0a 20 20 20 20 23 20 53 65 65 20 6e 6f 74 s.. # See not
7970: 65 73 20 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b es in Tcl's sock
7980: 65 74 2e 74 65 73 74 2e 0a 20 20 20 20 73 65 74 et.test.. set
7990: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
79a0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
79b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
79c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
79d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
79e0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
79f0: 61 63 63 65 70 74 20 38 38 33 30 5d 0a 20 20 20 accept 8830].
7a00: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
7a10: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
7a20: 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 ..# when doing a
7a30: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
7a40: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
7a50: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
7a60: 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c ..# to be non-bl
7a70: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
7a80: 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 LS handshake. A
7a90: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 lso make sure..#
7aa0: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 to return the c
7ab0: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
7ac0: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 uffering mode...
7ad0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
7ae0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7af0: 72 69 6e 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 ring line..puts
7b00: 24 73 20 62 79 65 0a 09 23 20 4f 6e 6c 79 20 4f $s bye..# Only O
7b10: 70 65 6e 53 53 4c 20 30 2e 39 2e 35 61 20 6f 6e penSSL 0.9.5a on
7b20: 20 57 69 6e 64 6f 77 73 20 73 65 65 6d 73 20 74 Windows seems t
7b30: 6f 20 6e 65 65 64 20 74 68 65 20 61 66 74 65 72 o need the after
7b40: 20 28 64 65 6c 61 79 65 64 29 0a 09 23 20 63 6c (delayed)..# cl
7b50: 6f 73 65 2c 20 62 75 74 20 69 74 20 77 6f 72 6b ose, but it work
7b60: 73 20 6a 75 73 74 20 74 68 65 20 73 61 6d 65 20 s just the same
7b70: 66 6f 72 20 61 6c 6c 20 6f 74 68 65 72 73 2e 20 for all others.
7b80: 2d 68 6f 62 62 73 0a 09 61 66 74 65 72 20 35 30 -hobbs..after 50
7b90: 30 20 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 0 close $s..set
7ba0: 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 x done. }.
7bb0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
7bc0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
7bd0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
7be0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7bf0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7c00: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 61 73 ntKey \.. -as
7c10: 79 6e 63 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 ync localhost 88
7c20: 33 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 30]. # when d
7c30: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
7c40: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
7c50: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
7c60: 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 s need. # to
7c70: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
7c80: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
7c90: 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 shake Also make
7ca0: 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 sure to. # r
7cb0: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
7cc0: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
7cd0: 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 ing mode (TLS se
7ce0: 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 ts it to 'none')
7cf0: 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
7d00: 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 $s1 -blocking 0
7d10: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7d20: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
7d30: 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 # TLS handshaki
7d40: 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 74 ng needs one byt
7d50: 65 20 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 6e e from the clien
7d60: 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 73 t.... puts $s
7d70: 31 20 61 0a 20 20 20 20 23 20 6e 65 65 64 20 75 1 a. # need u
7d80: 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 pdate to complet
7d90: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
7da0: 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 in-process. u
7db0: 70 64 61 74 65 0a 20 20 20 20 66 63 6f 6e 66 69 pdate. fconfi
7dc0: 67 75 72 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 gure $s1 -blocki
7dd0: 6e 67 20 31 0a 20 20 20 20 73 65 74 20 7a 20 5b ng 1. 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 6c 6f 63 61 tKey \.. loca
80d0: 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 lhost 8831].
80e0: 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 66 # This differs f
80f0: 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 rom socket-9.1 i
8100: 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 n that both side
8110: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 s need to be.
8120: 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 # non-blocking
8130: 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 because of TLS'
8140: 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 required handsha
8150: 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ke. fconfigur
8160: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
8170: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
8180: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
8190: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
81a0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
81b0: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 0123456789. c
81c0: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
81d0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
81e0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
81f0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
8200: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
8210: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
8220: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8230: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
8240: 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 $len.} {0 50}..t
8250: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 est tlsIO-9.2 {t
8260: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
8270: 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 te, fileevents,
8280: 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 flush on close}
8290: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
82a0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
82b0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
82c0: 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 1]. set secon
82d0: 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 dblock [string r
82e0: 65 70 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 epeat b 65535].
82f0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8300: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
8310: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
8320: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
8330: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
8340: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
8350: 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 readable readab
8360: 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 le \...-translat
8370: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
8380: 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 ze 16384 -buffer
8390: 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a ing line]. }.
83a0: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
83b0: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
83c0: 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 gets $s]..dputs
83d0: 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 "got \"[string r
83e0: 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 eplace $l 10 end
83f0: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
8400: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8410: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c ]) from $s"..fil
8420: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
8430: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
8440: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
8450: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
8460: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
8470: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 l firstblock..dp
8480: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
8490: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 ing replace $fir
84a0: 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 stblock 10 end-3
84b0: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
84c0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 ring length $fir
84d0: 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 stblock]) down $
84e0: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
84f0: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
8500: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
8510: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
8520: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
8530: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
8540: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
8550: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8560: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 tring replace $s
8570: 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e econdblock 10 en
8580: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
8590: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
85a0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f secondblock]) do
85b0: 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f wn $s"..puts -no
85c0: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
85d0: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
85e0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
85f0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8600: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8610: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8620: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8630: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8640: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
8650: 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 ccept 8832].
8660: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
8670: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8680: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
8690: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
86a0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
86b0: 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c Key \.. local
86c0: 68 6f 73 74 20 38 38 33 32 5d 0a 20 20 20 20 66 host 8832]. f
86d0: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
86e0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
86f0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
8700: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
8710: 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 0. puts $c h
8720: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
8730: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
8740: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
8750: 65 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 et data [read $s
8760: 5d 0a 09 64 70 75 74 73 20 22 72 65 61 64 20 5c ]..dputs "read \
8770: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8780: 20 24 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 $data 10 end-3
8790: 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 ...]\" \...([str
87a0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 ing length $data
87b0: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 ]) from $s"..inc
87c0: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
87d0: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 length $data]..i
87e0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
87f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
8800: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
8810: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
8820: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
8830: 22 72 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 "readit $c".
8840: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
8850: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
8860: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
8870: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
8880: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
8890: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
88a0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
88b0: 20 20 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 list $count
88c0: 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 $done.} {65566 1
88d0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e }..test tlsIO-9.
88e0: 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 3 {testing EOF s
88f0: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
8900: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
8910: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 ocket} {. # H
8920: 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b OBBS: never work
8930: 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 ed correctly.
8940: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 proc count_to_e
8950: 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c of {s} {..global
8960: 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 count done time
8970: 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 r..set l [gets $
8980: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
8990: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
89a0: 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f unt.. if {$co
89b0: 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f unt > 9} {...clo
89c0: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
89d0: 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e true...set coun
89e0: 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 t {eof is sticky
89f0: 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c }...after cancel
8a00: 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 $timer.. }..
8a10: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
8a20: 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a timerproc {} {.
8a30: 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 .global done cou
8a40: 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 nt c..set done t
8a50: 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b rue..set count {
8a60: 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 timer went off,
8a70: 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b eof is not stick
8a80: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
8a90: 20 7d 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e }.. set coun
8aa0: 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 t 0. set done
8ab0: 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 false. proc
8ac0: 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 write_then_close
8ad0: 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 {s} {..puts $s
8ae0: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 bye..close $s.
8af0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
8b00: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
8b10: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
8b20: 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 ocking 0 -buffer
8b30: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
8b40: 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 ation lf..fileev
8b50: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
8b60: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
8b70: 6b 65 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 ke $s writable w
8b80: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
8b90: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c \...-buffering l
8ba0: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8bb0: 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 lf]. }. s
8bc0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
8bd0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
8be0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8bf0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8c00: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8c10: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
8c20: 72 20 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 r accept 8833].
8c30: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
8c40: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8c50: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8c60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8c70: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8c80: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f entKey \.. lo
8c90: 63 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 20 calhost 8833].
8ca0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
8cb0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
8cc0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
8cd0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
8ce0: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
8cf0: 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f dable "count_to_
8d00: 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 eof $c". set
8d10: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
8d20: 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 0 timerproc].
8d30: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
8d40: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
8d50: 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 count.} {eof is
8d60: 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 sticky}..remove
8d70: 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 File script..tes
8d80: 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 t tlsIO-10.1 {te
8d90: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 sting socket acc
8da0: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
8db0: 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f or handling} {so
8dc0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
8dd0: 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 goterror 0. p
8de0: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
8df0: 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f {global goterro
8e00: 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 r; set goterror
8e10: 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 1}. set s [tl
8e20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c s::socket -cafil
8e30: 65 20 24 63 61 43 65 72 74 20 2d 73 65 72 76 65 e $caCert -serve
8e40: 72 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 r accept 8898].
8e50: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8e60: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
8e70: 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 ; error}. set
8e80: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
8e90: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8ea0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 127.0.0.1 8898].
8eb0: 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 vwait goterr
8ec0: 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a or. close $s.
8ed0: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
8ee0: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 set goterror.}
8ef0: 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 1..test tlsIO-11
8f00: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
8f10: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 on} {socket doTe
8f20: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
8f30: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8f40: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
8f50: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
8f60: 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f socket9_1_test_
8f70: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
8f80: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
8f90: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
8fa0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
8fb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8fc0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
8fd0: 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 8834]..proc acc
8fe0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
8ff0: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9000: 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 e $s.. puts $
9010: 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 s done.. clos
9020: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
9030: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
9040: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9050: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9060: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9070: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9080: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9090: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
90a0: 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 4]. set r [ge
90b0: 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $s]. close
90c0: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
90d0: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
90e0: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
90f0: 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 r}. set r.} d
9100: 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d one..test tlsIO-
9110: 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 11.2 {client spe
9120: 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d cifies its port}
9130: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
9140: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9150: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
9160: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 o exists port]}
9170: 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 {..incr port.
9180: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 } else {..set p
9190: 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 ort [expr {$tlsS
91a0: 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 erverPort + [pid
91b0: 5d 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 ]%1024}]. }.
91c0: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
91d0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
91e0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 d {..set socket9
91f0: 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _2_test_server [
9200: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
9210: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d ver accept \...-
9220: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9230: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9240: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9250: 65 72 76 65 72 4b 65 79 20 38 38 33 35 5d 0a 09 erverKey 8835]..
9260: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
9270: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
9280: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
9290: 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 puts $s $p..
92a0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
92b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
92c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
92d0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
92e0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
92f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9300: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9310: 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 -myport $port
9320: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9330: 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 8835]. set r
9340: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
9350: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
9360: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9370: 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 socket9_2_test_s
9380: 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 erver}. if {$
9390: 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 r == $port} {..s
93a0: 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 et result ok.
93b0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
93c0: 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 esult broken.
93d0: 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c }. set resul
93e0: 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 t.} ok..test tls
93f0: 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 IO-11.3 {trying
9400: 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 to connect, no s
9410: 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 erver} {socket d
9420: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9430: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
9440: 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 t status ok.
9450: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 if {![catch {set
9460: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
9470: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9480: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9490: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
94a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
94b0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
94c0: 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d erverIp 8836]}]}
94d0: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
94e0: 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 {gets $s}]} {..
94f0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 set status br
9500: 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 oken..}..close $
9510: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
9520: 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 status.} ok..tes
9530: 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 t tlsIO-11.4 {re
9540: 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c mote echo, one l
9550: 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ine} {socket doT
9560: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9570: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
9580: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
9590: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
95a0: 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 t socket10_6_tes
95b0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
95c0: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
95d0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
95e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
95f0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
9600: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
9610: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
9620: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
9630: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9640: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9650: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
9660: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
9670: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
9680: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
9690: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
96a0: 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 tion crlf..}..pr
96b0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
96c0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
96d0: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
96e0: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
96f0: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
9700: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
9710: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
9720: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
9730: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9740: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9750: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9760: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9770: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9780: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
9790: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
97a0: 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $f -translatio
97b0: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
97c0: 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 g line. puts
97d0: 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 $f hello. set
97e0: 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 r [gets $f].
97f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
9800: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9810: 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 $socket10_6_tes
9820: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
9830: 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 t r.} hello..tes
9840: 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 t tlsIO-11.5 {re
9850: 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 mote echo, 50 li
9860: 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nes} {socket doT
9870: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9880: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
9890: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
98a0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
98b0: 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 t socket10_7_tes
98c0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
98d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
98e0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
98f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9900: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9910: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9920: 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 ey 8836]..proc a
9930: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
9940: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9950: 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 ake $s.. file
9960: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
9970: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
9980: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
9990: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
99a0: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
99b0: 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 crlf..}..proc e
99c0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
99d0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
99e0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
99f0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
9a00: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
9a10: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
9a20: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
9a30: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
9a40: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9a50: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9a60: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9a70: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
9a80: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
9a90: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
9aa0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
9ab0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
9ac0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
9ad0: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
9ae0: 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 cnt 0} {$cnt < 5
9af0: 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 0} {incr cnt} {.
9b00: 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c .puts $f "hello,
9b10: 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 $cnt"..if {[str
9b20: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 ing compare [get
9b30: 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 s $f] "hello, $c
9b40: 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 nt"] != 0} {..
9b50: 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d break..}. }
9b60: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
9b70: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
9b80: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 lose $socket10_7
9b90: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
9ba0: 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a set cnt.} 50..
9bb0: 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b # Macintosh sock
9bc0: 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 ets can have mor
9bd0: 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 e than one serve
9be0: 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 r per port.if {$
9bf0: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 tcl_platform(pla
9c00: 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e tform) == "macin
9c10: 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 tosh"} {. set
9c20: 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 conflictResult
9c30: 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 {0 8836}.} else
9c40: 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 {. set confli
9c50: 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 ctResult {1 {cou
9c60: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
9c70: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
9c80: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 dy in use}}.}..t
9c90: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b est tlsIO-11.6 {
9ca0: 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d socket conflict}
9cb0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
9cc0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9cd0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b } {. set s1 [
9ce0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9cf0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
9d00: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9d10: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9d20: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9d30: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
9d40: 70 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 pt 8836]. if
9d50: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 {[catch {set s2
9d60: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9d70: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
9d80: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9d90: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9da0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9db0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
9dc0: 65 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d ept 8836]} msg]}
9dd0: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b {..set result [
9de0: 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 list 1 $msg].
9df0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
9e00: 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c esult [list 0 [l
9e10: 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 index [fconfigur
9e20: 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d e $s2 -sockname]
9e30: 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 2]]..close $s2.
9e40: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
9e50: 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 $s1. set resu
9e60: 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 lt.} $conflictRe
9e70: 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f sult..test tlsIO
9e80: 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 -11.7 {server wi
9e90: 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e th several clien
9ea0: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ts} {socket doTe
9eb0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9ec0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
9ed0: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
9ee0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
9ef0: 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 socket10_9_test
9f00: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
9f10: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
9f20: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9f30: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9f40: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9f50: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
9f60: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
9f70: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
9f80: 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 {.. fconfigu
9f90: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
9fa0: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
9fb0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9fc0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9fd0: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9fe0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
9ff0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
a000: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
a010: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
a020: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
a030: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
a040: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
a050: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
a060: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
a070: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
a080: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a090: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a0a0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
a0b0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
a0c0: 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 onfigure $s1 -bu
a0d0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
a0e0: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
a0f0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
a100: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
a110: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
a120: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
a130: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
a140: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
a150: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
a160: 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 e $s2 -buffering
a170: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 line. set s3
a180: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a190: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a1a0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
a1b0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a1c0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
a1d0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
a1e0: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
a1f0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d fconfigure $s3 -
a200: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
a210: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
a220: 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 {$i < 100} {inc
a230: 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 r i} {..puts $s1
a240: 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e hello,tlsIO-11.
a250: 37 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 7,s1..gets $s1..
a260: 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 74 puts $s2 hello,t
a270: 6c 73 49 4f 2d 31 31 2e 37 2c 73 32 0a 09 67 65 lsIO-11.7,s2..ge
a280: 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 ts $s2..puts $s3
a290: 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e hello,tlsIO-11.
a2a0: 37 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 7,s3..gets $s3.
a2b0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a2c0: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
a2d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
a2e0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a2f0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
a300: 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 9_test_server}.
a310: 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 set i.} 100
a320: 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ..test tlsIO-1
a330: 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 1.8 {client with
a340: 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 several servers
a350: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
a360: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
a370: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
a380: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
a390: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a 3a Command {..tls::
a3a0: 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 24 init -certfile $
a3b0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a3c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a3d0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a 09 ile $serverKey..
a3e0: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
a3f0: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
a400: 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a ept 4003" 4003].
a410: 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f .set s2 [tls::so
a420: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
a430: 63 65 70 74 20 34 30 30 34 22 20 34 30 30 34 5d cept 4004" 4004]
a440: 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 ..set s3 [tls::s
a450: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
a460: 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 ccept 4005" 4005
a470: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
a480: 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 20 e {s mp} {..
a490: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a4a0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
a4b0: 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 } elseif {[catch
a4c0: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
a4d0: 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a $s} result]} {.
a4e0: 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 ..# Some errors
a4f0: 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 are normal...
a500: 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 } elseif {$resu
a510: 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 lt == 1} {...# H
a520: 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 andshake complet
a530: 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 e...fileevent $s
a540: 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 70 readable ""...p
a550: 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c 6f uts $s $mp...clo
a560: 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a se $s.. }..}.
a570: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 .proc accept {mp
a580: 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 s a p} {.. #
a590: 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 61 These have to a
a5a0: 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 ccept non-blocki
a5b0: 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 20 ng, because the
a5c0: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 20 handshaking..
a5d0: 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 64 # order isn't d
a5e0: 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 20 eterministic..
a5f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
a600: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
a610: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
a620: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
a630: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e adable [list han
a640: 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a 09 dshake $s $mp]..
a650: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 3a }. }. tls:
a660: 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 :init -certfile
a670: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a680: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a690: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 0a file $clientKey.
a6a0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
a6b0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
a6c0: 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 erverIP 4003].
a6d0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
a6e0: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
a6f0: 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 verIP 4004].
a700: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
a710: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
a720: 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 rIP 4005]. se
a730: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
a740: 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 nd l [gets $s1]
a750: 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 [gets $s1] [eof
a760: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s1] [gets $s2]
a770: 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 [gets $s2] [eof
a780: 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 $s2] \..[gets $s
a790: 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 3] [gets $s3] [e
a7a0: 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 of $s3]. clos
a7b0: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a7c0: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a7d0: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a7e0: 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 d {..close $s1..
a7f0: 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 close $s2..close
a800: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s3. }. s
a810: 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 et l.} {4003 {}
a820: 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 1 4004 {} 1 4005
a830: 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 {} 1}..test tls
a840: 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 IO-11.9 {accept
a850: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 callback error}
a860: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a870: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a880: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
a890: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a8a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
a8b0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a8c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a8d0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
a8e0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
a8f0: 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 8836]. proc
a900: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a910: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
a920: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
a930: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
a940: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
a950: 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 }. sendCertVa
a960: 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 lues. if {[ca
a970: 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 tch {sendCommand
a980: 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 {.. set peer
a990: 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 name [fconfigure
a9a0: 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d $callerSocket -
a9b0: 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 peername].. s
a9c0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
a9d0: 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 66 t \... -certf
a9e0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a9f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
aa00: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
aa10: 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 6e Key \... [lin
aa20: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
aa30: 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 8836].. clos
aa40: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
aa50: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
aa60: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
aa70: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
aa80: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
aa90: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
aaa0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
aab0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
aac0: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
aad0: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
aae0: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
aaf0: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
ab00: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ero}}..test tlsI
ab10: 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 O-11.10 {testing
ab20: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
ab30: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
ab40: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
ab50: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
ab60: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
ab70: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
ab80: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
ab90: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 12_test_server [
aba0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
abb0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
abc0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
abd0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
abe0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
abf0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
ac00: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
ac10: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
ac20: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
ac30: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
ac40: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ac50: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
ac60: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ac70: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
ac80: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
ac90: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
aca0: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
acb0: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
acc0: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
acd0: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
ace0: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
acf0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
ad00: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
ad10: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
ad20: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
ad30: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
ad40: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
ad50: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
ad60: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
ad70: 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a 74 .} {8836 3 3}..t
ad80: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 est tlsIO-11.11
ad90: 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 {testing spuriou
ada0: 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 s events} {socke
adb0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
adc0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
add0: 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 # remote equiva
ade0: 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 20 lent of 9.1.
adf0: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
ae00: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
ae10: 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 73 ..set socket_tes
ae20: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
ae30: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
ae40: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
ae50: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
ae60: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ae70: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
ae80: 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 68 ey 8836]..proc h
ae90: 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a 09 andshake {s} {..
aea0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
aeb0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
aec0: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 } elseif {[c
aed0: 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 atch {tls::hands
aee0: 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d hake $s} result]
aef0: 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 } {...# Some err
af00: 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a ors are normal..
af10: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
af20: 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 result == 1} {..
af30: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
af40: 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e plete...fileeven
af50: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 22 t $s writable ""
af60: 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 72 69 ...after 100 wri
af70: 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 7d tesome $s.. }
af80: 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 ..}..proc accept
af90: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
afa0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
afb0: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
afc0: 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 76 lf".. fileev
afd0: 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 ent $s writable
afe0: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
aff0: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s]..}..proc wri
b000: 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 tesome {s} {..
b010: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
b020: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
b030: 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 i} {...puts $s
b040: 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 "line $i from re
b050: 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 mote server"..
b060: 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 }.. close $
b070: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b080: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
b090: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
b0a0: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
b0b0: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
b0c0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
b0d0: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
b0e0: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
b0f0: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
b100: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
b110: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
b120: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
b130: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
b140: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
b150: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
b160: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
b170: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
b180: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
b190: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b1a0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
b1b0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b1c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b1d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b1e0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b1f0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
b200: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
b210: 20 20 23 20 47 65 74 20 74 68 65 20 62 75 66 66 # Get the buff
b220: 65 72 69 6e 67 20 63 6f 72 72 65 63 74 65 64 0a ering corrected.
b230: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
b240: 63 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e c -buffering lin
b250: 65 0a 20 20 20 20 23 20 50 75 74 20 61 20 62 79 e. # Put a by
b260: 74 65 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 65 te into the clie
b270: 6e 74 20 70 69 70 65 20 74 6f 20 74 72 69 67 67 nt pipe to trigg
b280: 65 72 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 er TLS handshaki
b290: 6e 67 0a 20 20 20 20 70 75 74 73 20 24 63 20 61 ng. puts $c a
b2a0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b2b0: 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 c readable [list
b2c0: 20 72 65 61 64 6c 69 74 74 6c 65 20 24 63 5d 0a readlittle $c].
b2d0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
b2e0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
b2f0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
b300: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b310: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
b320: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
b330: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
b340: 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 socket_test_serv
b350: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
b360: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
b370: 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 2690}..test tls
b380: 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e IO-11.12 {testin
b390: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
b3a0: 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 } {unexplainedFa
b3b0: 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 ilure socket doT
b3c0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b3d0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 rver} {. # re
b3e0: 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 mote equivalent
b3f0: 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 4f 42 of 9.3. # HOB
b400: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 BS: never worked
b410: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 73 correctly. s
b420: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
b430: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
b440: 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 proc count_up {s
b450: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
b460: 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 ter done after_i
b470: 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 d..set l [gets $
b480: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
b490: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
b4a0: 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 unter.. if {$
b4b0: 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 counter > 9} {..
b4c0: 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 .set done {EOF i
b4d0: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
b4e0: 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f r cancel $after_
b4f0: 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 id...close $s..
b500: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
b510: 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 proc timed_out
b520: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 {} {..global c
b530: 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b done..set done {
b540: 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 timed_out, EOF i
b550: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
b560: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 lose $c. }.
b570: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
b580: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b590: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
b5a0: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _14_test_server
b5b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b5c0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
b5d0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
b5e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b5f0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
b600: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
b610: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
b620: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b630: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
b640: 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 s.. after 100
b650: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
b660: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
b670: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b680: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b690: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b6a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b6b0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b6c0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b6d0: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 8836]. file
b6e0: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
b6f0: 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a e "count_up $c".
b700: 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 set after_id
b710: 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d [after 1000 tim
b720: 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 ed_out]. vwai
b730: 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 t done. sendC
b740: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
b750: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
b760: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
b770: 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 done.} {EOF is s
b780: 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 ticky}..test tls
b790: 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e IO-11.13 {testin
b7a0: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 g async write, a
b7b0: 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e sync flush, asyn
b7c0: 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 c close} \..{soc
b7d0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b7e0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b7f0: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
b800: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
b810: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
b820: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
b830: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
b840: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
b850: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
b860: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
b870: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
b880: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
b890: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
b8a0: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
b8b0: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
b8c0: 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 20 73 eat a 31]..set s
b8d0: 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 econdblock [stri
b8e0: 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 35 33 ng repeat b 6553
b8f0: 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 5]..set l [tls::
b900: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
b910: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
b920: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b930: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
b940: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
b950: 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 accept 8845]..p
b960: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b970: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b980: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b990: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
b9a0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
b9b0: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
b9c0: 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 ersize 16384 \..
b9d0: 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e 67 20 . -buffering
b9e0: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
b9f0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
ba00: 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d "readable $s"..}
ba10: 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 ..proc readable
ba20: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
ba30: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
ba40: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
ba50: 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 dable {}.. af
ba60: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
ba70: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 $s..}..proc res
ba80: 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 pond {s} {..
ba90: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
baa0: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
bab0: 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 ewline $s $first
bac0: 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 block.. after
bad0: 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 1000 writedata
bae0: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
baf0: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 edata {s} {..
bb00: 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c global secondbl
bb10: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
bb20: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
bb30: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c ondblock.. cl
bb40: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
bb50: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
bb60: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
bb70: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
bb80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
bb90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
bba0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
bbb0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
bbc0: 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 845]. fconfig
bbd0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
bbe0: 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 0 -translation
bbf0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
bc00: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
bc10: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
bc20: 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 ello. fileeve
bc30: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
bc40: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
bc50: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
bc60: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
bc70: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
bc80: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
bc90: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
bca0: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
bcb0: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
bcc0: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
bcd0: 35 36 36 0a 0a 70 72 6f 63 20 67 65 74 64 61 74 566..proc getdat
bce0: 61 20 7b 74 79 70 65 20 66 69 6c 65 7d 20 7b 0a a {type file} {.
bcf0: 20 20 20 20 23 20 52 65 61 64 20 68 61 6e 64 6c # Read handl
bd00: 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 er on the accept
bd10: 65 64 20 73 6f 63 6b 65 74 2e 0a 20 20 20 20 67 ed socket.. g
bd20: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 67 6c 6f 62 lobal x. glob
bd30: 61 6c 20 66 61 69 6c 65 64 0a 20 20 20 20 73 65 al failed. se
bd40: 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 t status [catch
bd50: 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 {read $file} dat
bd60: 61 5d 0a 20 20 20 20 69 66 20 7b 24 73 74 61 74 a]. if {$stat
bd70: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 73 65 74 20 us != 0} {..set
bd80: 78 20 22 72 65 61 64 20 66 61 69 6c 65 64 2c 20 x "read failed,
bd90: 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 22 error was $data"
bda0: 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 ..catch { close
bdb0: 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c $file }. } el
bdc0: 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f seif {[string co
bdd0: 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d mpare {} $data]}
bde0: 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 {. } elseif
bdf0: 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 {[fblocked $file
be00: 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 69 ]} {. } elsei
be10: 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 f {[eof $file]}
be20: 7b 0a 09 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 {..if {$failed}
be30: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 24 74 {.. set x "$t
be40: 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ype socket was i
be50: 6e 68 65 72 69 74 65 64 22 0a 09 7d 20 65 6c 73 nherited"..} els
be60: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 e {.. set x "
be70: 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 61 73 $type socket was
be80: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 22 0a not inherited".
be90: 09 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 .}..catch { clos
bea0: 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 20 e $file }. }
beb0: 65 6c 73 65 20 7b 0a 09 73 65 74 20 78 20 7b 69 else {..set x {i
bec0: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
bed0: 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 .catch { close $
bee0: 66 69 6c 65 20 7d 0a 20 20 20 20 7d 0a 20 20 20 file }. }.
bef0: 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 return.}..test
bf00: 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 tlsIO-12.1 {test
bf10: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
bf20: 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 of server socket
bf30: 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d s} {socket exec}
bf40: 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 {. makeFile
bf50: 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d {} script1. m
bf60: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
bf70: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
bf80: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
bf90: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
bfa0: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
bfb0: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
bfc0: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
bfd0: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
bfe0: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
bff0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c000: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
c010: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
c020: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
c030: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
c040: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
c050: 53 63 72 69 70 74 32 20 63 72 65 61 74 65 73 20 Script2 creates
c060: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
c070: 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 t, launches scri
c080: 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 pt1,. # waits
c090: 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 a second, and e
c0a0: 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 xits. The serve
c0b0: 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f r socket will no
c0c0: 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 w. # be close
c0d0: 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 d unless script1
c0e0: 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a inherited it...
c0f0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c100: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c110: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c120: 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 tclsh $::tcltes
c130: 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 t::tcltest].
c140: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
c150: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
c160: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
c170: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
c180: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
c190: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
c1a0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
c1b0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
c1c0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
c1d0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
c1e0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c1f0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
c200: 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 y 8828\]". pu
c210: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
c220: 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 cept { file addr
c230: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 port } {.. c
c240: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 lose $file..}..e
c250: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c260: 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 t1 &..close $f..
c270: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
c280: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c290: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c2a0: 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 f.. # Launch
c2b0: 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 script2 and wait
c2c0: 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 5 seconds..
c2d0: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
c2e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
c2f0: 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 &. after 500
c300: 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 0 { set ok_to_pr
c310: 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 oceed 1 }. vw
c320: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
c330: 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 d.. # If we c
c340: 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 an still connect
c350: 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 to the server,
c360: 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 the socket got i
c370: 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 nherited... i
c380: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
c390: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
c3a0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
c3b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c3c0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
c3d0: 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 Key \. . 127.0
c3e0: 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d .0.1 8828} msg]}
c3f0: 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 {..set x {serve
c400: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 r socket was not
c410: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
c420: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
c430: 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 $msg..set x {ser
c440: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ver socket was i
c450: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a nherited}. }.
c460: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 . set x.} {se
c470: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
c480: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
c490: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 test tlsIO-12.2
c4a0: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
c4b0: 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 ance of client s
c4c0: 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 ockets} {socket
c4d0: 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 exec} {. make
c4e0: 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a File {} script1.
c4f0: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 makeFile {}
c500: 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 script2.. # S
c510: 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 cript1 is just a
c520: 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 10 second delay
c530: 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 . If the server
c540: 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 socket. # is
c550: 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 inherited, it w
c560: 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e ill be held open
c570: 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a for 10 seconds.
c580: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
c590: 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 script1 w].
c5a0: 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 puts $f {..after
c5b0: 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 10000 exit..vwa
c5c0: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c5d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c5e0: 20 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 # Script2 ope
c5f0: 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f ns the client so
c600: 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 cket and writes
c610: 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a to it. It then.
c620: 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 # launches s
c630: 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 cript1 and exits
c640: 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 . If the child
c650: 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 process inherite
c660: 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 d the. # clie
c670: 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 nt socket, the s
c680: 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c ocket will still
c690: 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 be open... s
c6a0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
c6b0: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
c6c0: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
c6d0: 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 h $::tcltest::tc
c6e0: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
c6f0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
c700: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
c710: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
c720: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
c730: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
c740: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
c750: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
c760: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
c770: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c780: 72 74 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 rt \.. -keyfi
c790: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
c7a0: 37 2e 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 7.0.0.1 8829\]".
c7b0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 puts $f {..e
c7c0: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c7d0: 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 t1 &..puts $f te
c7e0: 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a sting..flush $f.
c7f0: 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 .after 1000 exit
c800: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c810: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c820: 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 $f.. # Create
c830: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
c840: 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 et.. set serv
c850: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
c860: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
c870: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
c880: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
c890: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
c8a0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
c8b0: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 accept 8829].
c8c0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 proc accept { f
c8d0: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
c8e0: 7b 0a 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c {..# When the cl
c8f0: 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 ient connects, e
c900: 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 stablish the rea
c910: 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 d handler..globa
c920: 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 l server..close
c930: 24 73 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 $server..fconfig
c940: 75 72 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b ure $file -block
c950: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
c960: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
c970: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
c980: 6b 65 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c ke $file readabl
c990: 65 20 5c 0a 09 09 5b 6c 69 73 74 20 67 65 74 64 e \...[list getd
c9a0: 61 74 61 20 63 6c 69 65 6e 74 5d 20 2d 62 75 66 ata client] -buf
c9b0: 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 fering line]..re
c9c0: 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 turn. }..
c9d0: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
c9e0: 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d doesn't hit end-
c9f0: 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 of-file in 5 sec
ca00: 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 onds, the. #
ca10: 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 script1 process
ca20: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
ca30: 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a ted the client..
ca40: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
ca50: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
ca60: 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 [list set faile
ca70: 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e d 1].. # Laun
ca80: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
ca90: 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 rocess.. exec
caa0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
cab0: 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a test script2 &..
cac0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
cad0: 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a if {!$failed} {.
cae0: 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 .vwait failed.
caf0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
cb00: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
cb10: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
cb20: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 }..test tlsIO-12
cb30: 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .3 {testing inhe
cb40: 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 ritance of accep
cb50: 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ted sockets} \..
cb60: 7b 73 6f 63 6b 65 74 20 65 78 65 63 20 75 6e 69 {socket exec uni
cb70: 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b xOnly} {. mak
cb80: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 eFile {} script1
cb90: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
cba0: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 script2.. se
cbb0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
cbc0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
cbd0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
cbe0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
cbf0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
cc00: 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 ose $f.. set
cc10: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
cc20: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
cc30: 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 list set tclsh $
cc40: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
cc50: 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 st]. puts $f
cc60: 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 [list set auto_p
cc70: 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a ath $auto_path].
cc80: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
cc90: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
cca0: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
ccb0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
ccc0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
ccd0: 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 r accept \..
cce0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
ccf0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
cd00: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
cd10: 73 65 72 76 65 72 4b 65 79 20 38 39 33 30 5c 5d serverKey 8930\]
cd20: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
cd30: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 .proc accept { f
cd40: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
cd50: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 {.. global tc
cd60: 6c 73 68 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 lsh.. fconfig
cd70: 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 ure $file -buffe
cd80: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 70 ring line.. p
cd90: 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 uts $file {test
cda0: 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a data on socket}.
cdb0: 09 20 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 . exec $tclsh
cdc0: 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 script1 &..
cdd0: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
cde0: 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 .}..vwait foreve
cdf0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
ce00: 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e e $f.. # Laun
ce10: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
ce20: 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 rocess and conne
ce30: 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 ct to it. See h
ce40: 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 ow long. # th
ce50: 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f e socket stays o
ce60: 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 3a pen.. exec $:
ce70: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
ce80: 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 t script2 &..
ce90: 20 61 66 74 65 72 20 32 30 30 30 20 73 65 74 20 after 2000 set
cea0: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a ok_to_proceed 1.
ceb0: 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f vwait ok_to_
cec0: 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 proceed.. set
ced0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
cee0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
cef0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
cf00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
cf10: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
cf20: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
cf30: 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 1 8930]. fcon
cf40: 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 figure $f -buffe
cf50: 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b ring full -block
cf60: 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 20 6e ing 0. # We n
cf70: 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 79 74 eed to put a byt
cf80: 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 64 20 e into the read
cf90: 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 73 65 queue, otherwise
cfa0: 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 20 68 the. # TLS h
cfb0: 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e 27 74 andshake doesn't
cfc0: 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 74 73 finish. puts
cfd0: 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 66 0a $f a; flush $f.
cfe0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 fileevent $f
cff0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
d000: 67 65 74 64 61 74 61 20 61 63 63 65 70 74 65 64 getdata accepted
d010: 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 $f].. # If t
d020: 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 he socket is sti
d030: 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 ll open after 5
d040: 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 seconds, the scr
d050: 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 ipt1 process.
d060: 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 # must have inh
d070: 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 70 erited the accep
d080: 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 ted socket...
d090: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
d0a0: 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 74 after 5000 set
d0b0: 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 76 failed 1.. v
d0c0: 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 20 78 wait x. set x
d0d0: 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 .} {accepted soc
d0e0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
d0f0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
d100: 49 4f 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 IO-13.1 {Testing
d110: 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 use of shared s
d120: 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 ocket between tw
d130: 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 o threads} \..{s
d140: 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 ocket testthread
d150: 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a } {. # HOBBS:
d160: 20 6e 65 76 65 72 20 74 65 73 74 65 64 0a 20 20 never tested.
d170: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
d180: 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 ipt. threadRe
d190: 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 ap.. makeFile
d1a0: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
d1b0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
d1c0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
d1d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
d1e0: 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 828]..proc accep
d1f0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
d200: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
d210: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
d220: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
d230: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
d240: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
d250: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
d260: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
d270: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
d280: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
d290: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
d2a0: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
d2b0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
d2c0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
d2d0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
d2e0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
d2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d300: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
d310: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
d320: 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 .. incr
d330: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d340: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
d350: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
d360: 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 ..set i 0..vwait
d370: 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 x..close $f...#
d380: 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 thread cleans i
d390: 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 tself up...testt
d3a0: 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d hread exit. }
d3b0: 20 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 script. .
d3c0: 20 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 # create a thre
d3d0: 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 ad. set serve
d3e0: 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 rthread [testthr
d3f0: 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 ead create { sou
d400: 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 rce script } ].
d410: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 update. .
d420: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
d430: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
d440: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
d450: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
d460: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
d470: 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 g line.. catc
d480: 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 h {..puts $s "he
d490: 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 llo"..gets $s re
d4a0: 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 sult. }. c
d4b0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
d4c0: 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 te.. after 20
d4d0: 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 00. lappend r
d4e0: 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 esult [threadRea
d4f0: 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 p]. . set
d500: 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f result..} {hello
d510: 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 1}..test tlsIO-
d520: 31 34 2e 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 14.1 {test tls::
d530: 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 unimport} {socke
d540: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
d550: 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 atch {tls::unimp
d560: 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ort} msg] $msg.}
d570: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
d580: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
d590: 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e s::unimport chan
d5a0: 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 nel"}}.test tlsI
d5b0: 4f 2d 31 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 O-14.2 {test tls
d5c0: 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 ::unimport} {soc
d5d0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
d5e0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 [catch {tls::uni
d5f0: 6d 70 6f 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d mport foo bar} m
d600: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
d610: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
d620: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 uld be "tls::uni
d630: 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d mport channel"}}
d640: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 .test tlsIO-14.3
d650: 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d {test tls::unim
d660: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b port} {socket} {
d670: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
d680: 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 {tls::unimport
d690: 62 6f 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 bogus} msg] $msg
d6a0: 0a 7d 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 .} {1 {can not f
d6b0: 69 6e 64 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 ind channel name
d6c0: 64 20 22 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 d "bogus"}}.test
d6d0: 20 74 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 tlsIO-14.4 {tes
d6e0: 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d t tls::unimport}
d6f0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
d700: 23 20 73 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 # stdin can take
d710: 20 64 69 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 different names
d720: 20 61 73 20 74 68 65 20 22 74 6f 70 22 20 63 68 as the "top" ch
d730: 61 6e 6e 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b annel. list [
d740: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d catch {tls::unim
d750: 70 6f 72 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d port stdin} msg]
d760: 20 5c 0a 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 \..[string matc
d770: 68 20 7b 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 h {bad channel "
d780: 2a 22 3a 20 6e 6f 74 20 61 20 54 4c 53 20 63 68 *": not a TLS ch
d790: 61 6e 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b annel} $msg].} {
d7a0: 31 20 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 1 1}.test tlsIO-
d7b0: 31 34 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 14.5 {test tls::
d7c0: 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 unimport} {socke
d7d0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e t} {. set len
d7e0: 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 0. set spuri
d7f0: 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f ous 0. set do
d800: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 ne 0. proc re
d810: 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 adlittle {s} {..
d820: 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 global spurious
d830: 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 done len..set l
d840: 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 [read $s 1]..if
d850: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
d860: 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 $l] == 0} {..
d870: 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 if {![eof $s]}
d880: 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 {...incr spuriou
d890: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
d8a0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
d8b0: 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 done 1.. }..
d8c0: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e } else {.. in
d8d0: 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c cr len [string l
d8e0: 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 ength $l]..}.
d8f0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
d900: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
d910: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
d920: 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 cking 0..fileeve
d930: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
d940: 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b list do_handshak
d950: 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 e $s readable re
d960: 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 adlittle \...-bu
d970: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 ffering none].
d980: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
d990: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
d9a0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
d9b0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
d9c0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
d9d0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
d9e0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 31 5d ver accept 8831]
d9f0: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
da00: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
da10: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
da20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
da30: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
da40: 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f y \.. localho
da50: 73 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20 6f st 8831]. # o
da60: 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e 74 20 67 nly the client g
da70: 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 0a ets tls::import.
da80: 20 20 20 20 73 65 74 20 72 65 73 20 5b 74 6c 73 set res [tls
da90: 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 5d 0a 20 ::unimport $c].
daa0: 20 20 20 6c 69 73 74 20 24 72 65 73 20 5b 63 61 list $res [ca
dab0: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 20 65 tch {close $c} e
dac0: 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b 63 61 74 rr] $err \..[cat
dad0: 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 20 65 72 ch {close $s} er
dae0: 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 30 20 r] $err.} {{} 0
daf0: 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 {} 0 {}}..test t
db00: 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 7b 74 65 ls-bug58-1.0 {te
db10: 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e 65 67 6f st protocol nego
db20: 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 72 65 7d tiation failure}
db30: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
db40: 23 20 46 6f 6c 6c 6f 77 69 6e 67 20 63 6f 64 65 # Following code
db50: 20 69 73 20 62 61 73 65 64 20 6f 6e 20 77 68 61 is based on wha
db60: 74 20 77 61 73 20 72 65 70 6f 72 74 65 64 20 69 t was reported i
db70: 6e 20 62 75 67 20 23 35 38 2e 20 50 72 69 6f 72 n bug #58. Prior
db80: 0a 20 20 20 20 23 20 74 6f 20 66 69 78 20 74 68 . # to fix th
db90: 65 20 70 72 6f 67 72 61 6d 20 77 6f 75 6c 64 20 e program would
dba0: 63 72 61 73 68 20 77 69 74 68 20 61 20 73 65 67 crash with a seg
dbb0: 66 61 75 6c 74 2e 0a 20 20 20 20 70 72 6f 63 20 fault.. proc
dbc0: 41 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 72 67 Accept {sock arg
dbd0: 73 7d 20 7b 0a 20 20 20 20 20 20 20 20 66 63 6f s} {. fco
dbe0: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
dbf0: 6c 6f 63 6b 69 6e 67 20 30 3b 0a 20 20 20 20 20 locking 0;.
dc00: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 6f fileevent $so
dc10: 63 6b 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 ck readable [lis
dc20: 74 20 48 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 t Handshake $soc
dc30: 6b 5d 0a 20 20 20 20 7d 20 0a 20 20 20 20 70 72 k]. } . pr
dc40: 6f 63 20 48 61 6e 64 73 68 61 6b 65 20 7b 73 6f oc Handshake {so
dc50: 63 6b 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 ck} {. se
dc60: 74 20 3a 3a 64 6f 6e 65 20 48 41 4e 44 0a 20 20 t ::done HAND.
dc70: 20 20 20 20 20 20 63 61 74 63 68 20 7b 74 6c 73 catch {tls
dc80: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 ::handshake $soc
dc90: 6b 7d 20 6d 73 67 0a 20 20 20 20 20 20 20 20 73 k} msg. s
dca0: 65 74 20 3a 3a 64 6f 6e 65 20 24 6d 73 67 0a 20 et ::done $msg.
dcb0: 20 20 20 7d 20 0a 20 20 20 20 23 20 4e 4f 54 45 } . # NOTE
dcc0: 3a 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 : when doing an
dcd0: 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e in-process clien
dce0: 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 t/server test, b
dcf0: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 oth sides need.
dd00: 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 # to be non-b
dd10: 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 locking for the
dd20: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 0a 0a 20 TLS handshake..
dd30: 20 20 20 23 20 53 65 72 76 65 72 20 2d 20 4f 6e # Server - On
dd40: 6c 79 20 61 63 63 65 70 74 20 54 4c 53 20 31 2e ly accept TLS 1.
dd50: 32 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 2. set s [tls
dd60: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 20 20 20 20 20 ::socket \.
dd70: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
dd80: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
dd90: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
dda0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d 72 65 e $serverKey -re
ddb0: 71 75 65 73 74 20 30 20 5c 0a 09 2d 72 65 71 75 quest 0 \..-requ
ddc0: 69 72 65 20 30 20 2d 73 73 6c 32 20 30 20 2d 73 ire 0 -ssl2 0 -s
ddd0: 73 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d 74 sl3 0 -tls1 0 -t
dde0: 6c 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 ls1.1 0 -tls1.2
ddf0: 31 20 2d 74 6c 73 31 2e 33 20 30 20 5c 0a 20 20 1 -tls1.3 0 \.
de00: 20 20 20 20 20 20 2d 73 65 72 76 65 72 20 41 63 -server Ac
de10: 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 23 cept 8831]. #
de20: 20 43 6c 69 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 Client - Only p
de30: 72 6f 70 6f 73 65 20 54 4c 53 31 2e 30 0a 20 20 ropose TLS1.0.
de40: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
de50: 63 6b 65 74 20 2d 61 73 79 6e 63 20 2d 63 61 66 cket -async -caf
de60: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 72 65 71 ile $caCert -req
de70: 75 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 20 uest 0 -require
de80: 30 20 5c 0a 09 2d 73 73 6c 32 20 30 20 2d 73 73 0 \..-ssl2 0 -ss
de90: 6c 33 20 30 20 2d 74 6c 73 31 20 31 20 2d 74 6c l3 0 -tls1 1 -tl
dea0: 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 30 s1.1 0 -tls1.2 0
deb0: 20 2d 74 6c 73 31 2e 33 20 30 20 6c 6f 63 61 6c -tls1.3 0 local
dec0: 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 66 host 8831]. f
ded0: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
dee0: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
def0: 73 20 24 63 20 61 20 3b 20 66 6c 75 73 68 20 24 s $c a ; flush $
df00: 63 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 c. after 5000
df10: 20 5b 6c 69 73 74 20 73 65 74 20 3a 3a 64 6f 6e [list set ::don
df20: 65 20 74 69 6d 65 6f 75 74 5d 0a 20 20 20 20 76 e timeout]. v
df30: 77 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 wait ::done.
df40: 73 77 69 74 63 68 20 2d 65 78 61 63 74 20 2d 2d switch -exact --
df50: 20 24 3a 3a 64 6f 6e 65 20 7b 0a 20 20 20 20 20 $::done {.
df60: 20 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 "handshake fa
df70: 69 6c 65 64 3a 20 77 72 6f 6e 67 20 73 73 6c 20 iled: wrong ssl
df80: 76 65 72 73 69 6f 6e 22 20 2d 0a 20 20 20 20 20 version" -.
df90: 20 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 "handshake fa
dfa0: 69 6c 65 64 3a 20 75 6e 73 75 70 70 6f 72 74 65 iled: unsupporte
dfb0: 64 20 70 72 6f 74 6f 63 6f 6c 22 20 7b 0a 20 20 d protocol" {.
dfc0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a set ::
dfd0: 64 6f 6e 65 20 22 68 61 6e 64 73 68 61 6b 65 20 done "handshake
dfe0: 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 failed: wrong ve
dff0: 72 73 69 6f 6e 20 6e 75 6d 62 65 72 22 0a 20 20 rsion number".
e000: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 }. }.
e010: 20 20 73 65 74 20 3a 3a 64 6f 6e 65 0a 7d 20 7b set ::done.} {
e020: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
e030: 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f 6e 20 : wrong version
e040: 6e 75 6d 62 65 72 7d 0a 0a 23 20 63 6c 65 61 6e number}..# clean
e050: 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d up.if {[string m
e060: 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d atch sock* $comm
e070: 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d andSocket] == 1}
e080: 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d {. puts $comm
e090: 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 andSocket exit.
e0a0: 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 flush $command
e0b0: 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b Socket.}.catch {
e0c0: 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f close $commandSo
e0d0: 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f cket}.catch {clo
e0e0: 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 se $remoteProcCh
e0f0: 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 an}.::tcltest::c
e100: 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 leanupTests.flus
e110: 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a h stdout.return.