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