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