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 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 6f 2e 74 65 73 74 2c 76 20 31 : tlsIo.test,v 1
0200: 2e 31 32 20 32 30 30 30 2f 30 36 2f 30 33 20 30 .12 2000/06/03 0
0210: 35 3a 30 31 3a 33 33 20 61 77 62 20 45 78 70 20 5:01:33 awb Exp
0220: 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 73 6f 63 $..# Running soc
0230: 6b 65 74 20 74 65 73 74 73 20 77 69 74 68 20 61 ket tests with a
0240: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 3a 0a remote server:.
0250: 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d # --------------
0260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 20 0a ------------.# .
0280: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 6e 20 # Some tests in
0290: 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 70 65 socket.test depe
02a0: 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 74 65 nd on the existe
02b0: 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 65 20 nce of a remote
02c0: 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 69 63 server to.# whic
02d0: 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 2e 20 h they connect.
02e0: 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 The remote serve
02f0: 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 6e 73 r must be an ins
0300: 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 73 74 tance of tcltest
0310: 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 20 72 and it.# must r
0320: 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 66 6f un the script fo
0330: 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c 65 20 und in the file
0340: 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 6e 20 "remote.tcl" in
0350: 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 2e 20 this directory.
0360: 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 74 20 You.# can start
0370: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0380: 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 6e 65 r on any machine
0390: 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f 6d 20 reachable from
03a0: 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e 0a 23 the machine on.#
03b0: 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e 74 20 which you want
03c0: 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 6b 65 to run the socke
03d0: 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 73 75 t tests, by issu
03e0: 69 6e 67 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 ing:.# .# tc
03f0: 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c ltest remote.tcl
0400: 20 2d 70 6f 72 74 20 32 30 34 38 09 23 20 4f 72 -port 2048.# Or
0410: 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 72 20 choose another
0420: 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 20 0a port number..# .
0430: 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 6e 65 # If the machine
0440: 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 6e 67 you are running
0450: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0460: 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 72 61 er on has severa
0470: 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 63 65 l IP.# interface
0480: 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f 6f 73 s, you can choos
0490: 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 61 63 e which interfac
04a0: 65 20 74 68 65 20 73 65 72 76 65 72 20 6c 69 73 e the server lis
04b0: 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 63 6f tens on for.# co
04c0: 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 70 65 nnections by spe
04d0: 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 64 64 cifying the -add
04e0: 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e ress command lin
04f0: 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 20 0a 23 e flag, so:.# .#
0500: 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d tcltest rem
0510: 6f 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 73 73 ote.tcl -address
0520: 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f your.machine.co
0530: 6d 0a 23 20 0a 23 20 54 68 65 73 65 20 6f 70 74 m.# .# These opt
0540: 69 6f 6e 73 20 63 61 6e 20 61 6c 73 6f 20 62 65 ions can also be
0550: 20 73 65 74 20 62 79 20 65 6e 76 69 72 6f 6e 6d set by environm
0560: 65 6e 74 20 76 61 72 69 61 62 6c 65 73 2e 20 4f ent variables. O
0570: 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 0a n Unix, you can.
0580: 23 20 74 79 70 65 20 74 68 65 73 65 20 63 6f 6d # type these com
0590: 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 73 68 65 mands to the she
05a0: 6c 6c 20 66 72 6f 6d 20 77 68 69 63 68 20 74 68 ll from which th
05b0: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
05c0: 69 73 20 73 74 61 72 74 65 64 3a 0a 23 20 0a 23 is started:.# .#
05d0: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 shell% sete
05e0: 6e 76 20 73 65 72 76 65 72 50 6f 72 74 20 32 30 nv serverPort 20
05f0: 34 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 48.# shell%
0600: 73 65 74 65 6e 76 20 73 65 72 76 65 72 41 64 64 setenv serverAdd
0610: 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e ress your.machin
0620: 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e 64 20 73 e.com.# .# and s
0630: 75 62 73 65 71 75 65 6e 74 6c 79 20 79 6f 75 20 ubsequently you
0640: 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 72 65 can start the re
0650: 6d 6f 74 65 20 73 65 72 76 65 72 20 77 69 74 68 mote server with
0660: 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 :.# .# tclte
0670: 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 0a 23 20 st remote.tcl.#
0680: 0a 23 20 74 6f 20 68 61 76 65 20 69 74 20 6c 69 .# to have it li
0690: 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 32 30 34 sten on port 204
06a0: 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 66 61 8 on the interfa
06b0: 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e ce your.machine.
06c0: 63 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 20 57 68 com..# .# Wh
06d0: 65 6e 20 74 68 65 20 73 65 72 76 65 72 20 73 74 en the server st
06e0: 61 72 74 73 2c 20 69 74 20 70 72 69 6e 74 73 20 arts, it prints
06f0: 6f 75 74 20 61 20 64 65 74 61 69 6c 65 64 20 6d out a detailed m
0700: 65 73 73 61 67 65 20 63 6f 6e 74 61 69 6e 69 6e essage containin
0710: 67 20 69 74 73 0a 23 20 63 6f 6e 66 69 67 75 72 g its.# configur
0720: 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 69 6f ation informatio
0730: 6e 2c 20 61 6e 64 20 69 74 20 77 69 6c 6c 20 62 n, and it will b
0740: 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 6c 6c 65 lock until kille
0750: 64 20 77 69 74 68 20 61 20 43 74 72 6c 2d 43 2e d with a Ctrl-C.
0760: 0a 23 20 4f 6e 63 65 20 74 68 65 20 72 65 6d 6f .# Once the remo
0770: 74 65 20 73 65 72 76 65 72 20 65 78 69 73 74 73 te server exists
0780: 2c 20 79 6f 75 20 63 61 6e 20 72 75 6e 20 74 68 , you can run th
0790: 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 e tests in socke
07a0: 74 2e 74 65 73 74 20 77 69 74 68 0a 23 20 74 68 t.test with.# th
07b0: 65 20 73 65 72 76 65 72 20 62 79 20 73 65 74 74 e server by sett
07c0: 69 6e 67 20 74 77 6f 20 54 63 6c 20 76 61 72 69 ing two Tcl vari
07d0: 61 62 6c 65 73 3a 0a 23 20 0a 23 20 20 20 20 20 ables:.# .#
07e0: 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 % set remoteServ
07f0: 65 72 49 50 20 3c 6e 61 6d 65 20 6f 72 20 61 64 erIP <name or ad
0800: 64 72 65 73 73 20 6f 66 20 6d 61 63 68 69 6e 65 dress of machine
0810: 20 6f 6e 20 77 68 69 63 68 20 73 65 72 76 65 72 on which server
0820: 20 72 75 6e 73 3e 0a 23 20 20 20 20 20 25 20 73 runs>.# % s
0830: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
0840: 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 20 54 68 ort 2048.# .# Th
0850: 65 73 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 ese variables ar
0860: 65 20 61 6c 73 6f 20 73 65 74 74 61 62 6c 65 20 e also settable
0870: 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 72 6f 6e from the environ
0880: 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 ment. On Unix, y
0890: 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 20 20 20 20 ou can:.# .#
08a0: 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 72 shell% setenv r
08b0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6d 61 emoteServerIP ma
08c0: 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 72 76 chine.where.serv
08d0: 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 73 68 er.runs.# sh
08e0: 65 6c 6c 25 20 73 65 6e 65 74 76 20 72 65 6d 6f ell% senetv remo
08f0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 teServerPort 204
0900: 38 0a 23 20 0a 23 20 54 68 65 20 70 72 65 61 6d 8.# .# The pream
0910: 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 6b 65 ble of the socke
0920: 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 65 63 t.test file chec
0930: 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 68 65 ks to see if the
0940: 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 73 variables are s
0950: 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e 20 54 et.# either in T
0960: 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 6e 76 cl or in the env
0970: 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 68 65 ironment; if the
0980: 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 6d 70 y are, it attemp
0990: 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f ts to connect to
09a0: 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e 20 49 .# the server. I
09b0: 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e f the connection
09c0: 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 is successful,
09d0: 74 68 65 20 74 65 73 74 73 20 75 73 69 6e 67 20 the tests using
09e0: 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 the remote.# ser
09f0: 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 72 66 ver will be perf
0a00: 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 73 65 ormed; otherwise
0a10: 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 6d 70 , it will attemp
0a20: 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 72 t to start the r
0a30: 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 28 emote.# server (
0a40: 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 6c 61 via exec) on pla
0a50: 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 tforms that supp
0a60: 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 68 65 ort this, on the
0a70: 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 20 6c local host,.# l
0a80: 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f 72 74 istening at port
0a90: 20 32 30 34 38 2e 20 49 66 20 61 6c 6c 20 66 61 2048. If all fa
0aa0: 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 20 69 ils, a message i
0ab0: 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 74 68 s printed and th
0ac0: 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e 67 20 e tests.# using
0ad0: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0ae0: 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 6f 72 r are not perfor
0af0: 6d 65 64 2e 0a 0a 69 66 20 7b 5b 6c 73 65 61 72 med...if {[lsear
0b00: 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 68 ch [namespace ch
0b10: 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 73 ildren] ::tcltes
0b20: 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 t] == -1} {.
0b30: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0b40: 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d 65 tcltest. name
0b50: 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 6f space import -fo
0b60: 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 2a rce ::tcltest::*
0b70: 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 20 74 .}..# Load the t
0b80: 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 ls package.packa
0b90: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a ge require tls..
0ba0: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 5b set serverCert [
0bb0: 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c file join $::tcl
0bc0: 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 63 test::testsDirec
0bd0: 74 6f 72 79 20 63 65 72 74 73 20 73 65 72 76 65 tory certs serve
0be0: 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e r.pem].set clien
0bf0: 74 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e tCert [file join
0c00: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 $::tcltest::tes
0c10: 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 tsDirectory cert
0c20: 73 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 s client.pem].se
0c30: 74 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 6a t caCert [file j
0c40: 6f 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a oin $::tcltest::
0c50: 74 65 73 74 73 44 69 72 65 63 74 6f 72 79 20 63 testsDirectory c
0c60: 65 72 74 73 20 63 61 63 65 72 74 2e 70 65 6d 5d erts cacert.pem]
0c70: 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 5b .set serverKey [
0c80: 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c file join $::tcl
0c90: 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 63 test::testsDirec
0ca0: 74 6f 72 79 20 63 65 72 74 73 20 73 6b 65 79 2e tory certs skey.
0cb0: 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b pem].set clientK
0cc0: 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a ey [file join $:
0cd0: 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 :tcltest::testsD
0ce0: 69 72 65 63 74 6f 72 79 20 63 65 72 74 73 20 63 irectory certs c
0cf0: 6b 65 79 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 key.pem]..# Some
0d00: 20 74 65 73 74 73 20 72 65 71 75 69 72 65 20 74 tests require t
0d10: 68 65 20 74 65 73 74 74 68 72 65 61 64 20 63 6f he testthread co
0d20: 6d 6d 61 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 6c mmand..set ::tcl
0d30: 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 test::testConstr
0d40: 61 69 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 aints(testthread
0d50: 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 ) \..[expr {[inf
0d60: 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 o commands testt
0d70: 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a hread] != {}}]..
0d80: 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 #.# If remoteSer
0d90: 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 verIP or remoteS
0da0: 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f erverPort are no
0db0: 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 t set, check in
0dc0: 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e the.# environmen
0dd0: 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 t variables for
0de0: 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 externally set v
0df0: 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b alues..#..if {![
0e00: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0e10: 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 teServerIP]} {.
0e20: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0e30: 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 sts env(remoteSe
0e40: 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 rverIP)]} {..set
0e50: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0e60: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
0e70: 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 rIP). }.}.if
0e80: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0e90: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d emoteServerPort]
0ea0: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
0eb0: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d o exists env(rem
0ec0: 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d 20 7b oteServerIP)]} {
0ed0: 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 ..set remoteServ
0ee0: 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f erPort $env(remo
0ef0: 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 teServerPort).
0f00: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
0f10: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0f20: 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 sts remoteServer
0f30: 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 IP]} {.. set
0f40: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0f50: 20 32 30 34 38 0a 20 20 20 20 20 20 20 20 7d 0a 2048. }.
0f60: 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 }.}..#.# Che
0f70: 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 70 ck if we're supp
0f80: 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 osed to do tests
0f90: 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d against the rem
0fa0: 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 ote server.#..se
0fb0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
0fc0: 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b oteServer 1.if {
0fd0: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 ![info exists re
0fe0: 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 moteServerIP] &&
0ff0: 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 ($tcl_platform(
1000: 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 platform) != "ma
1010: 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 cintosh")} {.
1020: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
1030: 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a rIP 127.0.0.1.}.
1040: 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 if {($doTestsWit
1050: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
1060: 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 1) && (![info e
1070: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
1080: 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 erPort])} {.
1090: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
10a0: 50 6f 72 74 20 32 30 34 38 0a 7d 0a 0a 23 20 41 Port 2048.}..# A
10b0: 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 ttempt to connec
10c0: 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 t to a remote se
10d0: 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 rver if one is a
10e0: 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 lready running.
10f0: 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 If it.# is not r
1100: 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f unning or for so
1110: 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 me other reason
1120: 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c the connect fail
1130: 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 s, attempt to.#
1140: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
1150: 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c server on the l
1160: 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e ocal host listen
1170: 69 6e 67 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 ing on port 2048
1180: 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 . This.# is only
1190: 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 done on platfor
11a0: 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 ms that support
11b0: 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f exec (i.e. not o
11c0: 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 n the Mac). On.#
11d0: 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 platforms that
11e0: 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 do not support e
11f0: 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 xec, the remote
1200: 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 server must be s
1210: 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 tarted.# by the
1220: 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e user before runn
1230: 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a ing the tests...
1240: 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 set remoteProcCh
1250: 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e an "".set comman
1260: 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 dSocket "".if {$
1270: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1280: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 eServer} {. c
1290: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
12a0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 mandSocket}.
12b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
12c0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 commandSocket [t
12d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
12e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
12f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
1300: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
1310: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
1320: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
1330: 49 50 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 IP \.. $remot
1340: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 eServerPort]}] !
1350: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
1360: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d o commands exec]
1370: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 == ""} {.. s
1380: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1390: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 eason "can't exe
13a0: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 c".. set doTe
13b0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
13c0: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a ver 0..} else {.
13d0: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
13e0: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e erverIP 127.0.0.
13f0: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 1.. set remot
1400: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e eFile [file join
1410: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 [pwd] remote.tc
1420: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 l].. if {[cat
1430: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 ch {set remotePr
1440: 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 ocChan \.....[op
1450: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
1460: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 ltest::tcltest $
1470: 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 remoteFile \....
1480: 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e ..-serverIsSilen
1490: 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 t \......-port $
14a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
14b0: 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 \......-address
14c0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
14d0: 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c ]" \......w+]} \
14e0: 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d ... msg] == 0}
14f0: 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a {...after 1000.
1500: 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 ..if {[catch {se
1510: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
1520: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
1530: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
1540: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
1550: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
1560: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
1570: 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 .....$remoteServ
1580: 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f erIP \.....$remo
1590: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d teServerPort]} m
15a0: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 sg] == 0} {...
15b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f fconfigure $co
15c0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
15d0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
15e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 uffering line...
15f0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
1600: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1610: 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 eason $msg...
1620: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
1630: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
1640: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
1650: 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 ...set noRemoteT
1660: 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 estReason "$msg
1670: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
1680: 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 est"...set doTes
1690: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
16a0: 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 er 0.. }..}.
16b0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f } else {..fco
16c0: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
16d0: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
16e0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
16f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d ing line. }.}
1700: 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 ..# Some tests a
1710: 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 re run only if w
1720: 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 e are doing test
1730: 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 ing against a re
1740: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 mote server..set
1750: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
1760: 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 Constraints(doTe
1770: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1780: 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 ver) $doTestsWit
1790: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 hRemoteServer.if
17a0: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
17b0: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d moteServer == 0}
17c0: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 {. if {[stri
17d0: 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 ng first s $::tc
17e0: 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 ltest::verbose]
17f0: 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 != -1} {. .pu
1800: 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 ts "Skipping tes
1810: 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 ts with remote s
1820: 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 erver. See tests
1830: 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 /socket.test for
1840: 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 "..puts "informa
1850: 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 tion on how to r
1860: 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 un remote server
1870: 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e ."..puts "Reason
1880: 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 for not doing r
1890: 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f emote tests: $no
18a0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
18b0: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 ". }.}..#.# I
18c0: 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 f we do the test
18d0: 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d s, define a comm
18e0: 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f and to send a co
18f0: 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 mmand to the.# r
1900: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a emote server..#.
1910: 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 .if {$doTestsWit
1920: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
1930: 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 1} {. proc s
1940: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b endCommand {c} {
1950: 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 ..global command
1960: 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f Socket...if {[eo
1970: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
1980: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1990: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
19a0: 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a isappeared"..}..
19b0: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 .if {[catch {put
19c0: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
19d0: 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 $c} msg]} {..
19e0: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
19f0: 73 65 72 76 65 72 20 64 69 73 61 70 70 61 65 72 server disappaer
1a00: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 ed: $msg"..}..if
1a10: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1a20: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d commandSocket "-
1a30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1a40: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d -Marker--"} msg]
1a50: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1a60: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1a70: 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 sappeared: $msg"
1a80: 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 ..}...set resp "
1a90: 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 "..while {1} {..
1aa0: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 set line [ge
1ab0: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1ac0: 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 t].. if {[eof
1ad0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1ae0: 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d } {...error "rem
1af0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1b00: 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 peared".. }..
1b10: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1b20: 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d compare $line "-
1b30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1b40: 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 -Marker--"] == 0
1b50: 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e } {...if {[strin
1b60: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
1b70: 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 x $resp 0] error
1b80: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1b90: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1ba0: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1bb0: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1bc0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1bd0: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1be0: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1bf0: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1c00: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 }..}. }.}..te
1c10: 73 74 20 74 6c 73 49 6f 2d 31 2e 31 20 7b 61 72 st tlsIo-1.1 {ar
1c20: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1c30: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1c40: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1c50: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1c60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
1c70: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1c80: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1c90: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1ca0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
1cb0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
1cc0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
1cd0: 6f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 o-1.2 {arg parsi
1ce0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1cf0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1d00: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1d10: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1d20: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
1d30: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1d40: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1d50: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1d60: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
1d70: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
1d80: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 }}..test tlsIo-1
1d90: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
1da0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1db0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1dc0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1dd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1de0: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
1df0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1e00: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1e10: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
1e20: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
1e30: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 2e 34 ..test tlsIo-1.4
1e40: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1e50: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1e60: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
1e70: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
1e80: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
1e90: 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 r 127.0.0.1} msg
1ea0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1eb0: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1ec0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1ed0: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
1ee0: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
1ef0: 6c 73 49 6f 2d 31 2e 35 20 7b 61 72 67 20 70 61 lsIo-1.5 {arg pa
1f00: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1f10: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1f20: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1f30: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1f40: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
1f50: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1f60: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1f70: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1f80: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
1f90: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
1fa0: 49 6f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 Io-1.6 {arg pars
1fb0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1fc0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1fd0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1fe0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1ff0: 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 -myport xxxx} ms
2000: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2010: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2020: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2030: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2040: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2050: 74 6c 73 49 6f 2d 31 2e 37 20 7b 61 72 67 20 70 tlsIo-1.7 {arg p
2060: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2070: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2080: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2090: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
20a0: 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d et -myport 2522}
20b0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
20c0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
20d0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
20e0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
20f0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2100: 73 74 20 74 6c 73 49 6f 2d 31 2e 38 20 7b 61 72 st tlsIo-1.8 {ar
2110: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2120: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2130: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2140: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2150: 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d ocket -froboz} m
2160: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2170: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2180: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2190: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
21a0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
21b0: 20 74 6c 73 49 6f 2d 31 2e 39 20 7b 61 72 67 20 tlsIo-1.9 {arg
21c0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
21d0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
21e0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
21f0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2200: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 ket -server foo
2210: 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 -myport 2521 333
2220: 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 3} msg] $msg.} {
2230: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2240: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2250: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2260: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2270: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2280: 74 6c 73 49 6f 2d 31 2e 31 30 20 7b 61 72 67 20 tlsIo-1.10 {arg
2290: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
22a0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
22b0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
22c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
22d0: 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a ket host 2528 -j
22e0: 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d unk} msg] $msg.}
22f0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2300: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2310: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2320: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2330: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 2e 31 ..test tlsIo-1.1
2340: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
2350: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2360: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2370: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2380: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2390: 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 er callback 2520
23a0: 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d --} msg] $msg.}
23b0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
23c0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
23d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
23e0: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
23f0: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2400: 74 20 74 6c 73 49 6f 2d 31 2e 31 32 20 7b 61 72 t tlsIo-1.12 {ar
2410: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2420: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2430: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2440: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2450: 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 ocket foo badpor
2460: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
2470: 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 1 {expected inte
2480: 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 ger but got "bad
2490: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
24a0: 73 49 6f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e sIo-2.1 {tcp con
24b0: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
24c0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
24d0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
24e0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
24f0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2500: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
2510: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2520: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2530: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
2540: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d imed_out"]. }
2550: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2560: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2570: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2580: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2590: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
25a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
25b0: 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 38 20 $serverKey 2828
25c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
25d0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
25e0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
25f0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
2600: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
2610: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
2620: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 e $file..}..puts
2630: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2640: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2650: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
2660: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
2670: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2680: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2690: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
26a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
26b0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
26c0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
26d0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
26e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
26f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2700: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2710: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2720: 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 2828} msg]}
2730: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
2740: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
2750: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
2760: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2770: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
2780: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
2790: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
27a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
27b0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
27c0: 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 one {}}..if [inf
27d0: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b o exists port] {
27e0: 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d . incr port.}
27f0: 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 else { . set
2800: 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 34 38 port [expr 2048
2810: 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d + [pid]%1024].}
2820: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 32 ..test tlsIo-2.2
2830: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2840: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 with client por
2850: 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f t specified} {so
2860: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
2870: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
2880: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
2890: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
28a0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
28b0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
28c0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
28d0: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
28e0: 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one"]. }.
28f0: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
2900: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
2910: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
2920: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
2930: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
2940: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
2950: 65 72 4b 65 79 20 32 38 32 39 20 5c 5d 22 0a 20 erKey 2829 \]".
2960: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
2970: 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 oc accept {file
2980: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
2990: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
29a0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
29b0: 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d ts "[gets $file]
29c0: 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 $port".
29d0: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
29e0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
29f0: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
2a00: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
2a10: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
2a20: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
2a30: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2a40: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2a50: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
2a60: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
2a70: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
2a80: 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 s $f x. globa
2a90: 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b l port. if {[
2aa0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2ab0: 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 et -myport $port
2ac0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
2ad0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2ae0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2af0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2b00: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 7d 127.0.0.1 2829}
2b10: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
2b20: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 set x $sock..c
2b30: 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 atch {close [tls
2b40: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
2b50: 2e 31 20 32 38 32 39 5d 7d 0a 20 20 20 20 7d 20 .1 2829]}. }
2b60: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
2b70: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
2b80: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
2b90: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
2ba0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
2bb0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
2bc0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2bd0: 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 set x.} [lis
2be0: 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 t ready "hello $
2bf0: 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c 73 port"]..test tls
2c00: 49 6f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e Io-2.3 {tcp conn
2c10: 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 ection with clie
2c20: 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 nt interface spe
2c30: 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 cified} {socket
2c40: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
2c50: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
2c60: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
2c70: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
2c80: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
2c90: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
2ca0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
2cb0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
2cc0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
2cd0: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
2ce0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2cf0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
2d00: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
2d10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
2d20: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
2d30: 20 32 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 2830 \]". pu
2d40: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
2d50: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
2d60: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
2d70: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
2d80: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
2d90: 67 65 74 73 20 24 66 69 6c 65 5d 20 24 61 64 64 gets $file] $add
2da0: 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 r". c
2db0: 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 lose $file.
2dc0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
2dd0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
2de0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
2df0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
2e00: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
2e10: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
2e20: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
2e30: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
2e40: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
2e50: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
2e60: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
2e70: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
2e80: 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 yaddr 127.0.0.1
2e90: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
2ea0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
2eb0: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
2ec0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
2ed0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 20 127.0.0.1 2830}
2ee0: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
2ef0: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
2f00: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
2f10: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
2f20: 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 lo..catch {flush
2f30: 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 $sock}.
2f40: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
2f50: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
2f60: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
2f70: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2f80: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 et x.} {ready {h
2f90: 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d ello 127.0.0.1}}
2fa0: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 34 ..test tlsIo-2.4
2fb0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2fc0: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
2fd0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2fe0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2ff0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3000: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3010: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3020: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3030: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3040: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3050: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3060: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3070: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3080: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3090: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
30a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
30b0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
30c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
30d0: 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 $serverKey -myad
30e0: 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d dr [info hostnam
30f0: 65 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 20 e] 2831 \]".
3100: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3110: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
3120: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
3130: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3140: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
3150: 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 "[gets $file]".
3160: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
3170: 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 $file.
3180: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
3190: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
31a0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
31b0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
31c0: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
31d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
31e0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
31f0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3200: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3210: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
3220: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
3230: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3240: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3250: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3260: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3270: 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 entKey [info hos
3280: 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f 63 tname] 2831} soc
3290: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
32a0: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
32b0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
32c0: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
32d0: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
32e0: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
32f0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3300: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3310: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3320: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
3330: 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 dy hello}..test
3340: 74 6c 73 49 6f 2d 32 2e 35 20 7b 74 63 70 20 63 tlsIo-2.5 {tcp c
3350: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 onnection with r
3360: 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 edundant server
3370: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 port} {socket st
3380: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
3390: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
33a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
33b0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
33c0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
33d0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
33e0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
33f0: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
3400: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
3410: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
3420: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
3430: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
3440: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
3450: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
3460: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
3470: 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 832 \]". puts
3480: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
3490: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
34a0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
34b0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
34c0: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
34d0: 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 ts $file]".
34e0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
34f0: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
3500: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
3510: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
3520: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3530: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3540: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3550: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
3560: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3570: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3580: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3590: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
35a0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
35b0: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
35c0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
35d0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
35e0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
35f0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 ey 127.0.0.1 283
3600: 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 2} sock]} {.
3610: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
3620: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
3630: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
3640: 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f hello..flush $so
3650: 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 ck. lappe
3660: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
3670: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
3680: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ck. }. clo
3690: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
36a0: 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a } {ready hello}.
36b0: 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 36 20 7b test tlsIo-2.6 {
36c0: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
36d0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
36e0: 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 et status ok.
36f0: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 if {![catch {se
3700: 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 t sock [tls::soc
3710: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
3720: 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 33]}]} {..if {![
3730: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f 63 catch {gets $soc
3740: 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 k}]} {.. set
3750: 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d status broken..}
3760: 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 ..close $sock.
3770: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 }. set stat
3780: 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c us.} ok..test tl
3790: 73 49 6f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 sIo-2.7 {echo se
37a0: 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 rver, one line}
37b0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
37c0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
37d0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
37e0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
37f0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3800: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3810: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
3820: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3830: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3840: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3850: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3860: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3870: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
3880: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3890: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
38a0: 65 72 76 65 72 4b 65 79 20 32 38 33 34 20 5c 5d erverKey 2834 \]
38b0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
38c0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
38d0: 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 a p} {.
38e0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
38f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
3900: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
3910: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
3920: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
3930: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
3940: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
3950: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 20 {s} {.. set
3960: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
3970: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
3980: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
3990: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
39a0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
39b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
39d0: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
39e0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 } else {.
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a00: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
3a10: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 }..}..pu
3a20: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
3a30: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3a40: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3a50: 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 ..puts done.
3a60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3a70: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
3a80: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
3a90: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
3aa0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
3ab0: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
3ac0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3ad0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3ae0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3af0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3b00: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
3b10: 20 32 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 2834]. fconf
3b20: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
3b30: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
3b40: 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 ation lf. put
3b50: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
3b60: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 efghijklmnop".
3b70: 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 after 1000.
3b80: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d set x [gets $s]
3b90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
3ba0: 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 set y [gets $f
3bb0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
3bc0: 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 list $x $y.}
3bd0: 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 {{hello abcdefgh
3be0: 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a ijklmnop} done}.
3bf0: 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 38 20 .test tlsIo-2.8
3c00: 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f {echo server, lo
3c10: 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e op 50 times, sin
3c20: 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 gle connection}
3c30: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
3c40: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3c50: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
3c60: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
3c70: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3c80: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
3c90: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
3ca0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3cb0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
3cc0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
3cd0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3ce0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3cf0: 79 20 32 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 y 2835 \]". p
3d00: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3d10: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
3d30: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
3d40: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
3d50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
3d60: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
3d70: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
3d80: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
3d90: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
3da0: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
3db0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
3dc0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
3dd0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3df0: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3e00: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3e10: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
3e20: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
3e40: 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 se { ..
3e50: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
3e60: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
3e70: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
3e80: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 }..}..set i 0..p
3e90: 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 uts ready..set t
3ea0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3eb0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3ec0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3ed0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3ee0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 lose $f..puts "d
3ef0: 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 one $i". }.
3f00: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3f10: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3f20: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3f30: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3f40: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
3f50: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
3f60: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
3f70: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
3f80: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
3f90: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
3fa0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 ey 127.0.0.1 283
3fb0: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 5]. fconfigur
3fc0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
3fd0: 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b line. catch {
3fe0: 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 ..for {set x 0}
3ff0: 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 {$x < 50} {incr
4000: 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 x} {.. puts $
4010: 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 s "hello abcdefg
4020: 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 hijklmnop"..
4030: 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d gets $s..}. }
4040: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
4050: 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b catch {set x [
4060: 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c gets $f]}. cl
4070: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
4080: 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 .} {done 50}..te
4090: 73 74 20 74 6c 73 49 6f 2d 32 2e 39 20 7b 73 6f st tlsIo-2.9 {so
40a0: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
40b0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
40c0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
40d0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
40e0: 63 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 ccept 2828].
40f0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
4100: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
4110: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4120: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
4130: 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 75 $f {package requ
4140: 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f ire tls; tls::so
4150: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4160: 65 70 74 20 32 38 32 38 7d 0a 20 20 20 20 63 6c ept 2828}. cl
4170: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
4180: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
4190: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
41a0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
41b0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 gets $f. a
41c0: 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 fter 100. set
41d0: 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 x [list [catch
41e0: 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 {close $f} msg]
41f0: 24 6d 73 67 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $msg]. close
4200: 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $s. set x.} {
4210: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
4220: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
4230: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 0a already in use.
4240: 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 75 74 while execut
4250: 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 74 20 2d 73 ing."::socket -s
4260: 65 72 76 65 72 20 7b 74 6c 73 3a 3a 5f 61 63 63 erver {tls::_acc
4270: 65 70 74 20 7b 2d 73 65 72 76 65 72 20 31 7d 20 ept {-server 1}
4280: 61 63 63 65 70 74 7d 20 32 38 32 38 22 0a 20 20 accept} 2828".
4290: 20 20 28 22 65 76 61 6c 22 20 62 6f 64 79 20 6c ("eval" body l
42a0: 69 6e 65 20 31 29 0a 20 20 20 20 69 6e 76 6f 6b ine 1). invok
42b0: 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 ed from within."
42c0: 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 74 20 24 73 eval ::socket $s
42d0: 6f 70 74 73 22 0a 20 20 20 20 28 70 72 6f 63 65 opts". (proce
42e0: 64 75 72 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 dure "tls::socke
42f0: 74 22 20 6c 69 6e 65 20 36 32 29 0a 20 20 20 20 t" line 62).
4300: 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 invoked from wit
4310: 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 hin."tls::socket
4320: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4330: 32 38 32 38 22 0a 20 20 20 20 28 66 69 6c 65 20 2828". (file
4340: 22 73 63 72 69 70 74 22 20 6c 69 6e 65 20 31 29 "script" line 1)
4350: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 }}..test tlsIo-2
4360: 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 .10 {close on ac
4370: 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 cept, accepted s
4380: 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f ocket lives} {so
4390: 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b cket knownBug} {
43a0: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
43b0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
43c0: 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 fter 20000 "set
43d0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
43e0: 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 . set ss [tls
43f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4400: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
4410: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
4420: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
4430: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
4440: 72 4b 65 79 20 32 38 33 30 5d 0a 20 20 20 20 70 rKey 2830]. p
4450: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4460: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a p} {..global ss.
4470: 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 .close $ss..file
4480: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
4490: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 e "readit $s"..f
44a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
44b0: 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 ans lf. }.
44c0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
44d0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a {..global done.
44e0: 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 .gets $s..close
44f0: 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 $s..set done 1.
4500: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 }. set cs
4510: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4520: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4530: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4540: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4550: 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 clientKey [info
4560: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a hostname] 2830].
4570: 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 close $cs..
4580: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
4590: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
45a0: 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f timer. set do
45b0: 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 ne.} 1..test tls
45c0: 49 6f 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 69 Io-2.11 {detecti
45d0: 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f ng new data} {so
45e0: 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b cket knownBug} {
45f0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
4600: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
4610: 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 6f 63 al sock..set soc
4620: 6b 20 24 73 0a 09 73 65 74 20 66 20 5b 6f 70 65 k $s..set f [ope
4630: 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a 09 70 75 n awb.log w]..pu
4640: 74 73 20 24 66 20 5b 63 61 74 63 68 20 7b 74 6c ts $f [catch {tl
4650: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 6f s::handshake $so
4660: 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 73 20 24 ck} err]..puts $
4670: 66 20 22 65 72 72 3a 20 24 65 72 72 22 0a 09 70 f "err: $err"..p
4680: 75 74 73 20 24 66 20 22 5b 74 6c 73 3a 3a 73 74 uts $f "[tls::st
4690: 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a 09 63 6c atus $sock]"..cl
46a0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 0a 20 20 ose $s. }..
46b0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
46c0: 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 cket -require 0
46d0: 2d 72 65 71 75 65 73 74 20 30 20 2d 73 65 72 76 -request 0 -serv
46e0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
46f0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
4700: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4710: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 \..-keyfile $ser
4720: 76 65 72 4b 65 79 20 32 34 30 30 5d 0a 20 20 20 verKey 2400].
4730: 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 set sock "".
4740: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
4750: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
4760: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
4770: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4780: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4790: 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 30 30 y 127.0.0.1 2400
47a0: 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b ]. vwait sock
47b0: 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e . puts $s2 on
47c0: 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a e. flush $s2.
47d0: 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 after 500.
47e0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
47f0: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ck -blocking 0.
4800: 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 5b 67 set result [g
4810: 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c ets $sock]. l
4820: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 append result [g
4830: 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 ets $sock]. f
4840: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
4850: 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 -blocking 1.
4860: 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 puts $s2 two.
4870: 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 flush $s2. f
4880: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
4890: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
48a0: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
48b0: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
48c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
48d0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
48e0: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
48f0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
4900: 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 e $sock. set
4910: 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d result.} {one {}
4920: 20 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 two}..test tlsI
4930: 6f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e o-2.12 {tcp conn
4940: 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 ection; no certi
4950: 66 69 63 61 74 65 73 20 73 70 65 63 69 66 69 65 ficates specifie
4960: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
4970: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
4980: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
4990: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
49a0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
49b0: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
49c0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
49d0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
49e0: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
49f0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
4a00: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
4a10: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4a20: 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 2828]..proc acce
4a30: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
4a40: 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rt} {.. globa
4a50: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
4a60: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
4a70: 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 close $file..}..
4a80: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
4a90: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
4aa0: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
4ab0: 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 $f..puts $x.
4ac0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
4ad0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
4ae0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
4af0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
4b00: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
4b10: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
4b20: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
4b30: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 7d 127.0.0.1 2828}
4b40: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
4b50: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
4b60: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
4b70: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
4b80: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
4b90: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
4ba0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
4bb0: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
4bc0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
4bd0: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
4be0: 0a 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 33 2e ...test tlsIo-3.
4bf0: 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 1 {socket confli
4c00: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
4c10: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
4c20: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
4c30: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
4c40: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
4c50: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
4c60: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
4c70: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4c80: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
4c90: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4ca0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4cb0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4cc0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4cd0: 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 38 $serverKey 2828
4ce0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
4cf0: 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 {..puts ready..
4d00: 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 gets stdin..clos
4d10: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
4d20: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4d30: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4d40: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4d50: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
4d60: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4d70: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
4d80: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
4d90: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
4da0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4db0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4dc0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4dd0: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
4de0: 20 61 63 63 65 70 74 20 32 38 32 38 7d 20 6d 73 accept 2828} ms
4df0: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
4e00: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
4e10: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4e20: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
4e30: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4e40: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4e50: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
4e60: 6c 73 49 6f 2d 33 2e 32 20 7b 73 65 72 76 65 72 lsIo-3.2 {server
4e70: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
4e80: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
4e90: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
4ea0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4eb0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4ec0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4ed0: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4ee0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
4ef0: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
4f00: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4f10: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b _out"]..set t2 [
4f20: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
4f30: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
4f40: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
4f50: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4f60: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e _out"]..set coun
4f70: 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 ter 0. }.
4f80: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
4f90: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
4fa0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4fb0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4fc0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4fd0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
4fe0: 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 erKey 2828 \]".
4ff0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
5000: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
5010: 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 } {.. fileeve
5020: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
5030: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
5040: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5050: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5060: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
5070: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
5080: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
5090: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
50a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
50b0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
50d0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
50e0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
50f0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
5100: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5110: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
5120: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
5130: 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 }..}..puts re
5140: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5150: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 ter cancel $t1..
5160: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5170: 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 ancel $t2..vwait
5180: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5190: 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 $t3..close $s..
51a0: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
51b0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
51c0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
51d0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
51e0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
51f0: 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 r+]. set x [g
5200: 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 ets $f]. set
5210: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
5220: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5230: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5240: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5250: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
5260: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
5270: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
5280: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
5290: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
52a0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
52b0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
52c0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
52d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
52e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
52f0: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5300: 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 .0.1 2828]. f
5310: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
5320: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5330: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
5340: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5350: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5360: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5370: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5380: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5390: 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 7.0.0.1 2828].
53a0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
53b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
53c0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
53d0: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
53e0: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
53f0: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
5400: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5410: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
5420: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
5430: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
5440: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5450: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
5460: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
5470: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
5480: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
5490: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
54a0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 {ready done}..t
54b0: 65 73 74 20 74 6c 73 49 6f 2d 34 2e 31 20 7b 73 est tlsIo-4.1 {s
54c0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
54d0: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
54e0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
54f0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5500: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5510: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5520: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
5530: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5540: 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a tls..gets stdin.
5550: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
5560: 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a f "set s \[tls::
5570: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
5580: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5590: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
55a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
55b0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 20 127.0.0.1 2828
55c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
55d0: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
55e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
55f0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 ..for {set i 0}
5600: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
5610: 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 i} {.. puts
5620: 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 $s hello.. ge
5630: 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 ts $s..}..close
5640: 24 73 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 $s..puts bye..ge
5650: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
5660: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5670: 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b set p1 [open "|[
5680: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5690: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
56a0: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
56b0: 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 gure $p1 -buffer
56c0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
56d0: 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p2 [open "|[lis
56e0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
56f0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5700: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5710: 65 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 e $p2 -buffering
5720: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 line. set p3
5730: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5740: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5750: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5760: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5770: 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p3 -buffering li
5780: 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 ne. proc acce
5790: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
57a0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
57b0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
57c0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
57d0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
57e0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
57f0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f echo {s} {..glo
5800: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 bal x. se
5810: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
5820: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 if {[eof $
5830: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 s]} {.
5840: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
5850: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
5860: 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 e. } else
5870: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 {. p
5880: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
5890: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
58a0: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
58b0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
58c0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 ut"]. set t2
58d0: 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 [after 31000 "se
58e0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
58f0: 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 set t3 [afte
5900: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 r 32000 "set x t
5910: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5920: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5930: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
5940: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
5950: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5960: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
5970: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
5980: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 20 r accept 2828].
5990: 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 65 6e puts $p1 open
59a0: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 6f 70 . puts $p2 op
59b0: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 en. puts $p3
59c0: 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 20 78 open. vwait x
59d0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
59e0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
59f0: 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 er cancel $t1.
5a00: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5a10: 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e t2. after can
5a20: 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 cel $t3. clos
5a30: 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c 20 22 e $s. set l "
5a40: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
5a50: 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 20 24 [list p1 [gets $
5a60: 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 p1] $x]. lapp
5a70: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b end l [list p2 [
5a80: 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 gets $p2] $x].
5a90: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
5aa0: 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 5d 20 t p3 [gets $p3]
5ab0: 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 $x]. puts $p1
5ac0: 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 bye. puts $p
5ad0: 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 2 bye. puts $
5ae0: 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 p3 bye. close
5af0: 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $p1. close $
5b00: 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 33 p2. close $p3
5b10: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 . set l.} {{p
5b20: 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 1 bye done} {p2
5b30: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 bye done} {p3 by
5b40: 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 e done}}..test t
5b50: 6c 73 49 6f 2d 34 2e 32 20 7b 62 79 74 65 20 6f lsIo-4.2 {byte o
5b60: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5b70: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5b80: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
5b90: 0a 20 20 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 . set x ok.
5ba0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
5bb0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5bc0: 72 20 64 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d r dodo 0x3000} m
5bd0: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d sg]} {..set x $m
5be0: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a sg. } else {.
5bf0: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 .close $msg.
5c00: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b }. set x.} ok
5c10: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 35 2e 31 ..test tlsIo-5.1
5c20: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
5c30: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
5c40: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a mbers, htons} \.
5c50: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c .{socket unixOnl
5c60: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 y notRoot} {.
5c70: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
5c80: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5c90: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 t owner}. if
5ca0: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
5cb0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
5cc0: 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a do 0x1} msg]} {.
5cd0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 7b 68 set x {h
5ce0: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tons problem, sh
5cf0: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
5d00: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e ed, are you runn
5d10: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f ing as SU?}..clo
5d20: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5d30: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
5d40: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5d50: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 not owner}.test
5d60: 20 74 6c 73 49 6f 2d 35 2e 32 20 7b 62 79 74 65 tlsIo-5.2 {byte
5d70: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
5d80: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
5d90: 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d htons} {socket}
5da0: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
5db0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5dc0: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 et: port number
5dd0: 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 too high}. if
5de0: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a {![catch {tls::
5df0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
5e00: 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 odo 0x10000} msg
5e10: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 ]} {..set x {por
5e20: 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f t resolution pro
5e30: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
5e40: 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f disallowed}..clo
5e50: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5e60: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
5e70: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5e80: 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f port number too
5e90: 20 68 69 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 high}.test tlsI
5ea0: 6f 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 o-5.3 {byte orde
5eb0: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5ec0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5ed0: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e s} \..{socket un
5ee0: 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 ixOnly notRoot}
5ef0: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 {. set x {cou
5f00: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
5f10: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 t: not owner}.
5f20: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 if {![catch {t
5f30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5f40: 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d er dodo 21} msg]
5f50: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e } {..set x {hton
5f60: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
5f70: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
5f80: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
5f90: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
5fa0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5fb0: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
5fc0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5fd0: 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 t owner}..test t
5fe0: 6c 73 49 6f 2d 36 2e 31 20 7b 61 63 63 65 70 74 lsIo-6.1 {accept
5ff0: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
6000: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 {socket stdio p
6010: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 cCrash} {. re
6020: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
6030: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
6040: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
6050: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
6060: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
6070: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 74 6c ..gets stdin..tl
6080: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
6090: 30 2e 31 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 0.1 2848. }.
60a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
60b0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
60c0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
60d0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
60e0: 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 r+]. proc bg
60f0: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
6100: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
6110: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 rgs. }. pr
6120: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6130: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
6140: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6150: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6160: 63 63 65 70 74 20 32 38 34 38 5d 0a 20 20 20 20 ccept 2848].
6170: 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 puts $f hello.
6180: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6190: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
61a0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
61b0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
61c0: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
61d0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
61e0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
61f0: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
6200: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
6210: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
6220: 74 65 73 74 20 74 6c 73 49 6f 2d 37 2e 31 20 7b test tlsIo-7.1 {
6230: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6240: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6250: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
6260: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
6270: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
6280: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
6290: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
62a0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
62b0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
62c0: 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 uts $f "tls::soc
62d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
62e0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
62f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6300: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6310: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 e $serverKey 282
6320: 30 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0". puts $f {
6330: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
6340: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
6350: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
6360: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
6370: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
6380: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
6390: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
63a0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
63b0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
63c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
63d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
63e0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
63f0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
6400: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
6410: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
6420: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
6430: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
6440: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
6450: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6460: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
6470: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 30 5d 127.0.0.1 2820]
6480: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
6490: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
64a0: 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 ame]. close $
64b0: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 s. close $f.
64c0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
64d0: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
64e0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
64f0: 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e x $p 0] 127.0.0.
6500: 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 1]. lappend l
6510: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
6520: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 32 [lindex $p 2] 2
6530: 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 820]. lappend
6540: 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a l [llength $p].
6550: 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 20 } {0 0 3}..test
6560: 74 6c 73 49 6f 2d 37 2e 32 20 7b 74 65 73 74 69 tlsIo-7.2 {testi
6570: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6580: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
6590: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
65a0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
65b0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
65c0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
65d0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
65e0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
65f0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6600: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
6610: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
6620: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6630: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6640: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6650: 72 76 65 72 4b 65 79 20 32 38 32 31 22 0a 20 20 rverKey 2821".
6660: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
6670: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6680: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6690: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
66a0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
66b0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
66c0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
66d0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
66e0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
66f0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
6700: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6710: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6720: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6730: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6740: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6750: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6760: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6770: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6780: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6790: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
67a0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
67b0: 30 2e 30 2e 31 20 32 38 32 31 5d 0a 20 20 20 20 0.0.1 2821].
67c0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
67d0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
67e0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
67f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6800: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6810: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
6820: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6830: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
6840: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6850: 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 ing equal [linde
6860: 78 20 24 70 20 32 5d 20 32 38 32 31 5d 0a 7d 20 x $p 2] 2821].}
6870: 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a {3 127.0.0.1 0}.
6880: 0a 74 65 73 74 20 74 6c 73 49 6f 2d 37 2e 33 20 .test tlsIo-7.3
6890: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
68a0: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
68b0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
68c0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
68d0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
68e0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
68f0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6900: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6910: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
6920: 61 63 63 65 70 74 20 32 38 32 32 5d 0a 20 20 20 accept 2822].
6930: 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 set l [fconfigu
6940: 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 re $s]. close
6950: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 $s. update.
6960: 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 llength $l.}
6970: 31 32 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 37 12..test tlsIo-7
6980: 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .4 {testing sock
6990: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
69a0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
69b0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
69c0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
69d0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
69e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
69f0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6a00: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
6a10: 65 72 20 61 63 63 65 70 74 20 32 38 32 33 5d 0a er accept 2823].
6a20: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6a30: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
6a40: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
6a50: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
6a60: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
6a70: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
6a80: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
6a90: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
6aa0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
6ab0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6ac0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 clientKey \.
6ad0: 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d .[info hostname]
6ae0: 20 32 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 2823]. set t
6af0: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6b00: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6b10: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
6b20: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6b30: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
6b40: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
6b50: 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $s1. set l ""
6b60: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6b70: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
6b80: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 ength $x].} {282
6b90: 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 3 3}..test tlsIo
6ba0: 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.5 {testing so
6bb0: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
6bc0: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 tions} {socket u
6bd0: 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 nixOrPc} {. s
6be0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6bf0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6c00: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6c10: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6c20: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
6c30: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
6c40: 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 cept 2829]. p
6c50: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6c60: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
6c70: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
6c80: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6c90: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
6ca0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
6cb0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6cc0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6cd0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6ce0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6cf0: 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 32 37 2e tKey \. .127.
6d00: 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 20 0.0.1 2829].
6d10: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6d20: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6d30: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6d40: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6d50: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6d60: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6d70: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6d80: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6d90: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
6da0: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
6db0: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6dc0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 33 127.0.0.1 2829 3
6dd0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 38 2e }..test tlsIo-8.
6de0: 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 1 {testing -asyn
6df0: 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 c flag on socket
6e00: 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 s} {empty socket
6e10: 7d 20 7b 0a 20 20 20 20 23 20 74 65 73 74 20 73 } {. # test s
6e20: 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d 2d 20 eems to hang --
6e30: 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 20 20 awb 6/2/2000.
6e40: 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 74 65 # NOTE: This te
6e50: 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e 20 73 st may fail on s
6e60: 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e 34 20 ome Solaris 2.4
6e70: 73 79 73 74 65 6d 73 2e 20 49 66 20 69 74 20 64 systems. If it d
6e80: 6f 65 73 2c 0a 20 20 20 20 23 20 63 68 65 63 6b oes,. # check
6e90: 20 74 68 61 74 20 79 6f 75 20 68 61 76 65 20 74 that you have t
6ea0: 68 65 73 65 20 70 61 74 63 68 65 73 20 69 6e 73 hese patches ins
6eb0: 74 61 6c 6c 65 64 20 28 75 73 69 6e 67 20 73 68 talled (using sh
6ec0: 6f 77 72 65 76 20 2d 70 29 3a 0a 20 20 20 20 23 owrev -p):. #
6ed0: 0a 20 20 20 20 23 20 31 30 31 39 30 37 2d 30 35 . # 101907-05
6ee0: 2c 20 31 30 31 39 32 35 2d 30 32 2c 20 31 30 31 , 101925-02, 101
6ef0: 39 34 35 2d 31 34 2c 20 31 30 31 39 35 39 2d 30 945-14, 101959-0
6f00: 33 2c 20 31 30 31 39 36 39 2d 30 35 2c 20 31 30 3, 101969-05, 10
6f10: 31 39 37 33 2d 30 33 2c 0a 20 20 20 20 23 20 31 1973-03,. # 1
6f20: 30 31 39 37 37 2d 30 33 2c 20 31 30 31 39 38 31 01977-03, 101981
6f30: 2d 30 32 2c 20 31 30 31 39 38 35 2d 30 31 2c 20 -02, 101985-01,
6f40: 31 30 32 30 30 31 2d 30 33 2c 20 31 30 32 30 30 102001-03, 10200
6f50: 33 2d 30 31 2c 20 31 30 32 30 30 37 2d 30 31 2c 3-01, 102007-01,
6f60: 0a 20 20 20 20 23 20 31 30 32 30 31 31 2d 30 32 . # 102011-02
6f70: 2c 20 31 30 32 30 32 34 2d 30 31 2c 20 31 30 32 , 102024-01, 102
6f80: 30 33 39 2d 30 31 2c 20 31 30 32 30 34 34 2d 30 039-01, 102044-0
6f90: 31 2c 20 31 30 32 30 34 38 2d 30 31 2c 20 31 30 1, 102048-01, 10
6fa0: 32 30 36 32 2d 30 33 2c 0a 20 20 20 20 23 20 31 2062-03,. # 1
6fb0: 30 32 30 36 36 2d 30 34 2c 20 31 30 32 30 37 30 02066-04, 102070
6fc0: 2d 30 31 2c 20 31 30 32 31 30 35 2d 30 31 2c 20 -01, 102105-01,
6fd0: 31 30 32 31 35 33 2d 30 33 2c 20 31 30 32 32 31 102153-03, 10221
6fe0: 36 2d 30 31 2c 20 31 30 32 32 33 32 2d 30 31 2c 6-01, 102232-01,
6ff0: 0a 20 20 20 20 23 20 31 30 31 38 37 38 2d 30 33 . # 101878-03
7000: 2c 20 31 30 31 38 37 39 2d 30 31 2c 20 31 30 31 , 101879-01, 101
7010: 38 38 30 2d 30 33 2c 20 31 30 31 39 33 33 2d 30 880-03, 101933-0
7020: 31 2c 20 31 30 31 39 35 30 2d 30 31 2c 20 31 30 1, 101950-01, 10
7030: 32 30 33 30 2d 30 31 2c 0a 20 20 20 20 23 20 31 2030-01,. # 1
7040: 30 32 30 35 37 2d 30 38 2c 20 31 30 32 31 34 30 02057-08, 102140
7050: 2d 30 31 2c 20 31 30 31 39 32 30 2d 30 32 2c 20 -01, 101920-02,
7060: 31 30 31 39 32 31 2d 30 39 2c 20 31 30 31 39 32 101921-09, 10192
7070: 32 2d 30 37 2c 20 31 30 31 39 32 33 2d 30 33 0a 2-07, 101923-03.
7080: 20 20 20 20 23 0a 20 20 20 20 23 20 49 66 20 61 #. # If a
7090: 66 74 65 72 20 69 6e 73 74 61 6c 6c 69 6e 67 20 fter installing
70a0: 74 68 65 73 65 20 70 61 74 63 68 65 73 20 79 6f these patches yo
70b0: 75 20 61 72 65 20 73 74 69 6c 6c 20 65 78 70 65 u are still expe
70c0: 72 69 65 6e 63 69 6e 67 20 61 0a 20 20 20 20 23 riencing a. #
70d0: 20 70 72 6f 62 6c 65 6d 2c 20 70 6c 65 61 73 65 problem, please
70e0: 20 65 6d 61 69 6c 20 6a 79 6c 40 65 6e 67 2e 73 email jyl@eng.s
70f0: 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 61 76 65 20 un.com. We have
7100: 6e 6f 74 20 6f 62 73 65 72 76 65 64 20 74 68 69 not observed thi
7110: 73 0a 20 20 20 20 23 20 66 61 69 6c 75 72 65 20 s. # failure
7120: 6f 6e 20 53 6f 6c 61 72 69 73 20 32 2e 35 2c 20 on Solaris 2.5,
7130: 73 6f 20 61 6e 6f 74 68 65 72 20 6f 70 74 69 6f so another optio
7140: 6e 20 28 69 6e 73 74 65 61 64 20 6f 66 20 69 6e n (instead of in
7150: 73 74 61 6c 6c 69 6e 67 0a 20 20 20 20 23 20 74 stalling. # t
7160: 68 65 73 65 20 70 61 74 63 68 65 73 29 20 69 73 hese patches) is
7170: 20 74 6f 20 75 70 67 72 61 64 65 20 74 6f 20 53 to upgrade to S
7180: 6f 6c 61 72 69 73 20 32 2e 35 2e 0a 20 20 20 20 olaris 2.5..
7190: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
71a0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
71b0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
71c0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
71d0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
71e0: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
71f0: 63 63 65 70 74 20 32 38 33 30 5d 0a 20 20 20 20 ccept 2830].
7200: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7210: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a p} {..global x.
7220: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c .puts $s bye..cl
7230: 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f ose $s..set x do
7240: 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ne. }. set
7250: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
7260: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
7270: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7280: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7290: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
72a0: 09 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f .-async [info ho
72b0: 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 stname] 2830].
72c0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 vwait x. se
72d0: 74 20 7a 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 t z [gets $s1].
72e0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
72f0: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
7300: 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 t z.} bye..test
7310: 74 6c 73 49 6f 2d 39 2e 31 20 7b 74 65 73 74 69 tlsIo-9.1 {testi
7320: 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e ng spurious even
7330: 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 ts} {empty socke
7340: 74 7d 20 7b 0a 20 20 20 20 23 20 6c 6f 63 6b 73 t} {. # locks
7350: 20 75 70 20 0a 20 20 20 20 73 65 74 20 6c 65 6e up . set len
7360: 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 0. set spuri
7370: 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f ous 0. set do
7380: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 ne 0. proc re
7390: 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 adlittle {s} {..
73a0: 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 global spurious
73b0: 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 done len..set l
73c0: 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 [read $s 1]..if
73d0: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
73e0: 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 $l] == 0} {..
73f0: 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 if {![eof $s]}
7400: 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 {...incr spuriou
7410: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
7420: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
7430: 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 done 1.. }..
7440: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e } else {.. in
7450: 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c cr len [string l
7460: 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 ength $l]..}.
7470: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
7480: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
7490: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
74a0: 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c 6f fering none -blo
74b0: 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 65 cking off..filee
74c0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
74d0: 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 6c [list readlittl
74e0: 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s]. }.
74f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
7500: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7510: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7520: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7530: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7540: 5c 0a 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 \. .-server ac
7550: 63 65 70 74 20 32 38 33 31 5d 0a 20 20 20 20 73 cept 2831]. s
7560: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
7570: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
7580: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7590: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
75a0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
75b0: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
75c0: 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 20 20 20 name] 2831].
75d0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
75e0: 24 63 20 30 31 32 33 34 35 36 37 38 39 30 31 32 $c 0123456789012
75f0: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
7600: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
7610: 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 56789. close
7620: 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 $c. set timer
7630: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
7640: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
7650: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
7660: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
7670: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
7680: 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 lose $s. list
7690: 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a $spurious $len.
76a0: 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 } {0 50}..test t
76b0: 6c 73 49 6f 2d 39 2e 32 20 7b 74 65 73 74 69 6e lsIo-9.2 {testin
76c0: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 g async write, f
76d0: 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 ileevents, flush
76e0: 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b on close} {sock
76f0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 et} {. set fi
7700: 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 rstblock "".
7710: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
7720: 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 i < 5} {incr i}
7730: 7b 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 {set firstblock
7740: 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 "a$firstblock$fi
7750: 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 20 73 rstblock"}. s
7760: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 et secondblock "
7770: 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 ". for {set i
7780: 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 0} {$i < 16} {i
7790: 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 73 65 ncr i} {..set se
77a0: 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 condblock "b$sec
77b0: 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 ondblock$secondb
77c0: 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 20 lock". }.
77d0: 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b set l [tls::sock
77e0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
77f0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7800: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7810: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7820: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
7830: 63 63 65 70 74 20 32 38 33 32 5d 0a 20 20 20 20 ccept 2832].
7840: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7850: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
7860: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
7870: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
7880: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
7890: 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 84 \...-bufferin
78a0: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
78b0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
78c0: 65 61 64 61 62 6c 65 20 24 73 22 0a 20 20 20 20 eadable $s".
78d0: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 }. proc reada
78e0: 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c ble {s} {..set l
78f0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 6c 65 [gets $s]..file
7900: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
7910: 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 e {}..after 1000
7920: 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 respond $s.
7930: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f }. proc respo
7940: 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c nd {s} {..global
7950: 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 74 firstblock..put
7960: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
7970: 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 $firstblock..aft
7980: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
7990: 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 a $s. }. p
79a0: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
79b0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f } {..global seco
79c0: 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d 6e ndblock..puts -n
79d0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
79e0: 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 ondblock..close
79f0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
7a00: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
7a10: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
7a20: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7a30: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7a40: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
7a50: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
7a60: 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 20 66 63 me] 2832]. fc
7a70: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
7a80: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c cking 0 -trans l
7a90: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
7aa0: 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 e. set count
7ab0: 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 0. puts $s he
7ac0: 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 llo. proc rea
7ad0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
7ae0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
7af0: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
7b00: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
7b10: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
7b20: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
7b30: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
7b40: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
7b50: 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 }. fileeve
7b60: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
7b70: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
7b80: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
7b90: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
7ba0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
7bb0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
7bc0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
7bd0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c 0a er. close $l.
7be0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
7bf0: 36 35 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 65566..test tlsI
7c00: 6f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 o-9.3 {testing E
7c10: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
7c20: 65 6d 70 74 79 20 73 6f 63 6b 65 74 7d 20 7b 0a empty socket} {.
7c30: 20 20 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 # hangs.
7c40: 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f proc count_to_eo
7c50: 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 f {s} {..global
7c60: 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 count done timer
7c70: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
7c80: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
7c90: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 {.. incr cou
7ca0: 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 nt.. if {$cou
7cb0: 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 nt > 9} {...clos
7cc0: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
7cd0: 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 true...set count
7ce0: 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d {eof is sticky}
7cf0: 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 ...after cancel
7d00: 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d $timer.. }..}
7d10: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7d20: 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 timerproc {} {..
7d30: 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e global done coun
7d40: 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 t c..set done tr
7d50: 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 ue..set count {t
7d60: 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 imer went off, e
7d70: 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 of is not sticky
7d80: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
7d90: 7d 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 }.. set count
7da0: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
7db0: 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 false. proc w
7dc0: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
7dd0: 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 {s} {..puts $s b
7de0: 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 ye..close $s.
7df0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
7e00: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
7e10: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
7e20: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
7e30: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c nslation lf..fil
7e40: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
7e50: 6c 65 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 le "write_then_c
7e60: 6c 6f 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 lose $s". }.
7e70: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
7e80: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7e90: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7ea0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7eb0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7ec0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
7ed0: 72 20 61 63 63 65 70 74 20 32 38 33 33 5d 0a 20 r accept 2833].
7ee0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
7ef0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7f00: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7f10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7f20: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7f30: 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 ey \. .[info
7f40: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 33 5d 0a hostname] 2833].
7f50: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7f60: 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 c -blocking off
7f70: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
7f80: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
7f90: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
7fa0: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
7fb0: 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 _to_eof $c".
7fc0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7fd0: 20 31 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 1000 timerproc]
7fe0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
7ff0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8000: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f set count.} {eo
8010: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 f is sticky}..re
8020: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
8030: 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 30 2e 31 .test tlsIo-10.1
8040: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
8050: 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b accept callback
8060: 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d error handling}
8070: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8080: 73 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 set goterror 0.
8090: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
80a0: 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 args {global got
80b0: 65 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 error; set goter
80c0: 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 ror 1}. set s
80d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
80e0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
80f0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8100: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8110: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 $serverKey \.
8120: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
8130: 20 32 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 2898]. proc
8140: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8150: 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d close $s; error}
8160: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8170: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
8180: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8190: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
81a0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
81b0: 74 4b 65 79 20 5c 0a 09 31 32 37 2e 30 2e 30 2e tKey \..127.0.0.
81c0: 31 20 32 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 2898]. vwai
81d0: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
81e0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
81f0: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
8200: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
8210: 74 6c 73 49 6f 2d 31 31 2e 31 20 7b 74 63 70 20 tlsIo-11.1 {tcp
8220: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
8230: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8240: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8250: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8260: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
8270: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8280: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
8290: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
82a0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
82b0: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
82c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
82d0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
82e0: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
82f0: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
8300: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8310: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
8320: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8330: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
8340: 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_1_test_server
8350: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
8360: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
8370: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8380: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
8390: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
83a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
83b0: 65 79 20 5c 0a 09 09 32 38 33 34 5d 0a 09 70 72 ey \...2834]..pr
83c0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
83d0: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
83e0: 20 64 6f 6e 65 0a 09 20 20 20 20 74 6c 73 3a 3a done.. tls::
83f0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
8400: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
8410: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
8420: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8430: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8440: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8450: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8460: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8470: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
8480: 49 50 20 32 38 33 34 5d 0a 20 20 20 20 73 65 74 IP 2834]. set
8490: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
84a0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
84b0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
84c0: 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 $socket9_1_test
84d0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
84e0: 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 r.} done..test
84f0: 74 6c 73 49 6f 2d 31 31 2e 32 20 7b 63 6c 69 65 tlsIo-11.2 {clie
8500: 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 74 73 nt specifies its
8510: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 port} {socket d
8520: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
8530: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
8540: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8550: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
8560: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8570: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
8580: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
8590: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
85a0: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
85b0: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
85c0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
85d0: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
85e0: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
85f0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
8600: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
8610: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
8620: 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e sts port]} {..in
8630: 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c cr port. } el
8640: 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b se {..set port [
8650: 65 78 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 expr 2048 + [pid
8660: 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d 0a 20 20 ]%1024]. }.
8670: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
8680: 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 .set socket9_2_t
8690: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
86a0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
86b0: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
86c0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
86d0: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
86e0: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
86f0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
8700: 20 20 20 20 32 38 33 35 5d 0a 09 70 72 6f 63 20 2835]..proc
8710: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8720: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
8730: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 hake $s.. put
8740: 73 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f s $s $p.. clo
8750: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
8760: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8770: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8780: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8790: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
87a0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
87b0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d entKey \.. -m
87c0: 79 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d yport $port $rem
87d0: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 35 oteServerIP 2835
87e0: 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 ]. set r [get
87f0: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
8800: 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $s. sendComma
8810: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
8820: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
8830: 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 }. if {$r ==
8840: 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 $port} {..set re
8850: 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c sult ok. } el
8860: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
8870: 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 broken. }.
8880: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f set result.} o
8890: 6b 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 2e k.test tlsIo-11.
88a0: 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 3 {trying to con
88b0: 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d nect, no server}
88c0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
88d0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
88e0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 } {. set stat
88f0: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b us ok. if {![
8900: 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c catch {set s [tl
8910: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
8920: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
8930: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
8940: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8950: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
8960: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
8970: 70 20 32 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 p 2836]}]} {..if
8980: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
8990: 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 $s}]} {.. set
89a0: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
89b0: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 }..close $s.
89c0: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
89d0: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
89e0: 6f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 o-11.4 {remote e
89f0: 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b cho, one line} {
8a00: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8a10: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8a20: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
8a30: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
8a40: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
8a50: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
8a60: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
8a70: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8a80: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
8a90: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
8aa0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8ab0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
8ac0: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
8ad0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8ae0: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
8af0: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
8b00: 6f 6d 6d 61 6e 64 20 7b 0a 20 20 20 20 09 67 6c ommand {. .gl
8b10: 6f 62 61 6c 20 73 65 72 76 65 72 43 65 72 74 0a obal serverCert.
8b20: 09 67 6c 6f 62 61 6c 20 63 61 43 65 72 74 0a 09 .global caCert..
8b30: 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 4b 65 79 global serverKey
8b40: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 ..set socket10_6
8b50: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8b60: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
8b70: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8b80: 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 ert \...-cafile
8b90: 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 $caCert \...-key
8ba0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8bb0: 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 \...-server acce
8bc0: 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 2836]..proc a
8bd0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8be0: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
8bf0: 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 ake $s.. file
8c00: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
8c10: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
8c20: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
8c30: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
8c40: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8c50: 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 crlf..}..proc e
8c60: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
8c70: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
8c80: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
8c90: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
8ca0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
8cb0: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
8cc0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
8cd0: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
8ce0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8cf0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8d00: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8d10: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8d20: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
8d30: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
8d40: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
8d50: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
8d60: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
8d70: 6e 65 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 ne. puts $f h
8d80: 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b ello. set r [
8d90: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
8da0: 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f se $f. sendCo
8db0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
8dc0: 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 cket10_6_test_se
8dd0: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a rver}. set r.
8de0: 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c } hello..test tl
8df0: 73 49 6f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 sIo-11.5 {remote
8e00: 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d echo, 50 lines}
8e10: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
8e20: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
8e30: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
8e40: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
8e50: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
8e60: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8e70: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
8e80: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8e90: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8ea0: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
8eb0: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
8ec0: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
8ed0: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
8ee0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8ef0: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
8f00: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
8f10: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
8f20: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
8f30: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
8f40: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
8f50: 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 pt \...-certfile
8f60: 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 $serverCert \..
8f70: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
8f80: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 \...-keyfile $s
8f90: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 32 38 33 erverKey \...283
8fa0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
8fb0: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
8fc0: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
8fd0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
8fe0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
8ff0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
9000: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
9010: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
9020: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
9030: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9040: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
9050: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
9060: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
9070: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
9080: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
9090: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
90a0: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
90b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
90c0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
90d0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
90e0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
90f0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9100: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9110: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
9120: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
9130: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
9140: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9150: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
9160: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
9170: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
9180: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
9190: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
91a0: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
91b0: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
91c0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
91d0: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
91e0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
91f0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9200: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
9210: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9220: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
9230: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
9240: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
9250: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
9260: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
9270: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
9280: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
9290: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
92a0: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 32 38 33 ictResult {0 283
92b0: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
92c0: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
92d0: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
92e0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
92f0: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
9300: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c use}}.}..test tl
9310: 73 49 6f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 sIo-11.6 {socket
9320: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
9330: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9340: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9350: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9360: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9370: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9380: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9390: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
93a0: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
93b0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
93c0: 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 6]. if {[catc
93d0: 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a h {set s2 [tls::
93e0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
93f0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9400: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9410: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9420: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
9430: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
9440: 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 36]} msg]} {..se
9450: 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 t result [list 1
9460: 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 $msg]. } els
9470: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9480: 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 [list 0 [lindex
9490: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 [fconfigure $s2
94a0: 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 -sockname] 2]]..
94b0: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a close $s2. }.
94c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
94d0: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 set result.} $
94e0: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a conflictResult..
94f0: 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 2e 37 20 test tlsIo-11.7
9500: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
9510: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
9520: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9530: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9540: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9550: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
9560: 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _9_test_server [
9570: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
9580: 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 -certfile [file
9590: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
95a0: 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 server.pem] \..
95b0: 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a .-cafile [file j
95c0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
95d0: 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 caFile.pem] \...
95e0: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
95f0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9600: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 skey.pem] \...-s
9610: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
9620: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9630: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 {s a p} {.. #
9640: 20 68 61 6e 64 73 68 61 6b 65 20 6c 6f 63 6b 73 handshake locks
9650: 20 75 70 20 74 68 65 20 74 68 72 65 65 20 73 79 up the three sy
9660: 6e 63 68 72 6f 6e 6f 75 73 20 63 6c 69 65 6e 74 nchronous client
9670: 73 0a 09 20 20 20 20 23 20 74 6c 73 3a 3a 68 61 s.. # tls::ha
9680: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9690: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
96a0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
96b0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
96c0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
96d0: 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 cho $s]..}..proc
96e0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
96f0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
9700: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
9710: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
9720: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
9730: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
9740: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
9750: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
9760: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9770: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9780: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9790: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
97a0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
97b0: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
97c0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
97d0: 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $s1 -buffering
97e0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 line. set s2
97f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9800: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9810: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9820: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9830: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9840: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
9850: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
9860: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
9870: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
9880: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
9890: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
98a0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
98b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
98c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
98d0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
98e0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
98f0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9900: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
9910: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
9920: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
9930: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
9940: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 puts $s1 hello,s
9950: 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 1..gets $s1..put
9960: 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 s $s2 hello,s2..
9970: 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 gets $s2..puts $
9980: 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 s3 hello,s3..get
9990: 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 s $s3. }.
99a0: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c close $s1. cl
99b0: 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 ose $s2. clos
99c0: 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f e $s3. sendCo
99d0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
99e0: 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 cket10_9_test_se
99f0: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 69 0a rver}. set i.
9a00: 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 74 20 } 100 ..test
9a10: 74 6c 73 49 6f 2d 31 31 2e 38 20 7b 63 6c 69 65 tlsIo-11.8 {clie
9a20: 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 nt with several
9a30: 73 65 72 76 65 72 73 7d 20 7b 65 6d 70 74 79 20 servers} {empty
9a40: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9a50: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9a60: 7b 0a 20 20 20 20 23 20 74 68 69 73 20 6f 6e 65 {. # this one
9a70: 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d seems to hang -
9a80: 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 - awb 6/2/2000.
9a90: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9aa0: 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 ..set s1 [tls::s
9ab0: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
9ac0: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ile [file join [
9ad0: 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 pwd] certs serve
9ae0: 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 r.pem] \...-cafi
9af0: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9b00: 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 wd] certs caFile
9b10: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 .pem] \...-keyfi
9b20: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9b30: 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 wd] certs skey.p
9b40: 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 em] \...-server
9b50: 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 "accept 4003" 40
9b60: 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 03]..set s2 [tls
9b70: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
9b80: 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 rtfile [file joi
9b90: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 n [pwd] certs se
9ba0: 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 rver.pem] \...-c
9bb0: 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e afile [file join
9bc0: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 [pwd] certs caF
9bd0: 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 ile.pem] \...-ke
9be0: 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e yfile [file join
9bf0: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 [pwd] certs ske
9c00: 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 y.pem] \...-serv
9c10: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 er "accept 4004"
9c20: 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 4004]..set s3 [
9c30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
9c40: 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 -certfile [file
9c50: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
9c60: 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 server.pem] \..
9c70: 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a .-cafile [file j
9c80: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9c90: 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 caFile.pem] \...
9ca0: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
9cb0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9cc0: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 skey.pem] \...-s
9cd0: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
9ce0: 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 05" 4005]..proc
9cf0: 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 accept {mp s a p
9d00: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9d10: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9d20: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 20 20 20 puts $s $mp..
9d30: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
9d40: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
9d50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9d60: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9d70: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9d80: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9d90: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9da0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9db0: 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 IP 4003]. set
9dc0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9dd0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9de0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9df0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9e00: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
9e10: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
9e20: 53 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 ServerIP 4004].
9e30: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
9e40: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9e50: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9e60: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9e70: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9e80: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9e90: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
9ea0: 30 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 005]. set l "
9eb0: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
9ec0: 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 [gets $s1] [gets
9ed0: 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 $s1] [eof $s1]
9ee0: 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 [gets $s2] [gets
9ef0: 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 $s2] [eof $s2]
9f00: 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 \..[gets $s3] [g
9f10: 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 ets $s3] [eof $s
9f20: 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 3]. close $s1
9f30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 . close $s2.
9f40: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 close $s3.
9f50: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
9f60: 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 close $s1..close
9f70: 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a $s2..close $s3.
9f80: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a }. set l.
9f90: 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 } {4003 {} 1 400
9fa0: 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 4 {} 1 4005 {} 1
9fb0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 }..test tlsIo-11
9fc0: 2e 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 .9 {accept callb
9fd0: 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b ack error} {sock
9fe0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9ff0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a000: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
a010: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
a020: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
a030: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
a040: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
a050: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
a060: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
a070: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
a080: 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 t {s a p} {expr
a090: 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 10 / 0}. proc
a0a0: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a bgerror args {.
a0b0: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
a0c0: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
a0d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a0e0: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
a0f0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a100: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
a110: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
a120: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a130: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
a140: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
a150: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a160: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
a170: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
a180: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a190: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
a1a0: 22 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 ". if {[catch
a1b0: 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a {sendCommand {.
a1c0: 09 20 20 20 20 73 65 74 20 70 65 65 72 6e 61 6d . set peernam
a1d0: 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 63 e [fconfigure $c
a1e0: 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 allerSocket -pee
a1f0: 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 rname].. set
a200: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
a210: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c ...-certfile $cl
a220: 69 65 6e 74 43 65 72 74 20 5c 0a 09 09 2d 63 61 ientCert \...-ca
a230: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
a240: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
a250: 74 4b 65 79 20 5c 0a 09 20 20 20 20 09 5b 6c 69 tKey \.. .[li
a260: 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 ndex $peername 0
a270: 5d 20 32 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f ] 2836].. clo
a280: 73 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d se $s. . }} m
a290: 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 sg]} {..close $s
a2a0: 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 ..error $msg.
a2b0: 20 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 }. set timer
a2c0: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
a2d0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
a2e0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
a2f0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
a300: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
a310: 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 s. rename bge
a320: 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 rror {}. set
a330: 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 x.} {{divide by
a340: 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 zero}}..test tls
a350: 49 6f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e Io-11.10 {testin
a360: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
a370: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
a380: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
a390: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a3a0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a3b0: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
a3c0: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
a3d0: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
a3e0: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
a3f0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a400: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
a410: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
a420: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a430: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
a440: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
a450: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a460: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
a470: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
a480: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
a490: 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 10_12_test_serve
a4a0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
a4b0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
a4c0: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
a4d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
a4e0: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
a4f0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
a500: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
a510: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
a520: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 p} {close $s}.
a530: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
a540: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a550: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a560: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a570: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a580: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
a590: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
a5a0: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 73 65 74 IP 2836]. set
a5b0: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
a5c0: 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 s -peername].
a5d0: 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 set n [fconfigu
a5e0: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
a5f0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
a600: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
a610: 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 dex $p 2] [lleng
a620: 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 th $p] [llength
a630: 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $p]. close $s
a640: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a650: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
a660: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
a670: 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 32 }. set l.} {2
a680: 38 33 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 836 3 3}..test t
a690: 6c 73 49 6f 2d 31 31 2e 31 31 20 7b 74 65 73 74 lsIo-11.11 {test
a6a0: 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 ing spurious eve
a6b0: 6e 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b nts} {empty sock
a6c0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
a6d0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a6e0: 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 73 65 # hangs. se
a6f0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
a700: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
a710: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a720: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
a730: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
a740: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a750: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
a760: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
a770: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
a780: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
a790: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
a7a0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
a7b0: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
a7c0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a7d0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
a7e0: 33 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 3_test_server [t
a7f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
a800: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a810: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
a820: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
a830: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
a840: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
a850: 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 ept 2836]..proc
a860: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a870: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
a880: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f hake $s.. fco
a890: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
a8a0: 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c 66 slation "auto lf
a8b0: 22 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 ".. after 100
a8c0: 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 7d writesome $s..}
a8d0: 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 ..proc writesome
a8e0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 {s} {.. for
a8f0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
a900: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
a910: 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 ..puts $s "line
a920: 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 $i from remote s
a930: 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 erver".. }..
a940: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
a950: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e }. set len
a960: 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 0. set spuri
a970: 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f ous 0. set do
a980: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 ne 0. proc re
a990: 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 adlittle {s} {..
a9a0: 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 global spurious
a9b0: 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 done len..set l
a9c0: 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 [read $s 1]..if
a9d0: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
a9e0: 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 $l] == 0} {..
a9f0: 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 if {![eof $s]}
aa00: 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 {...incr spuriou
aa10: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
aa20: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
aa30: 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 done 1.. }..
aa40: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e } else {.. in
aa50: 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c cr len [string l
aa60: 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 ength $l]..}.
aa70: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
aa80: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
aa90: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
aaa0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
aab0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
aac0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
aad0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
aae0: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 2836]. file
aaf0: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
ab00: 65 20 22 72 65 61 64 6c 69 74 74 6c 65 20 24 63 e "readlittle $c
ab10: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
ab20: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
ab30: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
ab40: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
ab50: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
ab60: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
ab70: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
ab80: 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 $socket10_13_te
ab90: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 6c st_server}. l
aba0: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
abb0: 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 0a 74 en.} {0 2690}..t
abc0: 65 73 74 20 74 6c 73 49 6f 2d 31 31 2e 31 32 20 est tlsIo-11.12
abd0: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
abe0: 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 6b 65 74 ckyness} {socket
abf0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
ac00: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
ac10: 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 set counter 0.
ac20: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
ac30: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b proc count_up {
ac40: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
ac50: 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f nter done after_
ac60: 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 id..set l [gets
ac70: 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $s]..if {[eof $s
ac80: 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 ]} {.. incr c
ac90: 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b ounter.. if {
aca0: 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a $counter > 9} {.
acb0: 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 ..set done {EOF
acc0: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
acd0: 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 er cancel $after
ace0: 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 _id...close $s..
acf0: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
ad00: 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 proc timed_ou
ad10: 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 t {} {..global c
ad20: 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 done..set done
ad30: 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 {timed_out, EOF
ad40: 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 is not sticky}..
ad50: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 close $c. }.
ad60: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
ad70: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
ad80: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
ad90: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
ada0: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
adb0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
adc0: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
add0: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
ade0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
adf0: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
ae00: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
ae10: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
ae20: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
ae30: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
ae40: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
ae50: 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 t10_14_test_serv
ae60: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
ae70: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
ae80: 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 erverCert \...-c
ae90: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
aea0: 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
aeb0: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
aec0: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
aed0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
aee0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
aef0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
af00: 20 20 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 after 100 clos
af10: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
af20: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
af30: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
af40: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
af50: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
af60: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
af70: 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 24 72 65 ntKey \. .$re
af80: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
af90: 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 6]. fileevent
afa0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f $c readable "co
afb0: 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 unt_up $c". s
afc0: 65 74 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 et after_id [aft
afd0: 65 72 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 er 1000 timed_ou
afe0: 74 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e t]. vwait don
aff0: 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e e. sendComman
b000: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
b010: 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 10_14_test_serve
b020: 72 7d 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a r}. set done.
b030: 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 } {EOF is sticky
b040: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 }..test tlsIo-11
b050: 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 .13 {testing asy
b060: 6e 63 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 nc write, async
b070: 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f flush, async clo
b080: 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 se} \..{socket d
b090: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
b0a0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 Server} {. pr
b0b0: 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a oc readit {s} {.
b0c0: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f .global count do
b0d0: 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 ne..set l [read
b0e0: 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 $s]..incr count
b0f0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
b100: 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d l]..if {[eof $s]
b110: 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 } {.. close $
b120: 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 s.. set done
b130: 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 1..}. }. s
b140: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
b150: 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a caCert $caCert".
b160: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b170: 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 "set serverCert
b180: 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 $serverCert".
b190: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b1a0: 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c t clientCert $cl
b1b0: 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 ientCert". se
b1c0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
b1d0: 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 erverKey $server
b1e0: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
b1f0: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
b200: 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a Key $clientKey".
b210: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b220: 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 {..set firstbloc
b230: 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 k ""..for {set i
b240: 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 0} {$i < 5} {in
b250: 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 cr i} {...set fi
b260: 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 rstblock "a$firs
b270: 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 tblock$firstbloc
b280: 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e k"..}..set secon
b290: 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b dblock ""..for {
b2a0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
b2b0: 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 6} {incr i} {..
b2c0: 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f set secondblo
b2d0: 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 ck "b$secondbloc
b2e0: 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 k$secondblock"..
b2f0: 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 }..set l [tls::s
b300: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
b310: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
b320: 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 \...-cafile $caC
b330: 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 ert \...-keyfile
b340: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
b350: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
b360: 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 845]..proc accep
b370: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
b380: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
b390: 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 $s.. fconfigu
b3a0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
b3b0: 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 0 -translation l
b3c0: 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 f -buffersize 16
b3d0: 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 384 \...-bufferi
b3e0: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
b3f0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
b400: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
b410: 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 ..}..proc readab
b420: 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 le {s} {.. se
b430: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
b440: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
b450: 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 readable {}..
b460: 20 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 after 1000 resp
b470: 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 ond $s..}..proc
b480: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 respond {s} {..
b490: 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 global firstb
b4a0: 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d lock.. puts -
b4b0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 nonewline $s $fi
b4c0: 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 rstblock.. af
b4d0: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
b4e0: 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 ta $s..}..proc w
b4f0: 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 ritedata {s} {..
b500: 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e global secon
b510: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 dblock.. puts
b520: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
b530: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 secondblock..
b540: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
b550: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
b560: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b570: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b580: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b590: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b5a0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
b5b0: 20 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 .$remoteServerI
b5c0: 50 20 32 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e P 2845]. fcon
b5d0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
b5e0: 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 ing 0 -trans lf
b5f0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
b600: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a set count 0.
b610: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
b620: 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 o. fileevent
b630: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
b640: 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 dit $s". set
b650: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
b660: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
b670: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
b680: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
b690: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
b6a0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b6b0: 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 {close $l}. s
b6c0: 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 et count.} 65566
b6d0: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 32 2e ..test tlsIo-12.
b6e0: 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 1 {testing inher
b6f0: 69 74 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 itance of server
b700: 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f sockets} \..{so
b710: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
b720: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
b730: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
b740: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
b750: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 eFile script2..
b760: 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 # Script1 is
b770: 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 just a 10 second
b780: 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 delay. If the
b790: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 server socket.
b7a0: 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 # is inherited
b7b0: 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c , it will be hel
b7c0: 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 d open for 10 se
b7d0: 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 conds.. set f
b7e0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 [open script1 w
b7f0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
b800: 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 .after 10000 exi
b810: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
b820: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
b830: 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 $f.. # Scrip
b840: 74 32 20 63 72 65 61 74 65 73 20 74 68 65 20 73 t2 creates the s
b850: 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 erver socket, la
b860: 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a unches script1,.
b870: 20 20 20 20 23 20 77 61 69 74 73 20 61 20 73 65 # waits a se
b880: 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e cond, and exits.
b890: 20 20 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 The server soc
b8a0: 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 ket will now.
b8b0: 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c # be closed unl
b8c0: 65 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 ess script1 inhe
b8d0: 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 rited it... s
b8e0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
b8f0: 74 32 20 77 5d 0a 20 20 20 20 23 20 70 75 74 73 t2 w]. # puts
b900: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
b910: 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 ltest $::tcltest
b920: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
b930: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
b940: 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d tclsh [info nam
b950: 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a eofexecutable]].
b960: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
b970: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
b980: 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 cltest..package
b990: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
b9a0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
b9b0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
b9c0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
b9d0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
b9e0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
b9f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
ba00: 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 38 $serverKey 2828
ba10: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
ba20: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
ba30: 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 { file addr port
ba40: 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 } {.. close
ba50: 24 66 69 6c 65 0a 09 7d 0a 09 23 20 65 78 65 63 $file..}..# exec
ba60: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
ba70: 74 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 test script1 &..
ba80: 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 exec $tclsh scri
ba90: 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a pt1 &..close $f.
baa0: 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 .after 1000 exit
bab0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
bac0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
bad0: 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 $f... # Launc
bae0: 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 h script2 and wa
baf0: 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 it 5 seconds..
bb00: 20 20 23 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 # exec $::tclt
bb10: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
bb20: 69 70 74 32 20 26 0a 20 20 20 20 65 78 65 63 20 ipt2 &. exec
bb30: 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 [info nameofexec
bb40: 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 utable] script2
bb50: 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 &. after 5000
bb60: 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f { set ok_to_pro
bb70: 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 ceed 1 }. vwa
bb80: 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 it ok_to_proceed
bb90: 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 .. # If we ca
bba0: 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 n still connect
bbb0: 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 to the server, t
bbc0: 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e he socket got in
bbd0: 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 herited... if
bbe0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
bbf0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
bc00: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
bc10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
bc20: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
bc30: 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e ey \. . 127.0.
bc40: 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 2828} msg]}
bc50: 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 {..set x {server
bc60: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
bc70: 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d inherited}. }
bc80: 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 else {..close $
bc90: 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 msg..set x {serv
bca0: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e er socket was in
bcb0: 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a herited}. }..
bcc0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
bcd0: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
bce0: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 eFile script2.
bcf0: 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 set x.} {serve
bd00: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 r socket was not
bd10: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
bd20: 74 20 74 6c 73 49 6f 2d 31 32 2e 32 20 7b 74 65 t tlsIo-12.2 {te
bd30: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
bd40: 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b e of client sock
bd50: 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ets} \..{socket
bd60: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
bd70: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 eServer} {. r
bd80: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
bd90: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
bda0: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
bdb0: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
bdc0: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
bdd0: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
bde0: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
bdf0: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
be00: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
be10: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
be20: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
be30: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
be40: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
be50: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
be60: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
be70: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
be80: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 # Script2 op
be90: 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 ens the client s
bea0: 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 ocket and writes
beb0: 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e to it. It then
bec0: 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 . # launches
bed0: 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 script1 and exit
bee0: 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 s. If the child
bef0: 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 process inherit
bf00: 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 ed the. # cli
bf10: 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 ent socket, the
bf20: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c socket will stil
bf30: 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 l be open...
bf40: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
bf50: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
bf60: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
bf70: 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 sh [info nameofe
bf80: 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 xecutable]].
bf90: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
bfa0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
bfb0: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
bfc0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
bfd0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
bfe0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
bff0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c000: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
c010: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
c020: 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 29 \]". puts
c030: 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 $f {..exec $tcls
c040: 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 h script1 &..put
c050: 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c s $f testing..fl
c060: 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 ush $f..after 10
c070: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
c080: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
c090: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
c0a0: 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 76 Create the serv
c0b0: 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 er socket.. s
c0c0: 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a et server [tls::
c0d0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
c0e0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
c0f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c100: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
c110: 4b 65 79 20 5c 0a 09 2d 73 65 72 76 65 72 20 61 Key \..-server a
c120: 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 ccept 2829].
c130: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 proc accept { fi
c140: 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b le host port } {
c150: 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c ...# When the cl
c160: 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 ient connects, e
c170: 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 stablish the rea
c180: 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 d handler..globa
c190: 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 l server..close
c1a0: 24 73 65 72 76 65 72 0a 09 66 69 6c 65 65 76 65 $server..fileeve
c1b0: 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c nt $file readabl
c1c0: 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 e [list getdata
c1d0: 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 75 $file]..fconfigu
c1e0: 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 re $file -buffer
c1f0: 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b 69 ing line -blocki
c200: 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a 20 20 20 ng 0..return.
c210: 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 }. proc getd
c220: 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a ata { file } {..
c230: 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 .# Read handler
c240: 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 20 on the accepted
c250: 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 socket...global
c260: 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 x..global failed
c270: 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 ..set status [ca
c280: 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d tch {read $file}
c290: 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 data]..if {$sta
c2a0: 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 tus != 0} {..
c2b0: 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 set x {read fai
c2c0: 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 led, error was $
c2d0: 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 data}.. catch
c2e0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
c2f0: 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 ..} elseif {[str
c300: 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 ing compare {} $
c310: 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 data]} {..} else
c320: 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 if {[fblocked $f
c330: 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 ile]} {..} elsei
c340: 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 f {[eof $file]}
c350: 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c {.. if {$fail
c360: 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 ed} {...set x {c
c370: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 lient socket was
c380: 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 inherited}..
c390: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
c3a0: 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 x {client socket
c3b0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c3c0: 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ed}.. }..
c3d0: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
c3e0: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a ile }..} else {.
c3f0: 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f . set x {impo
c400: 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 ssible case}..
c410: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c420: 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 $file }..}..retu
c430: 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 rn. }.. #
c440: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f If the socket do
c450: 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 esn't hit end-of
c460: 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e -file in 5 secon
c470: 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 ds, the. # sc
c480: 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 ript1 process mu
c490: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 st have inherite
c4a0: 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 d the client...
c4b0: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
c4c0: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 5b after 5000 [
c4d0: 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 list set failed
c4e0: 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 1].. # Launch
c4f0: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f the script2 pro
c500: 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 5b cess.. exec [
c510: 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 info nameofexecu
c520: 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 table] script2 &
c530: 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 .. vwait x.
c540: 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 if {!$failed}
c550: 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a {..vwait failed.
c560: 20 20 20 20 7d 0a 20 20 20 20 72 65 6d 6f 76 65 }. remove
c570: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
c580: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
c590: 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 pt2. set x.}
c5a0: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
c5b0: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
c5c0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 32 }..test tlsIo-12
c5d0: 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .3 {testing inhe
c5e0: 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 ritance of accep
c5f0: 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ted sockets} \..
c600: 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 20 64 6f {empty socket do
c610: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
c620: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 erver} {. # h
c630: 61 6e 67 73 20 6f 6e 20 4c 69 6e 75 78 0a 20 20 angs on Linux.
c640: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c650: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
c660: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
c670: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c680: 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt1 w]. puts
c690: 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 $f {..after 100
c6a0: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
c6b0: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
c6c0: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 close $f.. s
c6d0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
c6e0: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
c6f0: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
c700: 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 h [info nameofex
c710: 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 ecutable]]. p
c720: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
c730: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
c740: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
c750: 20 24 66 20 22 63 61 74 63 68 20 7b 73 65 74 20 $f "catch {set
c760: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c770: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c780: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c790: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c7a0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c7b0: 65 72 76 65 72 4b 65 79 20 32 39 33 30 20 5c 5d erverKey 2930 \]
c7c0: 7d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b }". puts $f {
c7d0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
c7e0: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
c7f0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 {.. global t
c800: 63 6c 73 68 0a 09 20 20 20 20 70 75 74 73 20 24 clsh.. puts $
c810: 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 file {test data
c820: 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 on socket}..
c830: 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 exec $tclsh scri
c840: 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 pt1 &.. after
c850: 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 63 1000 exit..}..c
c860: 61 74 63 68 20 7b 76 77 61 69 74 20 66 6f 72 65 atch {vwait fore
c870: 76 65 72 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 ver}. }. c
c880: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c lose $f.. # L
c890: 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 aunch the script
c8a0: 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 2 process and co
c8b0: 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 nnect to it. Se
c8c0: 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 e how long. #
c8d0: 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 the socket stay
c8e0: 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 s open.. exec
c8f0: 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 [info nameofexe
c900: 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 cutable] script2
c910: 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 &.. after 10
c920: 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 00 set ok_to_pro
c930: 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 ceed 1. vwait
c940: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
c950: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
c960: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
c970: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
c980: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c990: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
c9a0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
c9b0: 32 37 2e 30 2e 30 2e 31 20 32 39 33 30 5d 0a 20 27.0.0.1 2930].
c9c0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
c9d0: 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c -buffering full
c9e0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
c9f0: 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 fileevent $f re
ca00: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 adable [list get
ca10: 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 data $f].. #
ca20: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 If the socket is
ca30: 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 still open afte
ca40: 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 r 5 seconds, the
ca50: 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 script1 process
ca60: 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 . # must have
ca70: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 inherited the a
ca80: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
ca90: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
caa0: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
cab0: 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 set failed 1..
cac0: 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 61 20 proc getdata
cad0: 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 { file } {...# R
cae0: 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 ead handler on t
caf0: 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 he client socket
cb00: 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f ...global x..glo
cb10: 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 bal failed..set
cb20: 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 status [catch {r
cb30: 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d ead $file} data]
cb40: 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d ..if {$status !=
cb50: 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 0} {.. set x
cb60: 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 {read failed, e
cb70: 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a rror was $data}.
cb80: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
cb90: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c se $file }..} el
cba0: 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f seif {[string co
cbb0: 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d mpare {} $data]}
cbc0: 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 {..} elseif {[f
cbd0: 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 blocked $file]}
cbe0: 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f {..} elseif {[eo
cbf0: 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 f $file]} {..
cc00: 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a if {$failed} {.
cc10: 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 ..set x {accepte
cc20: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 d socket was inh
cc30: 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 erited}.. } e
cc40: 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 lse {...set x {a
cc50: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 ccepted socket w
cc60: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
cc70: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 }.. }.. ca
cc80: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
cc90: 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 e }..} else {..
cca0: 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 set x {imposs
ccb0: 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 ible case}..
ccc0: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
ccd0: 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e ile }..}..return
cce0: 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 . }. .
ccf0: 76 77 61 69 74 20 78 0a 0a 20 20 20 20 72 65 6d vwait x.. rem
cd00: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
cd10: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
cd20: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
cd30: 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 .} {accepted soc
cd40: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
cd50: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
cd60: 49 6f 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 Io-13.1 {Testing
cd70: 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 use of shared s
cd80: 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 ocket between tw
cd90: 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 o threads} \..{s
cda0: 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 ocket testthread
cdb0: 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 } {.. removeF
cdc0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 ile script. t
cdd0: 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d hreadReap.. m
cde0: 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 akeFile {. .p
cdf0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
ce00: 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a ls..set f [tls::
ce10: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
ce20: 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f ccept 2828]..pro
ce30: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
ce40: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
ce50: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
ce60: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
ce70: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
ce80: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
ce90: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
cea0: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
ceb0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
cec0: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
ced0: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
cee0: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
cef0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
cf00: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
cf10: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
cf20: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
cf30: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
cf40: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
cf50: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
cf60: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
cf70: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
cf80: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
cf90: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
cfa0: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
cfb0: 0a 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 ..vwait x..close
cfc0: 20 24 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 $f...# thread c
cfd0: 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e leans itself up.
cfe0: 0a 09 74 65 73 74 74 68 72 65 61 64 20 65 78 69 ..testthread exi
cff0: 74 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 t. } script.
d000: 20 20 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 . # create
d010: 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 a thread. se
d020: 74 20 73 65 72 76 65 72 74 68 72 65 61 64 20 5b t serverthread [
d030: 74 65 73 74 74 68 72 65 61 64 20 63 72 65 61 74 testthread creat
d040: 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 e { source scrip
d050: 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 t } ]. update
d060: 0a 20 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 . . after
d070: 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 1000. set s [
d080: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
d090: 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 0.0.1 2828].
d0a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
d0b0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 uffering line..
d0c0: 20 20 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 catch {..puts
d0d0: 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 $s "hello"..get
d0e0: 73 20 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 s $s result.
d0f0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
d100: 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 update.. a
d110: 66 74 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 fter 2000. la
d120: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 ppend result [th
d130: 72 65 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 readReap]. .
d140: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d set result..}
d150: 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c {hello 1}..# cl
d160: 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e eanup.if {[strin
d170: 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 g match sock* $c
d180: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d ommandSocket] ==
d190: 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 1} {. puts $c
d1a0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 ommandSocket exi
d1b0: 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d t. flush $comm
d1c0: 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 andSocket.}.catc
d1d0: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
d1e0: 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b dSocket}.catch {
d1f0: 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f close $remotePro
d200: 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 cChan}.::tcltest
d210: 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 ::cleanupTests.f
d220: 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 lush stdout.retu
d230: 72 6e 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a rn............