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 31 20 32 30 30 30 2f 30 36 2f 30 33 20 30 .11 2000/06/03 0
0210: 33 3a 33 35 3a 33 36 20 61 77 62 20 45 78 70 20 3:35:36 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 73 6f 63 6b 65 74 2d 31 2e 31 20 7b 61 st socket-1.1 {a
1c20: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1c30: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1c40: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1c50: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1c60: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 socket -server}
1c70: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1c80: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1c90: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1ca0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
1cb0: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
1cc0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 ort"}}..test soc
1cd0: 6b 65 74 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 ket-1.2 {arg par
1ce0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
1cf0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
1d00: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
1d10: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
1d20: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 -server foo} ms
1d30: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1d40: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1d50: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1d60: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
1d70: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
1d80: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
1d90: 74 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 t-1.3 {arg parsi
1da0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1db0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1dc0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1dd0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1de0: 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 myaddr} msg] $ms
1df0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1e00: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1e10: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
1e20: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
1e30: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
1e40: 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e -1.4 {arg parsin
1e50: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1e60: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1e70: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1e80: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1e90: 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d yaddr 127.0.0.1}
1ea0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
1eb0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
1ec0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
1ed0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
1ee0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
1ef0: 73 74 20 73 6f 63 6b 65 74 2d 31 2e 35 20 7b 61 st socket-1.5 {a
1f00: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1f10: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1f20: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1f30: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1f40: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 socket -myport}
1f50: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1f60: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1f70: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1f80: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
1f90: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
1fa0: 74 20 73 6f 63 6b 65 74 2d 31 2e 36 20 7b 61 72 t socket-1.6 {ar
1fb0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1fc0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1fd0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1fe0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1ff0: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 ocket -myport xx
2000: 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 xx} msg] $msg.}
2010: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2020: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2030: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2040: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2050: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 37 .test socket-1.7
2060: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2070: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2080: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2090: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
20a0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
20b0: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
20c0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
20d0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
20e0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
20f0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2100: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
2110: 2d 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e -1.8 {arg parsin
2120: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
2130: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
2140: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2150: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 {tls::socket -f
2160: 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 roboz} msg] $msg
2170: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2180: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2190: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
21a0: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
21b0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
21c0: 31 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.9 {arg parsing
21d0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
21e0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
21f0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2200: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2210: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2220: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
2230: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2240: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2250: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2260: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2270: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
2280: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
2290: 31 2e 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 1.10 {arg parsin
22a0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
22b0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
22c0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
22d0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f {tls::socket ho
22e0: 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d st 2528 -junk} m
22f0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2300: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2310: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2320: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
2330: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
2340: 20 73 6f 63 6b 65 74 2d 31 2e 31 31 20 7b 61 72 socket-1.11 {ar
2350: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2360: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2370: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2380: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2390: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 ocket -server ca
23a0: 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 llback 2520 --}
23b0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
23c0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
23d0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
23e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
23f0: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
2400: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 ort"}}..test soc
2410: 6b 65 74 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 ket-1.12 {arg pa
2420: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2430: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2440: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2450: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2460: 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d t foo badport} m
2470: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 sg] $msg.} {1 {e
2480: 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 xpected integer
2490: 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 but got "badport
24a0: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
24b0: 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.1 {tcp connec
24c0: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 tion} {socket st
24d0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
24e0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
24f0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2500: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2510: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
2520: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2530: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2540: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
2550: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 d_out"]. }.
2560: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
2570: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
2580: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
2590: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
25a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
25b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
25c0: 72 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 rverKey 2828 \]"
25d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
25e0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
25f0: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
2600: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
2610: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
2620: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2630: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
2640: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2650: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2660: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
2670: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
2680: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2690: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
26a0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
26b0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
26c0: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
26d0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
26e0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
26f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
2700: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2710: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
2720: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
2730: 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 2828} msg]} {.
2740: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 set x $ms
2750: 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 g. } else {.
2760: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
2770: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
2780: 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 close $msg.
2790: 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 }. lappend
27a0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
27b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
27c0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
27d0: 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 {}}..if [info e
27e0: 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 xists port] {.
27f0: 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c incr port.} el
2800: 73 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 6f se { . set po
2810: 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 rt [expr 2048 +
2820: 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 [pid]%1024].}..t
2830: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 32 20 7b est socket-2.2 {
2840: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
2850: 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 ith client port
2860: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
2870: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
2880: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
2890: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
28a0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
28b0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
28c0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
28d0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
28e0: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
28f0: 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 e"]. }. pu
2900: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2910: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2920: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
2930: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2940: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2950: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2960: 4b 65 79 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 Key 2829 \]".
2970: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2980: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2990: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
29a0: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
29b0: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
29c0: 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 "[gets $file] $
29d0: 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 port".
29e0: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 close $file.
29f0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
2a00: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
2a10: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2a20: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2a30: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
2a40: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
2a50: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
2a60: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
2a70: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
2a80: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
2a90: 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 $f x. global
2aa0: 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 port. if {[ca
2ab0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2ac0: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c -myport $port \
2ad0: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
2ae0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2af0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2b00: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2b10: 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 7d 20 73 27.0.0.1 2829} s
2b20: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2b30: 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 set x $sock..cat
2b40: 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a ch {close [tls::
2b50: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
2b60: 20 32 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 2829]}. } el
2b70: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
2b80: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
2b90: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
2ba0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2bb0: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
2bc0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
2bd0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2be0: 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 set x.} [list
2bf0: 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f ready "hello $po
2c00: 72 74 22 5d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 rt"]..test socke
2c10: 74 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 t-2.3 {tcp conne
2c20: 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e ction with clien
2c30: 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 t interface spec
2c40: 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 ified} {socket s
2c50: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
2c60: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
2c70: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
2c80: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
2c90: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
2ca0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
2cb0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
2cc0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
2cd0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2ce0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2cf0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2d00: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2d10: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2d20: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2d30: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2d40: 32 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 2830 \]". put
2d50: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2d60: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
2d70: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
2d80: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
2d90: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
2da0: 65 74 73 20 24 66 69 6c 65 5d 20 24 61 64 64 72 ets $file] $addr
2db0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
2dc0: 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 ose $file.
2dd0: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
2de0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2df0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2e00: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2e10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
2e20: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2e30: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2e40: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
2e50: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
2e60: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
2e70: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
2e80: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2e90: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c addr 127.0.0.1 \
2ea0: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
2eb0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2ec0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2ed0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2ee0: 32 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 20 73 27.0.0.1 2830} s
2ef0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2f00: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
2f10: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2f20: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
2f30: 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 o..catch {flush
2f40: 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c $sock}. l
2f50: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2f60: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2f70: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
2f80: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2f90: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 t x.} {ready {he
2fa0: 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a llo 127.0.0.1}}.
2fb0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 34 .test socket-2.4
2fc0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2fd0: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
2fe0: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2ff0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3000: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3010: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3020: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3030: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3040: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3050: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3060: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3070: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3080: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3090: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
30a0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
30b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
30c0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
30d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
30e0: 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 $serverKey -myad
30f0: 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d dr [info hostnam
3100: 65 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 20 e] 2831 \]".
3110: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3120: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
3130: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
3140: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3150: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
3160: 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 "[gets $file]".
3170: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
3180: 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 $file.
3190: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
31a0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
31b0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
31c0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
31d0: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
31e0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
31f0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
3200: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3210: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3220: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
3230: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
3240: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3250: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3260: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3270: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3280: 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 entKey [info hos
3290: 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f 63 tname] 2831} soc
32a0: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
32b0: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
32c0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
32d0: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
32e0: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
32f0: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3300: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3310: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3320: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3330: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
3340: 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 dy hello}..test
3350: 73 6f 63 6b 65 74 2d 32 2e 35 20 7b 74 63 70 20 socket-2.5 {tcp
3360: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3370: 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 redundant server
3380: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 port} {socket s
3390: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
33a0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
33b0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
33c0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
33d0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
33e0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
33f0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3400: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3410: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3420: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3430: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3440: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3450: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3460: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3470: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3480: 32 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 2832 \]". put
3490: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
34a0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
34b0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
34c0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
34d0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
34e0: 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 ets $file]".
34f0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
3500: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
3510: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3520: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3530: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3540: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3550: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3560: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3570: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3580: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3590: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
35a0: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
35b0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
35c0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
35d0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
35e0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
35f0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3600: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
3610: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3620: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3630: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3640: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3650: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
3660: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
3670: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3680: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3690: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
36a0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
36b0: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
36c0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 36 .test socket-2.6
36d0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
36e0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
36f0: 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 set status ok.
3700: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
3710: 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 set sock [tls::s
3720: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
3730: 32 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 2833]}]} {..if {
3740: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
3750: 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 ock}]} {.. se
3760: 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a t status broken.
3770: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a .}..close $sock.
3780: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 }. set st
3790: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 atus.} ok..test
37a0: 73 6f 63 6b 65 74 2d 32 2e 37 20 7b 65 63 68 6f socket-2.7 {echo
37b0: 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e server, one lin
37c0: 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f e} {socket stdio
37d0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
37e0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
37f0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3800: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3810: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3820: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
3830: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
3840: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3850: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3860: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3870: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3880: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3890: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
38a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
38b0: 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 34 $serverKey 2834
38c0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
38d0: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
38e0: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
38f0: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
3900: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
3910: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
3920: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
3930: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
3940: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
3950: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
3960: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 ho {s} {.. s
3970: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
3980: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
3990: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
39a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f glo
39b0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
39c0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39e0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
39f0: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
3a00: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3a10: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
3a20: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
3a30: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3a40: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3a50: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3a60: 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 $f..puts done.
3a70: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3a80: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3a90: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3aa0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3ab0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3ac0: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
3ad0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
3ae0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3af0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3b00: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3b10: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
3b20: 30 2e 31 20 32 38 33 34 5d 0a 20 20 20 20 66 63 0.1 2834]. fc
3b30: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
3b40: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
3b50: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
3b60: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 puts $s "hello a
3b70: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 bcdefghijklmnop"
3b80: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a . after 1000.
3b90: 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 set x [gets
3ba0: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
3bb0: 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 . set y [gets
3bc0: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
3bd0: 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 f. list $x $y
3be0: 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 .} {{hello abcde
3bf0: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e fghijklmnop} don
3c00: 65 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d e}..test socket-
3c10: 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.8 {echo server
3c20: 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c , loop 50 times,
3c30: 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 single connecti
3c40: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
3c50: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b o} {. set f [
3c60: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3c70: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
3c80: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
3c90: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
3ca0: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
3cb0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3cc0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
3cd0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
3ce0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3cf0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
3d00: 65 72 4b 65 79 20 32 38 33 35 20 5c 5d 22 0a 20 erKey 2835 \]".
3d10: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
3d20: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
3d30: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3d40: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
3d50: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
3d60: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
3d70: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3d80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3d90: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
3da0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
3db0: 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 global i.
3dc0: 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 set l [get
3dd0: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
3de0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
3df0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3e00: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
3e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
3e20: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
3e30: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3e40: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
3e50: 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 } else { ..
3e60: 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 incr i.
3e70: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
3e80: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 $s $l.
3e90: 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 }..}..set i
3ea0: 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 0..puts ready..s
3eb0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3ec0: 32 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 20000 "set x don
3ed0: 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 e"]..vwait x..af
3ee0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
3ef0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
3f00: 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 s "done $i".
3f10: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3f20: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
3f30: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
3f40: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
3f50: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
3f60: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
3f70: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3f80: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3f90: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3fa0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3fb0: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
3fc0: 20 32 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 2835]. fconf
3fd0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
3fe0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 ing line. cat
3ff0: 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 ch {..for {set x
4000: 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 0} {$x < 50} {i
4010: 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 ncr x} {.. pu
4020: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
4030: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 defghijklmnop"..
4040: 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 gets $s..}.
4050: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4060: 73 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 s. catch {set
4070: 20 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 x [gets $f]}.
4080: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4090: 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d et x.} {done 50}
40a0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e ..test socket-2.
40b0: 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 9 {socket confli
40c0: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
40d0: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b o} {. set s [
40e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
40f0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
4100: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4110: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
4120: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
4130: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
4140: 6c 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 65 line $f {package
4150: 20 72 65 71 75 69 72 65 20 74 6c 73 3b 20 74 6c require tls; tl
4160: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4170: 72 20 61 63 63 65 70 74 20 32 38 32 38 7d 0a 20 r accept 2828}.
4180: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4190: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
41a0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
41b0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
41c0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
41d0: 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 after 100.
41e0: 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 set x [list [c
41f0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 atch {close $f}
4200: 6d 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 msg] $msg]. c
4210: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
4220: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
4230: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
4240: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
4250: 20 75 73 65 0a 20 20 20 20 77 68 69 6c 65 20 65 use. while e
4260: 78 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b xecuting."::sock
4270: 65 74 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a et -server {tls:
4280: 3a 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 76 65 :_accept {-serve
4290: 72 20 31 7d 20 61 63 63 65 70 74 7d 20 32 38 32 r 1} accept} 282
42a0: 38 22 0a 20 20 20 20 28 22 65 76 61 6c 22 20 62 8". ("eval" b
42b0: 6f 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 ody line 1).
42c0: 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 invoked from wit
42d0: 68 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b hin."eval ::sock
42e0: 65 74 20 24 73 6f 70 74 73 22 0a 20 20 20 20 28 et $sopts". (
42f0: 70 72 6f 63 65 64 75 72 65 20 22 74 6c 73 3a 3a procedure "tls::
4300: 73 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 socket" line 62)
4310: 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f . invoked fro
4320: 6d 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 m within."tls::s
4330: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4340: 63 65 70 74 20 32 38 32 38 22 0a 20 20 20 20 28 cept 2828". (
4350: 66 69 6c 65 20 22 73 63 72 69 70 74 22 20 6c 69 file "script" li
4360: 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 73 6f ne 1)}}..test so
4370: 63 6b 65 74 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 cket-2.10 {close
4380: 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 on accept, acce
4390: 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 pted socket live
43a0: 73 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e s} {socket known
43b0: 42 75 67 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 Bug} {. set d
43c0: 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 one 0. set ti
43d0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 mer [after 20000
43e0: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
43f0: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 _out"]. set s
4400: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4410: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
4420: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
4430: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4440: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4450: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 30 5d $serverKey 2830]
4460: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
4470: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
4480: 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 al ss..close $ss
4490: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
44a0: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
44b0: 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 $s"..fconfigure
44c0: 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 $s -trans lf.
44d0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 }. proc read
44e0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
44f0: 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 done..gets $s..
4500: 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f close $s..set do
4510: 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 ne 1. }. s
4520: 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b et cs [tls::sock
4530: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4540: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4550: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4560: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4570: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
4580: 32 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 2830]. close
4590: 24 63 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 $cs.. vwait d
45a0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
45b0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
45c0: 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 set done.} 1..te
45d0: 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 31 20 7b st socket-2.11 {
45e0: 64 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 detecting new da
45f0: 74 61 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 ta} {socket know
4600: 6e 42 75 67 7d 20 7b 0a 20 20 20 20 70 72 6f 63 nBug} {. proc
4610: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
4620: 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 {..global sock..
4630: 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 73 65 74 set sock $s..set
4640: 20 66 20 5b 6f 70 65 6e 20 61 77 62 2e 6c 6f 67 f [open awb.log
4650: 20 77 5d 0a 09 70 75 74 73 20 24 66 20 5b 63 61 w]..puts $f [ca
4660: 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 tch {tls::handsh
4670: 61 6b 65 20 24 73 6f 63 6b 7d 20 65 72 72 5d 0a ake $sock} err].
4680: 09 70 75 74 73 20 24 66 20 22 65 72 72 3a 20 24 .puts $f "err: $
4690: 65 72 72 22 0a 09 70 75 74 73 20 24 66 20 22 5b err"..puts $f "[
46a0: 74 6c 73 3a 3a 73 74 61 74 75 73 20 24 73 6f 63 tls::status $soc
46b0: 6b 5d 22 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 k]"..close $s.
46c0: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b }.. set s [
46d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 tls::socket -req
46e0: 75 69 72 65 20 30 20 2d 72 65 71 75 65 73 74 20 uire 0 -request
46f0: 30 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 0 -server accept
4700: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
4710: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
4720: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4730: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 34 le $serverKey 24
4740: 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 00]. set sock
4750: 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b "". set s2 [
4760: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
4770: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
4780: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4790: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
47a0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
47b0: 2e 31 20 32 34 30 30 5d 0a 20 20 20 20 76 77 61 .1 2400]. vwa
47c0: 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 it sock. puts
47d0: 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 $s2 one. flu
47e0: 73 68 20 24 73 32 0a 20 20 20 20 61 66 74 65 72 sh $s2. after
47f0: 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 500. fconfig
4800: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4810: 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 ing 0. set re
4820: 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b sult [gets $sock
4830: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 ]. lappend re
4840: 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b sult [gets $sock
4850: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4860: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4870: 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 1. puts $s2
4880: 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 two. flush $s
4890: 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 2. fconfigure
48a0: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
48b0: 20 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 0. lappend r
48c0: 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 esult [gets $soc
48d0: 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 k]. fconfigur
48e0: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
48f0: 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 g 1. close $s
4900: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 2. close $s.
4910: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
4920: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
4930: 7b 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a 0a 74 65 {one {} two}..te
4940: 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 32 20 7b st socket-2.12 {
4950: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 tcp connection;
4960: 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 20 no certificates
4970: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
4980: 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 et stdio pcCrash
4990: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
49a0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
49b0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
49c0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
49d0: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
49e0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
49f0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
4a00: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4a10: 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c 73 ut"]..set f [tls
4a20: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4a30: 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 accept 2828]..p
4a40: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
4a50: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
4a60: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
4a70: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
4a80: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
4a90: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
4aa0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
4ab0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4ac0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
4ad0: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
4ae0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
4af0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
4b00: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
4b10: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
4b20: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
4b30: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
4b40: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
4b50: 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b .1 2828} msg]} {
4b60: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
4b70: 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b msg. } else {
4b80: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
4b90: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
4ba0: 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a close $msg.
4bb0: 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e }. lappen
4bc0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
4bd0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4be0: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f et x.} {ready do
4bf0: 6e 65 20 7b 7d 7d 0a 0a 0a 0a 0a 74 65 73 74 20 ne {}}.....test
4c00: 73 6f 63 6b 65 74 2d 33 2e 31 20 7b 73 6f 63 6b socket-3.1 {sock
4c10: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
4c20: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4c30: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4c40: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
4c50: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
4c60: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
4c70: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
4c80: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
4c90: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
4ca0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4cb0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
4cc0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4cd0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4ce0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4cf0: 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 20 rKey 2828 \]".
4d00: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 75 74 puts $f {..put
4d10: 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 74 s ready..gets st
4d20: 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 din..close $f.
4d30: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4d40: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4d50: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4d60: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4d70: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 ipt]" r+]. ge
4d80: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 20 ts $f. set x
4d90: 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c [list [catch {tl
4da0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
4db0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4dc0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4dd0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
4de0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
4df0: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
4e00: 20 32 38 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 2828} msg] \...
4e10: 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 20 24 $msg]. puts $
4e20: 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 f bye. close
4e30: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
4e40: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
4e50: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
4e60: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d already in use}
4e70: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 33 }..test socket-3
4e80: 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 .2 {server with
4e90: 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d several clients}
4ea0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
4eb0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
4ec0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
4ed0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
4ee0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
4ef0: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
4f00: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 uire tls..set t1
4f10: 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 [after 30000 "s
4f20: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
4f30: 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 ..set t2 [after
4f40: 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 31000 "set x tim
4f50: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 ed_out"]..set t3
4f60: 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 [after 32000 "s
4f70: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
4f80: 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a ..set counter 0.
4f90: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
4fa0: 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a f "set s \[tls::
4fb0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4fc0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
4fd0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
4fe0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
4ff0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
5000: 32 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 2828 \]". put
5010: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
5020: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
5030: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
5040: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
5050: 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f cho $s].. fco
5060: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5070: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 ering line..}..p
5080: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
5090: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
50a0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c set l
50b0: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
50c0: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
50d0: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
50e0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
50f0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
5100: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
5110: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
5120: 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 e {.
5130: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
5150: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
5160: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5170: 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 ncel $t1..vwait
5180: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5190: 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 $t2..vwait x..af
51a0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 ter cancel $t3..
51b0: 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 close $s..puts $
51c0: 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 x. }. clos
51d0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
51e0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
51f0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5200: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5210: 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 set x [gets $f
5220: 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c ]. set s1 [tl
5230: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
5240: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5250: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5260: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5270: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
5280: 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 127.0.0.1 2828
5290: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
52a0: 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $s1 -buffering
52b0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 line. set s2
52c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
52d0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
52e0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
52f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5300: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5310: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 . 127.0.0.1 2
5320: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
5330: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
5340: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
5350: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
5360: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5370: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5380: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5390: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
53a0: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
53b0: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
53c0: 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 figure $s3 -buff
53d0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
53e0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
53f0: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
5400: 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c {..puts $s1 hel
5410: 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a lo,s1..gets $s1.
5420: 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c .puts $s2 hello,
5430: 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 s2..gets $s2..pu
5440: 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a ts $s3 hello,s3.
5450: 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a .gets $s3. }.
5460: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
5470: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
5480: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c 61 close $s3. la
5490: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
54a0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
54b0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
54c0: 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 73 6f y done}..test so
54d0: 63 6b 65 74 2d 34 2e 31 20 7b 73 65 72 76 65 72 cket-4.1 {server
54e0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
54f0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
5500: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
5510: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5520: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5530: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5540: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
5550: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5560: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5570: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5580: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
5590: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
55a0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
55b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
55c0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
55d0: 30 2e 30 2e 31 20 32 38 32 38 20 5c 5d 22 0a 20 0.0.1 2828 \]".
55e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 puts $f {..fc
55f0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5600: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 fering line..for
5610: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
5620: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
5630: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 .. puts $s he
5640: 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 llo.. gets $s
5650: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 ..}..close $s..p
5660: 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 uts bye..gets st
5670: 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c din. }. cl
5680: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 ose $f. set p
5690: 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 1 [open "|[list
56a0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
56b0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
56c0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
56d0: 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p1 -buffering l
56e0: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b ine. set p2 [
56f0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5700: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5710: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5720: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 fconfigure $p2
5730: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5740: 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 . set p3 [ope
5750: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5760: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5770: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
5780: 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 configure $p3 -b
5790: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
57a0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
57b0: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
57c0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
57d0: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
57e0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
57f0: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
5800: 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f }. proc echo
5810: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 {s} {..global x
5820: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b . set l [
5830: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 gets $s].
5840: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
5850: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
5860: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
5870: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5880: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
5890: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
58a0: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 s $l. }.
58b0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 }. set t1
58c0: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
58d0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
58e0: 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 set t2 [afte
58f0: 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 r 31000 "set x t
5900: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5910: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
5920: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5930: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 out"]. set s
5940: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5950: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
5960: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
5970: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5980: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
5990: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
59a0: 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 70 75 ept 2828]. pu
59b0: 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 ts $p1 open.
59c0: 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 puts $p2 open.
59d0: 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a puts $p3 open.
59e0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
59f0: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
5a00: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
5a10: 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 ncel $t1. aft
5a20: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 er cancel $t2.
5a30: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5a40: 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a t3. close $s.
5a50: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5a60: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 lappend l [list
5a70: 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 p1 [gets $p1] $
5a80: 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c x]. lappend l
5a90: 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 [list p2 [gets
5aa0: 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 $p2] $x]. lap
5ab0: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 pend l [list p3
5ac0: 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 [gets $p3] $x].
5ad0: 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a puts $p1 bye.
5ae0: 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 puts $p2 bye
5af0: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 . puts $p3 by
5b00: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a e. close $p1.
5b10: 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 close $p2.
5b20: 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 close $p3.
5b30: 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 set l.} {{p1 bye
5b40: 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 done} {p2 bye d
5b50: 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e one} {p3 bye don
5b60: 65 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 e}}..test socket
5b70: 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -4.2 {byte order
5b80: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
5b90: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
5ba0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
5bb0: 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 set x ok. if
5bc0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
5bd0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
5be0: 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d do 0x3000} msg]}
5bf0: 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 {..set x $msg.
5c00: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f } else {..clo
5c10: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5c20: 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 set x.} ok..te
5c30: 73 74 20 73 6f 63 6b 65 74 2d 35 2e 31 20 7b 62 st socket-5.1 {b
5c40: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
5c50: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
5c60: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
5c70: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
5c80: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
5c90: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
5ca0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
5cb0: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
5cc0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5cd0: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
5ce0: 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 0x1} msg]} {.
5cf0: 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e set x {hton
5d00: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
5d10: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
5d20: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
5d30: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
5d40: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5d50: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
5d60: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5d70: 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 73 6f t owner}.test so
5d80: 63 6b 65 74 2d 35 2e 32 20 7b 62 79 74 65 20 6f cket-5.2 {byte o
5d90: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5da0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5db0: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
5dc0: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
5dd0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
5de0: 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f : port number to
5df0: 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b o high}. if {
5e00: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
5e10: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5e20: 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d o 0x10000} msg]}
5e30: 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 {..set x {port
5e40: 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c resolution probl
5e50: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5e60: 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 sallowed}..close
5e70: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
5e80: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
5e90: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5ea0: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5eb0: 69 67 68 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 igh}.test socket
5ec0: 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.3 {byte order
5ed0: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
5ee0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
5ef0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 } \..{socket uni
5f00: 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b xOnly notRoot} {
5f10: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
5f20: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
5f30: 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 : not owner}.
5f40: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
5f50: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5f60: 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d r dodo 21} msg]}
5f70: 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 {..set x {htons
5f80: 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 problem, should
5f90: 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 be disallowed,
5fa0: 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 are you running
5fb0: 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 as SU?}..close $
5fc0: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
5fd0: 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 t x.} {couldn't
5fe0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
5ff0: 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 73 6f owner}..test so
6000: 63 6b 65 74 2d 36 2e 31 20 7b 61 63 63 65 70 74 cket-6.1 {accept
6010: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
6020: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 {socket stdio p
6030: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 cCrash} {. re
6040: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
6050: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
6060: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
6070: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
6080: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
6090: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 74 6c ..gets stdin..tl
60a0: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
60b0: 30 2e 31 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 0.1 2848. }.
60c0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
60d0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
60e0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
60f0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6100: 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 r+]. proc bg
6110: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
6120: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
6130: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 rgs. }. pr
6140: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6150: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
6160: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6170: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6180: 63 63 65 70 74 20 32 38 34 38 5d 0a 20 20 20 20 ccept 2848].
6190: 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 puts $f hello.
61a0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
61b0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
61c0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
61d0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
61e0: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
61f0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
6200: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
6210: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
6220: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
6230: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
6240: 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 31 20 test socket-7.1
6250: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6260: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6270: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
6280: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
6290: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
62a0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
62b0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
62c0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
62d0: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
62e0: 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f puts $f "tls::so
62f0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
6300: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
6310: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
6320: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6330: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 le $serverKey 28
6340: 32 30 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 20". puts $f
6350: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 {..proc accept a
6360: 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rgs {.. globa
6370: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
6380: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
6390: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
63a0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
63b0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 x timed_out"]..v
63c0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
63d0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
63e0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
63f0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6400: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6410: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6420: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
6430: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
6440: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
6450: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
6460: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
6470: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6480: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
6490: 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 30 127.0.0.1 2820
64a0: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
64b0: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
64c0: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
64d0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
64e0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
64f0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 lappend l [stri
6500: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
6510: 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 ex $p 0] 127.0.0
6520: 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 .1]. lappend
6530: 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 l [string compar
6540: 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 e [lindex $p 2]
6550: 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 2820]. lappen
6560: 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d d l [llength $p]
6570: 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 .} {0 0 3}..test
6580: 20 73 6f 63 6b 65 74 2d 37 2e 32 20 7b 74 65 73 socket-7.2 {tes
6590: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
65a0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
65b0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
65c0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
65d0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
65e0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
65f0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
6600: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6610: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
6620: 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 $f "tls::socket
6630: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6640: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
6650: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
6660: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6670: 73 65 72 76 65 72 4b 65 79 20 32 38 32 31 22 0a serverKey 2821".
6680: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
6690: 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 roc accept args
66a0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
66b0: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
66c0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
66d0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
66e0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
66f0: 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 med_out"]..vwait
6700: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
6710: 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 $timer. }.
6720: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6730: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
6740: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
6750: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
6760: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
6770: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
6780: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
6790: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
67a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
67b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
67c0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
67d0: 37 2e 30 2e 30 2e 31 20 32 38 32 31 5d 0a 20 20 7.0.0.1 2821].
67e0: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
67f0: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
6800: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
6810: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6820: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
6830: 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 pend l [llength
6840: 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $p]. lappend
6850: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a l [lindex $p 0].
6860: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 65 lappend l [e
6870: 78 70 72 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 xpr [lindex $p 2
6880: 5d 20 3d 3d 20 32 38 32 31 5d 0a 7d 20 7b 33 20 ] == 2821].} {3
6890: 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 127.0.0.1 0}..te
68a0: 73 74 20 73 6f 63 6b 65 74 2d 37 2e 33 20 7b 74 st socket-7.3 {t
68b0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
68c0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
68d0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
68e0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
68f0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6900: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6910: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6920: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
6930: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
6940: 63 65 70 74 20 32 38 32 32 5d 0a 20 20 20 20 73 cept 2822]. s
6950: 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 72 65 et l [fconfigure
6960: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
6970: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 s. update.
6980: 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 31 32 llength $l.} 12
6990: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e ..test socket-7.
69a0: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
69b0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
69c0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
69d0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
69e0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
69f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
6a00: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6a10: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
6a20: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
6a30: 72 20 61 63 63 65 70 74 20 32 38 32 33 5d 0a 20 r accept 2823].
6a40: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
6a50: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
6a60: 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 x..set x [fconf
6a70: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
6a80: 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 me]..close $s.
6a90: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
6aa0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6ab0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
6ac0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6ad0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
6ae0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
6af0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
6b00: 32 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 2823]. set ti
6b10: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6b20: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
6b30: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
6b40: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6b50: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
6b60: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6b70: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
6b80: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6b90: 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 index $x 2] [lle
6ba0: 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 33 ngth $x].} {2823
6bb0: 20 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 3}..test socket
6bc0: 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.5 {testing so
6bd0: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
6be0: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 tions} {socket u
6bf0: 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 nixOrPc} {. s
6c00: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6c10: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6c20: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6c30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6c40: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
6c50: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
6c60: 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 cept 2829]. p
6c70: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6c80: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
6c90: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
6ca0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6cb0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
6cc0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
6cd0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6ce0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6cf0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6d00: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6d10: 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 32 37 2e tKey \. .127.
6d20: 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 20 0.0.1 2829].
6d30: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6d40: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6d50: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6d60: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6d70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6d80: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6d90: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6da0: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6db0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
6dc0: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
6dd0: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6de0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 33 127.0.0.1 2829 3
6df0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 38 }..test socket-8
6e00: 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 .1 {testing -asy
6e10: 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 nc flag on socke
6e20: 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 ts} {empty socke
6e30: 74 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a t} {. # NOTE:
6e40: 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 This test may f
6e50: 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 ail on some Sola
6e60: 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e ris 2.4 systems.
6e70: 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 If it does,.
6e80: 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f # check that yo
6e90: 75 20 68 61 76 65 20 74 68 65 73 65 20 70 61 74 u have these pat
6ea0: 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 ches installed (
6eb0: 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 using showrev -p
6ec0: 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 ):. #. # 1
6ed0: 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 01907-05, 101925
6ee0: 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 -02, 101945-14,
6ef0: 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 101959-03, 10196
6f00: 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 9-05, 101973-03,
6f10: 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 . # 101977-03
6f20: 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 , 101981-02, 101
6f30: 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 985-01, 102001-0
6f40: 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 3, 102003-01, 10
6f50: 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 2007-01,. # 1
6f60: 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 02011-02, 102024
6f70: 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 -01, 102039-01,
6f80: 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 102044-01, 10204
6f90: 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 8-01, 102062-03,
6fa0: 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 . # 102066-04
6fb0: 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 , 102070-01, 102
6fc0: 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 105-01, 102153-0
6fd0: 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 3, 102216-01, 10
6fe0: 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 2232-01,. # 1
6ff0: 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 01878-03, 101879
7000: 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 -01, 101880-03,
7010: 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 101933-01, 10195
7020: 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0-01, 102030-01,
7030: 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 . # 102057-08
7040: 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 , 102140-01, 101
7050: 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 920-02, 101921-0
7060: 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 9, 101922-07, 10
7070: 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 1923-03. #.
7080: 20 20 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 # If after ins
7090: 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 talling these pa
70a0: 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 tches you are st
70b0: 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 ill experiencing
70c0: 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d a. # problem
70d0: 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a , please email j
70e0: 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 yl@eng.sun.com.
70f0: 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 We have not obse
7100: 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 rved this. #
7110: 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 failure on Solar
7120: 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 is 2.5, so anoth
7130: 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 er option (inste
7140: 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 ad of installing
7150: 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 61 74 . # these pat
7160: 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 ches) is to upgr
7170: 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 ade to Solaris 2
7180: 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 .5.. set s [t
7190: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
71a0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
71b0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
71c0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
71d0: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
71e0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
71f0: 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 30]. proc acc
7200: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
7210: 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 lobal x..puts $s
7220: 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 bye..close $s..
7230: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d set x done. }
7240: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
7250: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7260: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
7270: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7280: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7290: 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e 63 20 ntKey \..-async
72a0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
72b0: 32 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 2830]. vwait
72c0: 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 x. set z [get
72d0: 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 s $s1]. close
72e0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
72f0: 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 1. set z.} by
7300: 65 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 e..test socket-9
7310: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 .1 {testing spur
7320: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d ious events} {em
7330: 70 74 79 20 73 6f 63 6b 65 74 20 70 63 43 72 61 pty socket pcCra
7340: 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 sh} {. set le
7350: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
7360: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
7370: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
7380: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
7390: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
73a0: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
73b0: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
73c0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
73d0: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
73e0: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
73f0: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
7400: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
7410: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
7420: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
7430: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
7440: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
7450: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
7460: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
7470: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
7480: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
7490: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c ffering none -bl
74a0: 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 ocking off..file
74b0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
74c0: 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 e [list readlitt
74d0: 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 le $s]. }.
74e0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
74f0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7500: 70 74 20 32 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 2831]. set
7510: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
7520: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
7530: 32 38 33 31 5d 0a 20 20 20 20 70 75 74 73 20 2d 2831]. puts -
7540: 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 nonewline $c 012
7550: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
7560: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
7570: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 567890123456789.
7580: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
7590: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
75a0: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
75b0: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
75c0: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
75d0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
75e0: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
75f0: 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 s. list $spur
7600: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 ious $len.} {0 5
7610: 30 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 0}..test socket-
7620: 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 9.2 {testing asy
7630: 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 nc write, fileev
7640: 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 ents, flush on c
7650: 6c 6f 73 65 7d 20 7b 65 6d 70 74 79 20 73 6f 63 lose} {empty soc
7660: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
7670: 20 20 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 set firstbloc
7680: 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 k "". for {se
7690: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
76a0: 7b 69 6e 63 72 20 69 7d 20 7b 73 65 74 20 66 69 {incr i} {set fi
76b0: 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 rstblock "a$firs
76c0: 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 tblock$firstbloc
76d0: 6b 22 7d 0a 20 20 20 20 73 65 74 20 73 65 63 6f k"}. set seco
76e0: 6e 64 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 ndblock "". f
76f0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
7700: 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 < 16} {incr i}
7710: 7b 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f {..set secondblo
7720: 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 ck "b$secondbloc
7730: 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 k$secondblock".
7740: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 20 5b }. set l [
7750: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7760: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d ver accept 2832]
7770: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7780: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
7790: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
77a0: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
77b0: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a on lf -buffersiz
77c0: 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 e 16384 \...-buf
77d0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
77e0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
77f0: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
7800: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7810: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
7820: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
7830: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
7840: 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 adable {}..after
7850: 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 1000 respond $s
7860: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7870: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 respond {s} {..g
7880: 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b lobal firstblock
7890: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
78a0: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
78b0: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
78c0: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
78d0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
78e0: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
78f0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 secondblock..pu
7900: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
7910: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 $secondblock..c
7920: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
7930: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7940: 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e cket [info hostn
7950: 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 20 66 ame] 2832]. f
7960: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
7970: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
7980: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
7990: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
79a0: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
79b0: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
79c0: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
79d0: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
79e0: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
79f0: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
7a00: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
7a10: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
7a20: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
7a30: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
7a40: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
7a50: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7a60: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
7a70: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7a80: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
7a90: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
7aa0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
7ab0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
7ac0: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c mer. close $l
7ad0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
7ae0: 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 65566..test soc
7af0: 6b 65 74 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 ket-9.3 {testing
7b00: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
7b10: 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 20 70 {empty socket p
7b20: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 70 72 cCrash} {. pr
7b30: 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 oc count_to_eof
7b40: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
7b50: 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 unt done timer..
7b60: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
7b70: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
7b80: 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 .. incr count
7b90: 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 .. if {$count
7ba0: 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 > 9} {...close
7bb0: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 $s...set done tr
7bc0: 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b ue...set count {
7bd0: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 eof is sticky}..
7be0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
7bf0: 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 imer.. }..}.
7c00: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
7c10: 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c merproc {} {..gl
7c20: 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 obal done count
7c30: 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 c..set done true
7c40: 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d ..set count {tim
7c50: 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 er went off, eof
7c60: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
7c70: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 .close $c. }.
7c80: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
7c90: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 . set done fa
7ca0: 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 lse. proc wri
7cb0: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 te_then_close {s
7cc0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 } {..puts $s bye
7cd0: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7ce0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7cf0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
7d00: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
7d10: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
7d20: 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 lation lf..filee
7d30: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
7d40: 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f "write_then_clo
7d50: 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 se $s". }.
7d60: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7d70: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7d80: 70 74 20 32 38 33 33 5d 0a 20 20 20 20 73 65 74 pt 2833]. set
7d90: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
7da0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
7db0: 32 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2833]. fconfi
7dc0: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
7dd0: 67 20 6f 66 66 20 2d 62 75 66 66 65 72 69 6e 67 g off -buffering
7de0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
7df0: 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 on lf. fileev
7e00: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
7e10: 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 "count_to_eof $c
7e20: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
7e30: 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 [after 1000 time
7e40: 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 rproc]. vwait
7e50: 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 done. close
7e60: 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $s. set count
7e70: 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b .} {eof is stick
7e80: 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 y}..removeFile s
7e90: 63 72 69 70 74 0a 0a 74 65 73 74 20 73 6f 63 6b cript..test sock
7ea0: 65 74 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 et-10.1 {testing
7eb0: 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 socket accept c
7ec0: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 allback error ha
7ed0: 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 20 ndling} {socket
7ee0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
7ef0: 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 et goterror 0.
7f00: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
7f10: 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 rgs {global gote
7f20: 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 rror; set goterr
7f30: 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 or 1}. set s
7f40: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7f50: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
7f60: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
7f70: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7f80: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
7f90: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
7fa0: 32 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 2898]. proc a
7fb0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
7fc0: 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a lose $s; error}.
7fd0: 20 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a set c [tls:
7fe0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7ff0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8000: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8010: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8020: 74 4b 65 79 20 5c 0a 09 31 32 37 2e 30 2e 30 2e tKey \..127.0.0.
8030: 31 20 32 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 2898]. vwai
8040: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
8050: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
8060: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
8070: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
8080: 73 6f 63 6b 65 74 2d 31 31 2e 31 20 7b 74 63 70 socket-11.1 {tcp
8090: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
80a0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
80b0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
80c0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
80d0: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
80e0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
80f0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
8100: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
8110: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8120: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
8130: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
8140: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8150: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
8160: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
8170: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8180: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
8190: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
81a0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
81b0: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
81c0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
81d0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
81e0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
81f0: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
8200: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
8210: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
8220: 4b 65 79 20 5c 0a 09 09 32 38 33 34 5d 0a 09 70 Key \...2834]..p
8230: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8240: 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 p} {.. puts $
8250: 73 20 64 6f 6e 65 0a 09 20 20 20 20 74 6c 73 3a s done.. tls:
8260: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
8270: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
8280: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
8290: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
82a0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
82b0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
82c0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
82d0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
82e0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
82f0: 72 49 50 20 32 38 33 34 5d 0a 20 20 20 20 73 65 rIP 2834]. se
8300: 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t r [gets $s].
8310: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
8320: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
8330: 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 e $socket9_1_tes
8340: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
8350: 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 t r.} done..test
8360: 20 73 6f 63 6b 65 74 2d 31 31 2e 32 20 7b 63 6c socket-11.2 {cl
8370: 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 ient specifies i
8380: 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 ts port} {socket
8390: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
83a0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
83b0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
83c0: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
83d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
83e0: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
83f0: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
8400: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8410: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
8420: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
8430: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
8440: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
8450: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
8460: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8470: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
8480: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
8490: 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 xists port]} {..
84a0: 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 incr port. }
84b0: 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 else {..set port
84c0: 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b 70 [expr 2048 + [p
84d0: 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d 0a id]%1024]. }.
84e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
84f0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 {..set socket9_2
8500: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8510: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8520: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
8530: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
8540: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
8550: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
8560: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8570: 0a 09 20 20 20 20 32 38 33 35 5d 0a 09 70 72 6f .. 2835]..pro
8580: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
8590: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
85a0: 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 $p.. close $s
85b0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
85c0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
85d0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
85e0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
85f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8600: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8610: 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 y \.. -myport
8620: 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 $port $remoteSe
8630: 72 76 65 72 49 50 20 32 38 33 35 5d 0a 20 20 20 rverIP 2835].
8640: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d set r [gets $s]
8650: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
8660: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
8670: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f lose $socket9_2_
8680: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
8690: 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 if {$r == $port
86a0: 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 } {..set result
86b0: 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ok. } else {.
86c0: 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b .set result brok
86d0: 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 en. }. set
86e0: 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 result.} ok.tes
86f0: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 33 20 7b 74 t socket-11.3 {t
8700: 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 rying to connect
8710: 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f , no server} {so
8720: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8730: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8740: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f set status o
8750: 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 k. if {![catc
8760: 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 h {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 24 72 entKey \.. $r
87c0: 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 32 38 emoteServerIp 28
87d0: 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 36]}]} {..if {![
87e0: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d catch {gets $s}]
87f0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
8800: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
8810: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
8820: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
8830: 6b 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 k..test socket-1
8840: 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 1.4 {remote echo
8850: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
8860: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8870: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8880: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8890: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
88a0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
88b0: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
88c0: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
88d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
88e0: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
88f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
8900: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8910: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
8920: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
8930: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8940: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
8950: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8960: 61 6e 64 20 7b 0a 20 20 20 20 09 67 6c 6f 62 61 and {. .globa
8970: 6c 20 73 65 72 76 65 72 43 65 72 74 0a 09 67 6c l serverCert..gl
8980: 6f 62 61 6c 20 63 61 43 65 72 74 0a 09 67 6c 6f obal caCert..glo
8990: 62 61 6c 20 73 65 72 76 65 72 4b 65 79 0a 09 73 bal serverKey..s
89a0: 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 et socket10_6_te
89b0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
89c0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
89d0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
89e0: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
89f0: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
8a00: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
8a10: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
8a20: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
8a30: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
8a40: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
8a50: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
8a60: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
8a70: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
8a80: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
8a90: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
8aa0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
8ab0: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
8ac0: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
8ad0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
8ae0: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
8af0: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
8b00: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
8b10: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
8b20: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
8b30: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
8b40: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8b50: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
8b60: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
8b70: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
8b80: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
8b90: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
8ba0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
8bb0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
8bc0: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
8bd0: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
8be0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
8bf0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
8c00: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
8c10: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
8c20: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 set r.} hello..t
8c30: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 35 20 est socket-11.5
8c40: 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 {remote echo, 50
8c50: 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 lines} {socket
8c60: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
8c70: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
8c80: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
8c90: 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a caCert $caCert".
8ca0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8cb0: 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 "set serverCert
8cc0: 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 $serverCert".
8cd0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8ce0: 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c t clientCert $cl
8cf0: 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 ientCert". se
8d00: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
8d10: 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 erverKey $server
8d20: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
8d30: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
8d40: 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a Key $clientKey".
8d50: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8d60: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
8d70: 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 7_test_server [t
8d80: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
8d90: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
8da0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8db0: 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 ert \...-cafile
8dc0: 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 $caCert \...-key
8dd0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8de0: 5c 0a 09 09 32 38 33 36 5d 0a 09 70 72 6f 63 20 \...2836]..proc
8df0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8e00: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
8e10: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
8e20: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
8e30: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8e40: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
8e50: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
8e60: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
8e70: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
8e80: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
8e90: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
8ea0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
8eb0: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
8ec0: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
8ed0: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
8ee0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8ef0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8f00: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8f10: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8f20: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8f30: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
8f40: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
8f50: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
8f60: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
8f70: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
8f80: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
8f90: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
8fa0: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
8fb0: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
8fc0: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
8fd0: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
8fe0: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
8ff0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
9000: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
9010: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
9020: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9030: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
9040: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9050: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
9060: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
9070: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
9080: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
9090: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
90a0: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
90b0: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
90c0: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
90d0: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 32 38 33 ictResult {0 283
90e0: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
90f0: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
9100: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
9110: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
9120: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
9130: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 73 6f use}}.}..test so
9140: 63 6b 65 74 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 cket-11.6 {socke
9150: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
9160: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9170: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9180: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
9190: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
91a0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
91b0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
91c0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
91d0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
91e0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
91f0: 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 36]. if {[cat
9200: 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a ch {set s2 [tls:
9210: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9220: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9230: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9240: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9250: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
9260: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
9270: 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 836]} msg]} {..s
9280: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
9290: 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 1 $msg]. } el
92a0: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
92b0: 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 [list 0 [lindex
92c0: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 [fconfigure $s2
92d0: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a -sockname] 2]].
92e0: 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d .close $s2. }
92f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
9300: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
9310: 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a $conflictResult.
9320: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e .test socket-11.
9330: 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 7 {server with s
9340: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
9350: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9360: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9370: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
9380: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
9390: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
93a0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
93b0: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
93c0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
93d0: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
93e0: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
93f0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9400: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9410: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9420: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9430: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9440: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
9450: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
9460: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9470: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
9480: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
9490: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
94a0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
94b0: 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f echo $s]..}..pro
94c0: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
94d0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
94e0: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
94f0: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
9500: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
9510: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
9520: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
9530: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
9540: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9550: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9560: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9570: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9580: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9590: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
95a0: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
95b0: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
95c0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
95d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
95e0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
95f0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9600: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9610: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9620: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9630: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
9640: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
9650: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9660: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
9670: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9680: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9690: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
96a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
96b0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
96c0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
96d0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
96e0: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
96f0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
9700: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
9710: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
9720: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
9730: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
9740: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a ts $s2 hello,s2.
9750: 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 .gets $s2..puts
9760: 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 $s3 hello,s3..ge
9770: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
9780: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
9790: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
97a0: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
97b0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
97c0: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
97d0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 69 erver}. set i
97e0: 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 74 .} 100 ..test
97f0: 20 73 6f 63 6b 65 74 2d 31 31 2e 38 20 7b 63 6c socket-11.8 {cl
9800: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
9810: 6c 20 73 65 72 76 65 72 73 7d 20 7b 6b 6e 6f 77 l servers} {know
9820: 6e 42 75 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 nBug socket doTe
9830: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9840: 76 65 72 7d 20 7b 0a 09 23 20 74 68 69 73 20 6f ver} {..# this o
9850: 6e 65 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 ne seems to hang
9860: 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 -- awb 6/2/2000
9870: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9880: 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a {..set s1 [tls:
9890: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
98a0: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
98b0: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
98c0: 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 ver.pem] \...-ca
98d0: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
98e0: 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 [pwd] certs caFi
98f0: 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 le.pem] \...-key
9900: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9910: 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 [pwd] certs skey
9920: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 .pem] \...-serve
9930: 72 20 22 61 63 63 65 70 74 20 34 30 30 33 22 20 r "accept 4003"
9940: 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 4003]..set s2 [t
9950: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
9960: 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a certfile [file j
9970: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9980: 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 server.pem] \...
9990: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
99a0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
99b0: 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d aFile.pem] \...-
99c0: 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f keyfile [file jo
99d0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
99e0: 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 key.pem] \...-se
99f0: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
9a00: 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 4" 4004]..set s3
9a10: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9a20: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
9a30: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9a40: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
9a50: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9a60: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9a70: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9a80: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9a90: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9aa0: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9ab0: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
9ac0: 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 4005" 4005]..pro
9ad0: 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 c accept {mp s a
9ae0: 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 p} {.. puts
9af0: 24 73 20 24 6d 70 0a 09 20 20 20 20 63 6c 6f 73 $s $mp.. clos
9b00: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
9b10: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9b20: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9b30: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9b40: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9b50: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9b60: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9b70: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
9b80: 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 03]. set s2 [
9b90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9ba0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9bb0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9bc0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9bd0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9be0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9bf0: 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65 rIP 4004]. se
9c00: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
9c10: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9c20: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9c30: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9c40: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9c50: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9c60: 65 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a eServerIP 4005].
9c70: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
9c80: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 lappend l [gets
9c90: 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d $s1] [gets $s1]
9ca0: 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 [eof $s1] [gets
9cb0: 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d $s2] [gets $s2]
9cc0: 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 [eof $s2] \..[g
9cd0: 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 ets $s3] [gets $
9ce0: 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 s3] [eof $s3].
9cf0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9d00: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
9d10: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
9d20: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 Command {..close
9d30: 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a $s1..close $s2.
9d40: 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d .close $s3. }
9d50: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 . set l.} {40
9d60: 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 03 {} 1 4004 {}
9d70: 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 1 4005 {} 1}..te
9d80: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 39 20 7b st socket-11.9 {
9d90: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
9da0: 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 70 error} {socket p
9db0: 63 43 72 61 73 68 20 64 6f 54 65 73 74 73 57 69 cCrash doTestsWi
9dc0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9dd0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
9de0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9df0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9e00: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9e10: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9e20: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
9e30: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
9e40: 32 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 2836]. proc a
9e50: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 ccept {s a p} {e
9e60: 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 xpr 10 / 0}.
9e70: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
9e80: 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 s {..global x..s
9e90: 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d et x $args. }
9ea0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9eb0: 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 "set caCert $ca
9ec0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
9ed0: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
9ee0: 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 rCert $serverCer
9ef0: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
9f00: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 nd "set clientCe
9f10: 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a rt $clientCert".
9f20: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9f30: 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 "set serverKey $
9f40: 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 serverKey". s
9f50: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9f60: 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e clientKey $clien
9f70: 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b 63 tKey". if {[c
9f80: 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e atch {sendComman
9f90: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 d {.. set pee
9fa0: 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 rname [fconfigur
9fb0: 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 e $callerSocket
9fc0: 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 -peername]..
9fd0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9fe0: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
9ff0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 5c 0a 09 $clientCert \..
a000: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
a010: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 63 \...-keyfile $c
a020: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
a030: 09 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 .[lindex $peerna
a040: 6d 65 20 30 5d 20 32 38 33 36 5d 0a 09 20 20 20 me 0] 2836]..
a050: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 close $s. .
a060: 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 }} msg]} {..clos
a070: 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 e $s..error $msg
a080: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
a090: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
a0a0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
a0b0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
a0c0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
a0d0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
a0e0: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
a0f0: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
a100: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
a110: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
a120: 20 73 6f 63 6b 65 74 2d 31 31 2e 31 30 20 7b 74 socket-11.10 {t
a130: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
a140: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
a150: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a160: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a170: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
a180: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
a190: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
a1a0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
a1b0: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
a1c0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a1d0: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
a1e0: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
a1f0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a200: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
a210: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
a220: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a230: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
a240: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
a250: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
a260: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
a270: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
a280: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a290: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
a2a0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a2b0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a2c0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
a2d0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
a2e0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
a2f0: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
a300: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
a310: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
a320: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a330: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a340: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a350: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a360: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a370: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
a380: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
a390: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
a3a0: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
a3b0: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
a3c0: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
a3d0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
a3e0: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
a3f0: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
a400: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
a410: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
a420: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
a430: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
a440: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
a450: 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d 0a 0a 74 .} {2836 3 3}..t
a460: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 31 est socket-11.11
a470: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
a480: 75 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d 70 74 us events} {empt
a490: 79 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 y socket doTests
a4a0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
a4b0: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
a4c0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
a4d0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
a4e0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
a4f0: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
a500: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
a510: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
a520: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
a530: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
a540: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
a550: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
a560: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a570: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
a580: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
a590: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
a5a0: 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 socket10_13_test
a5b0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
a5c0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
a5d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
a5e0: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
a5f0: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
a600: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
a610: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
a620: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a630: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
a640: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
a650: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
a660: 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 lf".. after
a670: 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 100 writesome $s
a680: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 ..}..proc writes
a690: 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 ome {s} {.. f
a6a0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
a6b0: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
a6c0: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 {...puts $s "li
a6d0: 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 ne $i from remot
a6e0: 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d e server".. }
a6f0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
a700: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
a710: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
a720: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
a730: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
a740: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
a750: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
a760: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
a770: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
a780: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
a790: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
a7a0: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
a7b0: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
a7c0: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
a7d0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
a7e0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
a7f0: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
a800: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
a810: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
a820: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
a830: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a840: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a850: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a860: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a870: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a880: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a890: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
a8a0: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
a8b0: 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 able "readlittle
a8c0: 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d $c". set tim
a8d0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
a8e0: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
a8f0: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
a900: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
a910: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a920: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a930: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 ose $socket10_13
a940: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
a950: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
a960: 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d $len.} {0 2690}
a970: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 ..test socket-11
a980: 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 .12 {testing EOF
a990: 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f stickyness} {so
a9a0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
a9b0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
a9c0: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 set counter
a9d0: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0. set done 0
a9e0: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
a9f0: 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c up {s} {..global
aa00: 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 counter done af
aa10: 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 ter_id..set l [g
aa20: 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f ets $s]..if {[eo
aa30: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e f $s]} {.. in
aa40: 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 cr counter..
aa50: 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 if {$counter > 9
aa60: 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b } {...set done {
aa70: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 EOF is sticky}..
aa80: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 .after cancel $a
aa90: 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 fter_id...close
aaa0: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $s.. }..}.
aab0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
aac0: 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 d_out {} {..glob
aad0: 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 al c done..set d
aae0: 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 one {timed_out,
aaf0: 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b EOF is not stick
ab00: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
ab10: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
ab20: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
ab30: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
ab40: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
ab50: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
ab60: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
ab70: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
ab80: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
ab90: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
aba0: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
abb0: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
abc0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
abd0: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
abe0: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
abf0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
ac00: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
ac10: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
ac20: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
ac30: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
ac40: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
ac50: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
ac60: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
ac70: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
ac80: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
ac90: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 61 {s a p} {.. a
aca0: 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 fter 100 close $
acb0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
acc0: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
acd0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
ace0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
acf0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ad00: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
ad10: 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 ey \. .$remot
ad20: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
ad30: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
ad40: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
ad50: 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 _up $c". set
ad60: 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 after_id [after
ad70: 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 1000 timed_out].
ad80: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
ad90: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
ada0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
adb0: 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 14_test_server}.
adc0: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b set done.} {
add0: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a EOF is sticky}..
ade0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
adf0: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
ae00: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
ae10: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
ae20: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
ae30: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
ae40: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
ae50: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
ae60: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
ae70: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
ae80: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
ae90: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
aea0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
aeb0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
aec0: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
aed0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
aee0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
aef0: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
af00: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
af10: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
af20: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
af30: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
af40: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
af50: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
af60: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
af70: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
af80: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
af90: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
afa0: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
afb0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
afc0: 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 .set firstblock
afd0: 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ""..for {set i 0
afe0: 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 } {$i < 5} {incr
aff0: 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 73 i} {...set firs
b000: 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 tblock "a$firstb
b010: 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 lock$firstblock"
b020: 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 ..}..set secondb
b030: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
b040: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d t i 0} {$i < 16}
b050: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
b060: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
b070: 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 "b$secondblock$
b080: 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d 0a secondblock"..}.
b090: 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 .set l [tls::soc
b0a0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
b0b0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
b0c0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
b0d0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
b0e0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
b0f0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 34 erver accept 284
b100: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
b110: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
b120: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
b130: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
b140: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
b150: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d size 16384 \...-
b160: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
b170: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
b180: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 readable "reada
b190: 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 ble $s"..}..proc
b1a0: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
b1b0: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
b1c0: 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 $s].. fileev
b1d0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
b1e0: 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 {}.. after 10
b1f0: 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 00 respond $s..}
b200: 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b ..proc respond {
b210: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
b220: 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 firstblock..
b230: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
b240: 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a $s $firstblock.
b250: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
b260: 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a writedata $s..}.
b270: 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 .proc writedata
b280: 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 {s} {.. globa
b290: 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 l secondblock..
b2a0: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
b2b0: 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f ne $s $secondblo
b2c0: 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ck.. close $s
b2d0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b2e0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
b2f0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
b300: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
b310: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
b320: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
b330: 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 65 y \. .$remote
b340: 53 65 72 76 65 72 49 50 20 32 38 34 35 5d 0a 20 ServerIP 2845].
b350: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
b360: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
b370: 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ans lf -bufferin
b380: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
b390: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
b3a0: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c $s hello. fil
b3b0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
b3c0: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
b3d0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
b3e0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
b3f0: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
b400: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
b410: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
b420: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 $timer. sendC
b430: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c ommand {close $l
b440: 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a }. set count.
b450: 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f } 65566..test so
b460: 63 6b 65 74 2d 31 32 2e 31 20 7b 74 65 73 74 69 cket-12.1 {testi
b470: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
b480: 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 f server sockets
b490: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b4a0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b4b0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rver} {. remo
b4c0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
b4d0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
b4e0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
b4f0: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
b500: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
b510: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
b520: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
b530: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
b540: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
b550: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
b560: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
b570: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
b580: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
b590: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
b5a0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
b5b0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
b5c0: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
b5d0: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
b5e0: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
b5f0: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
b600: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
b610: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
b620: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
b630: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
b640: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
b650: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
b660: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
b670: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
b680: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
b690: 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 set tcltest $::t
b6a0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
b6b0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
b6c0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
b6d0: 74 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 67 65 tcltest..package
b6e0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
b6f0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
b700: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
b710: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
b720: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
b730: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
b740: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b750: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 e $serverKey 282
b760: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
b770: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
b780: 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 { file addr por
b790: 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 t } {.. close
b7a0: 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 $file..}..exec
b7b0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
b7c0: 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 63 est script1 &..c
b7d0: 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 lose $f..after 1
b7e0: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
b7f0: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
b800: 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 close $f...
b810: 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 # Launch script
b820: 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 2 and wait 5 sec
b830: 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 onds.. exec $
b840: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
b850: 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 st script2 &.
b860: 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 after 5000 { se
b870: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
b880: 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 1 }. vwait ok
b890: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
b8a0: 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 # If we can sti
b8b0: 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 ll connect to th
b8c0: 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f e server, the so
b8d0: 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 cket got inherit
b8e0: 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 ed... if {[ca
b8f0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
b900: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
b910: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b920: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b930: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b940: 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 32 . 127.0.0.1 2
b950: 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 828} msg]} {..se
b960: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
b970: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
b980: 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ited}. } else
b990: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 {..close $msg..
b9a0: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
b9b0: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
b9c0: 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 ed}. }.. r
b9d0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
b9e0: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
b9f0: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
ba00: 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 x.} {server soc
ba10: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
ba20: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 rited}..test soc
ba30: 6b 65 74 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e ket-12.2 {testin
ba40: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
ba50: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d client sockets}
ba60: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
ba70: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
ba80: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
ba90: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
baa0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
bab0: 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 ipt2.. # Scri
bac0: 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 pt1 is just a 10
bad0: 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 second delay.
bae0: 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f If the server so
baf0: 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e cket. # is in
bb00: 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c herited, it will
bb10: 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f be held open fo
bb20: 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 r 10 seconds..
bb30: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
bb40: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
bb50: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
bb60: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
bb70: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
bb80: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
bb90: 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 20 # Script2 opens
bba0: 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 the client socke
bbb0: 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f 20 t and writes to
bbc0: 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 20 it. It then.
bbd0: 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 # launches scri
bbe0: 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 20 pt1 and exits.
bbf0: 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 6f If the child pro
bc00: 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 74 cess inherited t
bc10: 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 20 he. # client
bc20: 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b socket, the sock
bc30: 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 et will still be
bc40: 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 open... set
bc50: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
bc60: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
bc70: 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 list set tcltest
bc80: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
bc90: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
bca0: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
bcb0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
bcc0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
bcd0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
bce0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
bcf0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
bd00: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
bd10: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
bd20: 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 5c 5d 22 7.0.0.1 2829 \]"
bd30: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
bd40: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
bd50: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 :tcltest script1
bd60: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
bd70: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
bd80: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
bd90: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
bda0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
bdb0: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
bdc0: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
bdd0: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
bde0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
bdf0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
be00: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
be10: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
be20: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d 73 $serverKey \..-s
be30: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
be40: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
be50: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
be60: 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e ort } {...# When
be70: 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e the client conn
be80: 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 ects, establish
be90: 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 the read handler
bea0: 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a ..global server.
beb0: 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 .close $server..
bec0: 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 fileevent $file
bed0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 readable [list g
bee0: 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 etdata $file]..f
bef0: 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 configure $file
bf00: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
bf10: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 -blocking 0..ret
bf20: 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 urn. }. pr
bf30: 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c oc getdata { fil
bf40: 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 e } {...# Read h
bf50: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
bf60: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 cepted socket...
bf70: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
bf80: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
bf90: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
bfa0: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
bfb0: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
bfc0: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
bfd0: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
bfe0: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
bff0: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c000: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
c010: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
c020: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
c030: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
c040: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
c050: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
c060: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
c070: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
c080: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
c090: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
c0a0: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
c0b0: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
c0c0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c0d0: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
c0e0: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c0f0: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
c100: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
c110: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
c120: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
c130: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
c140: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
c150: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
c160: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
c170: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
c180: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
c190: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
c1a0: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
c1b0: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
c1c0: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
c1d0: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
c1e0: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
c1f0: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
c200: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
c210: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
c220: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c230: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c240: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
c250: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
c260: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
c270: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d ed. }. rem
c280: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
c290: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
c2a0: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
c2b0: 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 .} {client socke
c2c0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
c2d0: 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ted}..test socke
c2e0: 74 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 t-12.3 {testing
c2f0: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 inheritance of a
c300: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d ccepted sockets}
c310: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
c320: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
c330: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
c340: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
c350: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c360: 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 ipt2.. set f
c370: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
c380: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c390: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
c3a0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c3b0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c3c0: 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f.. set f [o
c3d0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
c3e0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
c3f0: 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a set tcltest $::
c400: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
c410: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c420: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
c430: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
c440: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
c450: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c460: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c470: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c480: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c490: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c4a0: 65 72 76 65 72 4b 65 79 20 32 39 33 30 20 5c 5d erverKey 2930 \]
c4b0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
c4c0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 .proc accept { f
c4d0: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
c4e0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 {.. global tc
c4f0: 6c 74 65 73 74 0a 09 20 20 20 20 70 75 74 73 20 ltest.. puts
c500: 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 $file {test data
c510: 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 on socket}..
c520: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c530: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c540: 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 1 &.. after 1
c550: 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 000 exit..}..vwa
c560: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c580: 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 # Launch the
c590: 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 script2 process
c5a0: 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 and connect to i
c5b0: 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 t. See how long
c5c0: 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 . # the socke
c5d0: 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 t stays open..
c5e0: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
c5f0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
c600: 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 t2 &.. after
c610: 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 1000 set ok_to_p
c620: 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 roceed 1. vwa
c630: 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 it ok_to_proceed
c640: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 .. set f [tls
c650: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
c660: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
c670: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
c680: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
c690: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
c6a0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 39 33 30 5d 127.0.0.1 2930]
c6b0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
c6c0: 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 $f -buffering fu
c6d0: 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ll -blocking 0.
c6e0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 fileevent $f
c6f0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 readable [list g
c700: 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 20 etdata $f]..
c710: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
c720: 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 is still open af
c730: 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 ter 5 seconds, t
c740: 68 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 he script1 proce
c750: 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 ss. # must ha
c760: 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 ve inherited the
c770: 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 accepted socket
c780: 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 ... set faile
c790: 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 d 0. after 50
c7a0: 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 00 set failed 1.
c7b0: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 . proc getdat
c7c0: 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 a { file } {...#
c7d0: 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e Read handler on
c7e0: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b the client sock
c7f0: 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 et...global x..g
c800: 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 lobal failed..se
c810: 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 t status [catch
c820: 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 {read $file} dat
c830: 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 a]..if {$status
c840: 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 != 0} {.. set
c850: 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c x {read failed,
c860: 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 error was $data
c870: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c880: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
c890: 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 elseif {[string
c8a0: 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 compare {} $data
c8b0: 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b ]} {..} elseif {
c8c0: 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d [fblocked $file]
c8d0: 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b } {..} elseif {[
c8e0: 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 eof $file]} {..
c8f0: 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 if {$failed}
c900: 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 {...set x {accep
c910: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ted socket was i
c920: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
c930: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 else {...set x
c940: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
c950: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c960: 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ed}.. }..
c970: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
c980: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a ile }..} else {.
c990: 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f . set x {impo
c9a0: 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 ssible case}..
c9b0: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c9c0: 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 $file }..}..retu
c9d0: 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 20 rn. }. .
c9e0: 20 20 76 77 61 69 74 20 78 0a 0a 20 20 20 20 72 vwait x.. r
c9f0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
ca00: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
ca10: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
ca20: 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 x.} {accepted s
ca30: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
ca40: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 73 herited}..test s
ca50: 6f 63 6b 65 74 2d 31 33 2e 31 20 7b 54 65 73 74 ocket-13.1 {Test
ca60: 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 ing use of share
ca70: 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e d socket between
ca80: 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a two threads} \.
ca90: 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 .{socket testthr
caa0: 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f ead} {.. remo
cab0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
cac0: 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 threadReap..
cad0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 makeFile {.
cae0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
caf0: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
cb00: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
cb10: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 r accept 2828]..
cb20: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
cb30: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
cb40: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
cb50: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
cb60: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
cb70: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
cb80: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
cb90: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
cba0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
cbb0: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
cbc0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
cbd0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
cbe0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
cbf0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
cc00: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
cc10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cc20: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
cc30: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
cc40: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
cc50: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
cc60: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
cc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
cc80: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
cc90: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
cca0: 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c i 0..vwait x..cl
ccb0: 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 ose $f...# threa
ccc0: 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 d cleans itself
ccd0: 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 up...testthread
cce0: 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 exit. } scrip
ccf0: 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 t. . # cre
cd00: 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 ate a thread.
cd10: 20 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 set serverthrea
cd20: 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 d [testthread cr
cd30: 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 eate { source sc
cd40: 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 ript } ]. upd
cd50: 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 ate. . aft
cd60: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
cd70: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 s [tls::socket 1
cd80: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 27.0.0.1 2828].
cd90: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
cda0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
cdb0: 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 .. catch {..p
cdc0: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 uts $s "hello"..
cdd0: 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 gets $s result.
cde0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
cdf0: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 s. update..
ce00: 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 after 2000.
ce10: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
ce20: 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 [threadReap].
ce30: 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 . set result
ce40: 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 ..} {hello 1}..#
ce50: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
ce60: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
ce70: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
ce80: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
ce90: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
cea0: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
ceb0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
cec0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
ced0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
cee0: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
cef0: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
cf00: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
cf10: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
cf20: 65 74 75 72 6e 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a eturn...........
cf30: 0a .