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