Artifact
b1e4530462df2800ba4d87a3f328a9ea45fcd21cd22bd17d77ac6316ac26343c:
0000: 23 20 54 68 69 73 20 66 69 6c 65 20 63 6f 6e 74 # This file cont
0010: 61 69 6e 73 20 54 63 6c 20 63 6f 64 65 20 74 6f ains Tcl code to
0020: 20 69 6d 70 6c 65 6d 65 6e 74 20 61 20 72 65 6d implement a rem
0030: 6f 74 65 20 73 65 72 76 65 72 20 74 68 61 74 20 ote server that
0040: 63 61 6e 20 62 65 0a 23 20 75 73 65 64 20 64 75 can be.# used du
0050: 72 69 6e 67 20 74 65 73 74 69 6e 67 20 6f 66 20 ring testing of
0060: 54 63 6c 20 73 6f 63 6b 65 74 20 63 6f 64 65 2e Tcl socket code.
0070: 20 54 68 69 73 20 73 65 72 76 65 72 20 69 73 20 This server is
0080: 75 73 65 64 20 62 79 20 73 6f 6d 65 0a 23 20 6f used by some.# o
0090: 66 20 74 68 65 20 74 65 73 74 73 20 69 6e 20 73 f the tests in s
00a0: 6f 63 6b 65 74 2e 74 65 73 74 2e 0a 23 0a 23 20 ocket.test..#.#
00b0: 53 6f 75 72 63 65 20 74 68 69 73 20 66 69 6c 65 Source this file
00c0: 20 69 6e 20 74 68 65 20 72 65 6d 6f 74 65 20 73 in the remote s
00d0: 65 72 76 65 72 20 79 6f 75 20 61 72 65 20 75 73 erver you are us
00e0: 69 6e 67 20 74 6f 20 74 65 73 74 20 54 63 6c 20 ing to test Tcl
00f0: 61 67 61 69 6e 73 74 2e 0a 23 0a 23 20 43 6f 70 against..#.# Cop
0100: 79 72 69 67 68 74 20 28 63 29 20 31 39 39 35 2d yright (c) 1995-
0110: 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 73 79 1996 Sun Microsy
0120: 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 0a 23 20 stems, Inc..#.#
0130: 53 65 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 See the file "li
0140: 63 65 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 cense.terms" for
0150: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 information on
0160: 75 73 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 usage and redist
0170: 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 ribution.# of th
0180: 69 73 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 is file, and for
0190: 20 61 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 a DISCLAIMER OF
01a0: 20 41 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e ALL WARRANTIES.
01b0: 0a 23 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 .#.# RCS: @(#) $
01c0: 49 64 3a 20 72 65 6d 6f 74 65 2e 74 63 6c 2c 76 Id: remote.tcl,v
01d0: 20 31 2e 36 20 32 30 30 34 2f 30 32 2f 31 31 20 1.6 2004/02/11
01e0: 32 32 3a 34 31 3a 32 35 20 72 61 7a 7a 65 6c 6c 22:41:25 razzell
01f0: 20 45 78 70 20 24 0a 0a 23 20 6c 6f 61 64 20 74 Exp $..# load t
0200: 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 ls package.packa
0210: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a ge require tls..
0220: 23 20 49 6e 69 74 69 61 6c 69 7a 65 20 6d 65 73 # Initialize mes
0230: 73 61 67 65 20 64 65 6c 69 6d 69 74 6f 72 0a 0a sage delimitor..
0240: 23 20 49 6e 69 74 69 61 6c 69 7a 65 20 63 6f 6d # Initialize com
0250: 6d 61 6e 64 20 61 72 72 61 79 0a 63 61 74 63 68 mand array.catch
0260: 20 7b 75 6e 73 65 74 20 63 6f 6d 6d 61 6e 64 7d {unset command}
0270: 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 28 30 29 20 .set command(0)
0280: 22 22 0a 73 65 74 20 63 61 6c 6c 65 72 53 6f 63 "".set callerSoc
0290: 6b 65 74 20 22 22 0a 0a 23 20 44 65 74 65 63 74 ket ""..# Detect
02a0: 20 77 68 65 74 68 65 72 20 77 65 20 73 68 6f 75 whether we shou
02b0: 6c 64 20 70 72 69 6e 74 20 6f 75 74 20 63 6f 6e ld print out con
02c0: 6e 65 63 74 69 6f 6e 20 6d 65 73 73 61 67 65 73 nection messages
02d0: 20 65 74 63 2e 0a 23 20 73 65 74 20 56 45 52 42 etc..# set VERB
02e0: 4f 53 45 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f OSE 1.if {![info
02f0: 20 65 78 69 73 74 73 20 56 45 52 42 4f 53 45 5d exists VERBOSE]
0300: 7d 20 7b 0a 20 20 20 20 73 65 74 20 56 45 52 42 } {. set VERB
0310: 4f 53 45 20 30 0a 7d 0a 0a 70 72 6f 63 20 5f 5f OSE 0.}..proc __
0320: 64 6f 43 6f 6d 6d 61 6e 64 73 5f 5f 20 7b 6c 20 doCommands__ {l
0330: 73 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 s} {. global
0340: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 56 45 52 callerSocket VER
0350: 42 4f 53 45 0a 0a 20 20 20 20 69 66 20 7b 24 56 BOSE.. if {$V
0360: 45 52 42 4f 53 45 7d 20 7b 0a 09 70 75 74 73 20 ERBOSE} {..puts
0370: 22 2d 2d 2d 20 53 65 72 76 65 72 20 65 78 65 63 "--- Server exec
0380: 75 74 69 6e 67 20 74 68 65 20 66 6f 6c 6c 6f 77 uting the follow
0390: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 24 ing for socket $
03a0: 73 3a 22 0a 09 70 75 74 73 20 24 6c 0a 09 70 75 s:"..puts $l..pu
03b0: 74 73 20 22 2d 2d 2d 22 0a 20 20 20 20 7d 0a 20 ts "---". }.
03c0: 20 20 20 69 66 20 7b 30 7d 20 7b 0a 09 73 65 74 if {0} {..set
03d0: 20 66 64 20 5b 6f 70 65 6e 20 72 65 6d 6f 74 65 fd [open remote
03e0: 53 65 72 76 65 72 2e 6c 6f 67 20 61 5d 0a 09 63 Server.log a]..c
03f0: 61 74 63 68 20 7b 70 75 74 73 20 24 66 64 20 22 atch {puts $fd "
0400: 73 6b 65 79 3a 20 24 73 65 72 76 65 72 4b 65 79 skey: $serverKey
0410: 22 7d 0a 09 70 75 74 73 20 24 66 64 20 22 2d 2d "}..puts $fd "--
0420: 2d 20 53 65 72 76 65 72 20 65 78 65 63 75 74 69 - Server executi
0430: 6e 67 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 ng the following
0440: 20 66 6f 72 20 73 6f 63 6b 65 74 20 24 73 3a 22 for socket $s:"
0450: 0a 09 70 75 74 73 20 24 66 64 20 24 6c 0a 09 70 ..puts $fd $l..p
0460: 75 74 73 20 24 66 64 20 22 2d 2d 2d 22 0a 09 63 uts $fd "---"..c
0470: 6c 6f 73 65 20 24 66 64 0a 20 20 20 20 7d 0a 20 lose $fd. }.
0480: 20 20 20 73 65 74 20 63 61 6c 6c 65 72 53 6f 63 set callerSoc
0490: 6b 65 74 20 24 73 0a 20 20 20 20 69 66 20 7b 5b ket $s. if {[
04a0: 63 61 74 63 68 20 7b 75 70 6c 65 76 65 6c 20 23 catch {uplevel #
04b0: 30 20 24 6c 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 0 $l} msg]} {.
04c0: 20 20 09 69 66 20 7b 30 7d 20 7b 0a 09 20 20 20 .if {0} {..
04d0: 20 73 65 74 20 66 64 20 5b 6f 70 65 6e 20 72 65 set fd [open re
04e0: 6d 6f 74 65 53 65 72 76 65 72 2e 6c 6f 67 20 61 moteServer.log a
04f0: 5d 0a 09 20 20 20 20 70 75 74 73 20 24 66 64 20 ].. puts $fd
0500: 22 65 72 72 6f 72 3a 20 24 6d 73 67 22 0a 09 20 "error: $msg"..
0510: 20 20 20 63 6c 6f 73 65 20 24 66 64 0a 09 7d 0a close $fd..}.
0520: 09 6c 69 73 74 20 65 72 72 6f 72 20 24 6d 73 67 .list error $msg
0530: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 6c . } else {..l
0540: 69 73 74 20 73 75 63 63 65 73 73 20 24 6d 73 67 ist success $msg
0550: 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 5f . }.}..proc _
0560: 5f 72 65 61 64 41 6e 64 45 78 65 63 75 74 65 5f _readAndExecute_
0570: 5f 20 7b 73 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 _ {s} {. glob
0580: 61 6c 20 63 6f 6d 6d 61 6e 64 20 56 45 52 42 4f al command VERBO
0590: 53 45 0a 0a 20 20 20 20 73 65 74 20 6c 20 5b 67 SE.. set l [g
05a0: 65 74 73 20 24 73 5d 0a 20 20 20 20 69 66 20 7b ets $s]. if {
05b0: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
05c0: 24 6c 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 $l "--Marker--Ma
05d0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d rker--Marker--"]
05e0: 20 3d 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 == 0} {..if {[i
05f0: 6e 66 6f 20 65 78 69 73 74 73 20 63 6f 6d 6d 61 nfo exists comma
0600: 6e 64 28 24 73 29 5d 7d 20 7b 0a 09 20 20 20 20 nd($s)]} {..
0610: 70 75 74 73 20 24 73 20 5b 6c 69 73 74 20 65 72 puts $s [list er
0620: 72 6f 72 20 69 6e 63 6f 6d 70 6c 65 74 65 5f 63 ror incomplete_c
0630: 6f 6d 6d 61 6e 64 5d 0a 09 7d 0a 09 70 75 74 73 ommand]..}..puts
0640: 20 24 73 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d $s "--Marker--M
0650: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 arker--Marker--"
0660: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
0670: 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 if {[string c
0680: 6f 6d 70 61 72 65 20 24 6c 20 22 22 5d 20 3d 3d ompare $l ""] ==
0690: 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 65 6f 66 20 0} {..if {[eof
06a0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b $s]} {.. if {
06b0: 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 09 70 75 $VERBOSE} {...pu
06c0: 74 73 20 22 53 65 72 76 65 72 20 63 6c 6f 73 69 ts "Server closi
06d0: 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 6f 6d 20 ng $s, eof from
06e0: 63 6c 69 65 6e 74 22 0a 09 20 20 20 20 7d 0a 09 client".. }..
06f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
0700: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 .return. }.
0710: 20 20 61 70 70 65 6e 64 20 63 6f 6d 6d 61 6e 64 append command
0720: 28 24 73 29 20 24 6c 20 22 5c 6e 22 0a 20 20 20 ($s) $l "\n".
0730: 20 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 70 6c if {[info compl
0740: 65 74 65 20 24 63 6f 6d 6d 61 6e 64 28 24 73 29 ete $command($s)
0750: 5d 7d 20 7b 0a 09 73 65 74 20 63 6d 64 73 20 24 ]} {..set cmds $
0760: 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 75 6e 73 command($s)..uns
0770: 65 74 20 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 et command($s)..
0780: 70 75 74 73 20 24 73 20 5b 5f 5f 64 6f 43 6f 6d puts $s [__doCom
0790: 6d 61 6e 64 73 5f 5f 20 24 63 6d 64 73 20 24 73 mands__ $cmds $s
07a0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b ]. }. if {
07b0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 69 66 20 [eof $s]} {..if
07c0: 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 20 20 {$VERBOSE} {..
07d0: 20 20 70 75 74 73 20 22 53 65 72 76 65 72 20 63 puts "Server c
07e0: 6c 6f 73 69 6e 67 20 24 73 2c 20 65 6f 66 20 66 losing $s, eof f
07f0: 72 6f 6d 20 63 6c 69 65 6e 74 22 0a 09 7d 0a 09 rom client"..}..
0800: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 7d close $s. }.}
0810: 0a 0a 70 72 6f 63 20 5f 5f 61 63 63 65 70 74 5f ..proc __accept_
0820: 5f 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 _ {s a p} {.
0830: 67 6c 6f 62 61 6c 20 56 45 52 42 4f 53 45 0a 0a global VERBOSE..
0840: 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 if {$VERBOSE
0850: 7d 20 7b 0a 09 70 75 74 73 20 22 53 65 72 76 65 } {..puts "Serve
0860: 72 20 61 63 63 65 70 74 73 20 6e 65 77 20 63 6f r accepts new co
0870: 6e 6e 65 63 74 69 6f 6e 20 66 72 6f 6d 20 24 61 nnection from $a
0880: 3a 24 70 20 6f 6e 20 24 73 22 0a 20 20 20 20 7d :$p on $s". }
0890: 0a 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
08a0: 61 6b 65 20 24 73 0a 20 20 20 20 66 69 6c 65 65 ake $s. filee
08b0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
08c0: 20 5b 6c 69 73 74 20 5f 5f 72 65 61 64 41 6e 64 [list __readAnd
08d0: 45 78 65 63 75 74 65 5f 5f 20 24 73 5d 0a 20 20 Execute__ $s].
08e0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
08f0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
0900: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
0910: 66 0a 7d 0a 0a 73 65 74 20 73 65 72 76 65 72 49 f.}..set serverI
0920: 73 53 69 6c 65 6e 74 20 30 0a 66 6f 72 20 7b 73 sSilent 0.for {s
0930: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 et i 0} {$i < $a
0940: 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a rgc} {incr i} {.
0950: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
0960: 63 6f 6d 70 61 72 65 20 2d 73 65 72 76 65 72 49 compare -serverI
0970: 73 53 69 6c 65 6e 74 20 5b 6c 69 6e 64 65 78 20 sSilent [lindex
0980: 24 61 72 67 76 20 24 69 5d 5d 20 3d 3d 20 30 7d $argv $i]] == 0}
0990: 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 49 73 {..set serverIs
09a0: 53 69 6c 65 6e 74 20 31 0a 09 62 72 65 61 6b 0a Silent 1..break.
09b0: 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e }.}.if {![in
09c0: 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 fo exists server
09d0: 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 Port]} {. if
09e0: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e {[info exists en
09f0: 76 28 73 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 v(serverPort)]}
0a00: 7b 0a 09 73 65 74 20 73 65 72 76 65 72 50 6f 72 {..set serverPor
0a10: 74 20 24 65 6e 76 28 73 65 72 76 65 72 50 6f 72 t $env(serverPor
0a20: 74 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 t). }.}.if {!
0a30: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 [info exists ser
0a40: 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 verPort]} {.
0a50: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
0a60: 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 i < $argc} {incr
0a70: 20 69 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 72 69 i} {..if {[stri
0a80: 6e 67 20 63 6f 6d 70 61 72 65 20 2d 70 6f 72 74 ng compare -port
0a90: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 24 [lindex $argv $
0aa0: 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 i]] == 0} {..
0ab0: 20 69 66 20 7b 24 69 20 3c 20 5b 65 78 70 72 20 if {$i < [expr
0ac0: 24 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 $argc - 1]} {...
0ad0: 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 5b set serverPort [
0ae0: 6c 69 6e 64 65 78 20 24 61 72 67 76 20 5b 65 78 lindex $argv [ex
0af0: 70 72 20 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 pr $i + 1]]..
0b00: 20 7d 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d }.. break..}
0b10: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0b20: 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 nfo exists serve
0b30: 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 73 65 rPort]} {. se
0b40: 74 20 73 65 72 76 65 72 50 6f 72 74 20 38 30 34 t serverPort 804
0b50: 38 0a 7d 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 8.}..if {![info
0b60: 65 78 69 73 74 73 20 73 65 72 76 65 72 41 64 64 exists serverAdd
0b70: 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 69 66 20 ress]} {. if
0b80: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e {[info exists en
0b90: 76 28 73 65 72 76 65 72 41 64 64 72 65 73 73 29 v(serverAddress)
0ba0: 5d 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 ]} {..set server
0bb0: 41 64 64 72 65 73 73 20 24 65 6e 76 28 73 65 72 Address $env(ser
0bc0: 76 65 72 41 64 64 72 65 73 73 29 0a 20 20 20 20 verAddress).
0bd0: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
0be0: 78 69 73 74 73 20 73 65 72 76 65 72 41 64 64 72 xists serverAddr
0bf0: 65 73 73 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 20 ess]} {. for
0c00: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
0c10: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 $argc} {incr i}
0c20: 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 {..if {[string c
0c30: 6f 6d 70 61 72 65 20 2d 61 64 64 72 65 73 73 20 ompare -address
0c40: 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 24 69 [lindex $argv $i
0c50: 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 ]] == 0} {..
0c60: 69 66 20 7b 24 69 20 3c 20 5b 65 78 70 72 20 24 if {$i < [expr $
0c70: 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 argc - 1]} {...s
0c80: 65 74 20 73 65 72 76 65 72 41 64 64 72 65 73 73 et serverAddress
0c90: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 5b [lindex $argv [
0ca0: 65 78 70 72 20 24 69 20 2b 20 31 5d 5d 0a 09 20 expr $i + 1]]..
0cb0: 20 20 20 7d 0a 09 20 20 20 20 62 72 65 61 6b 0a }.. break.
0cc0: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 .}. }.}.if {!
0cd0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 [info exists ser
0ce0: 76 65 72 41 64 64 72 65 73 73 5d 7d 20 7b 0a 20 verAddress]} {.
0cf0: 20 20 20 73 65 74 20 73 65 72 76 65 72 41 64 64 set serverAdd
0d00: 72 65 73 73 20 30 2e 30 2e 30 2e 30 0a 7d 0a 0a ress 0.0.0.0.}..
0d10: 69 66 20 7b 24 73 65 72 76 65 72 49 73 53 69 6c if {$serverIsSil
0d20: 65 6e 74 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 ent == 0} {.
0d30: 73 65 74 20 6c 20 22 52 65 6d 6f 74 65 20 73 65 set l "Remote se
0d40: 72 76 65 72 20 6c 69 73 74 65 6e 69 6e 67 20 6f rver listening o
0d50: 6e 20 70 6f 72 74 20 24 73 65 72 76 65 72 50 6f n port $serverPo
0d60: 72 74 2c 20 49 50 20 24 73 65 72 76 65 72 41 64 rt, IP $serverAd
0d70: 64 72 65 73 73 2e 22 0a 20 20 20 20 70 75 74 73 dress.". puts
0d80: 20 22 22 0a 20 20 20 20 70 75 74 73 20 24 6c 0a "". puts $l.
0d90: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 20 5b for {set c [
0da0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
0db0: 5d 7d 20 7b 24 63 20 3e 20 30 7d 20 7b 69 6e 63 ]} {$c > 0} {inc
0dc0: 72 20 63 20 2d 31 7d 20 7b 70 75 74 73 20 2d 6e r c -1} {puts -n
0dd0: 6f 6e 65 77 6c 69 6e 65 20 22 2d 22 7d 0a 20 20 onewline "-"}.
0de0: 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 puts "". pu
0df0: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 22 ts "". puts "
0e00: 59 6f 75 20 68 61 76 65 20 73 65 74 20 74 68 65 You have set the
0e10: 20 54 63 6c 20 76 61 72 69 61 62 6c 65 73 20 73 Tcl variables s
0e20: 65 72 76 65 72 41 64 64 72 65 73 73 20 74 6f 20 erverAddress to
0e30: 24 73 65 72 76 65 72 41 64 64 72 65 73 73 20 61 $serverAddress a
0e40: 6e 64 22 0a 20 20 20 20 70 75 74 73 20 22 73 65 nd". puts "se
0e50: 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73 65 72 rverPort to $ser
0e60: 76 65 72 50 6f 72 74 2e 20 59 6f 75 20 63 61 6e verPort. You can
0e70: 20 73 65 74 20 74 68 65 73 65 20 77 69 74 68 20 set these with
0e80: 74 68 65 20 2d 61 64 64 72 65 73 73 20 61 6e 64 the -address and
0e90: 22 0a 20 20 20 20 70 75 74 73 20 22 2d 70 6f 72 ". puts "-por
0ea0: 74 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 6f t command line o
0eb0: 70 74 69 6f 6e 73 2c 20 6f 72 20 61 73 20 65 6e ptions, or as en
0ec0: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0ed0: 6c 65 73 20 69 6e 20 79 6f 75 72 22 0a 20 20 20 les in your".
0ee0: 20 70 75 74 73 20 22 73 68 65 6c 6c 2e 22 0a 20 puts "shell.".
0ef0: 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 puts "". p
0f00: 75 74 73 20 22 4e 4f 54 45 3a 20 54 68 65 20 74 uts "NOTE: The t
0f10: 65 73 74 73 20 77 69 6c 6c 20 6e 6f 74 20 77 6f ests will not wo
0f20: 72 6b 20 70 72 6f 70 65 72 6c 79 20 69 66 20 73 rk properly if s
0f30: 65 72 76 65 72 41 64 64 72 65 73 73 20 69 73 20 erverAddress is
0f40: 73 65 74 20 74 6f 22 0a 20 20 20 20 70 75 74 73 set to". puts
0f50: 20 22 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 "\"localhost\"
0f60: 6f 72 20 31 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 or 127.0.0.1.".
0f70: 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 puts "". p
0f80: 75 74 73 20 22 57 68 65 6e 20 79 6f 75 20 69 6e uts "When you in
0f90: 76 6f 6b 65 20 74 63 6c 74 65 73 74 20 74 6f 20 voke tcltest to
0fa0: 72 75 6e 20 74 68 65 20 74 65 73 74 73 2c 20 73 run the tests, s
0fb0: 65 74 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 et the variables
0fc0: 22 0a 20 20 20 20 70 75 74 73 20 22 72 65 6d 6f ". puts "remo
0fd0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 74 6f 20 teServerPort to
0fe0: 24 73 65 72 76 65 72 50 6f 72 74 20 61 6e 64 20 $serverPort and
0ff0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 74 remoteServerIP t
1000: 6f 22 0a 20 20 20 20 70 75 74 73 20 22 5b 69 6e o". puts "[in
1010: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 2e 20 59 6f fo hostname]. Yo
1020: 75 20 63 61 6e 20 73 65 74 20 74 68 65 73 65 20 u can set these
1030: 61 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 as environment v
1040: 61 72 69 61 62 6c 65 73 22 0a 20 20 20 20 70 75 ariables". pu
1050: 74 73 20 22 66 72 6f 6d 20 74 68 65 20 73 68 65 ts "from the she
1060: 6c 6c 2e 20 54 68 65 20 74 65 73 74 73 20 77 69 ll. The tests wi
1070: 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 70 72 6f 70 ll not work prop
1080: 65 72 6c 79 20 69 66 20 79 6f 75 20 73 65 74 22 erly if you set"
1090: 0a 20 20 20 20 70 75 74 73 20 22 72 65 6d 6f 74 . puts "remot
10a0: 65 53 65 72 76 65 72 49 50 20 74 6f 20 5c 22 6c eServerIP to \"l
10b0: 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 20 31 32 ocalhost\" or 12
10c0: 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 20 70 75 7.0.0.1.". pu
10d0: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 2d ts "". puts -
10e0: 6e 6f 6e 65 77 6c 69 6e 65 20 22 54 79 70 65 20 nonewline "Type
10f0: 43 74 72 6c 2d 43 20 74 6f 20 74 65 72 6d 69 6e Ctrl-C to termin
1100: 61 74 65 2d 2d 3e 20 22 0a 20 20 20 20 66 6c 75 ate--> ". flu
1110: 73 68 20 73 74 64 6f 75 74 0a 7d 0a 0a 73 65 74 sh stdout.}..set
1120: 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 certsDir.[file
1130: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 join [file dirna
1140: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d me [info script]
1150: 5d 20 63 65 72 74 73 5d 0a 73 65 74 20 73 65 72 ] certs].set ser
1160: 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f verCert.[file jo
1170: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 in $certsDir ser
1180: 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 ver.pem].set caC
1190: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
11a0: 63 65 72 74 73 44 69 72 20 63 61 63 65 72 74 2e certsDir cacert.
11b0: 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 4b pem].set serverK
11c0: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
11d0: 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 6b ertsDir server.k
11e0: 65 79 5d 0a 69 66 20 7b 5b 63 61 74 63 68 20 7b ey].if {[catch {
11f0: 73 65 74 20 73 65 72 76 65 72 53 6f 63 6b 65 74 set serverSocket
1200: 20 5c 0a 09 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 \..[tls::socket
1210: 20 2d 6d 79 61 64 64 72 20 24 73 65 72 76 65 72 -myaddr $server
1220: 41 64 64 72 65 73 73 20 2d 73 65 72 76 65 72 20 Address -server
1230: 5f 5f 61 63 63 65 70 74 5f 5f 20 5c 0a 09 2d 63 __accept__ \..-c
1240: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 63 afile $caCert -c
1250: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
1260: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
1270: 72 76 65 72 4b 65 79 20 5c 0a 09 24 73 65 72 76 rverKey \..$serv
1280: 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 7d 20 7b erPort]} msg]} {
1290: 0a 20 20 20 20 70 75 74 73 20 22 53 65 72 76 65 . puts "Serve
12a0: 72 20 6f 6e 20 24 73 65 72 76 65 72 41 64 64 72 r on $serverAddr
12b0: 65 73 73 3a 24 73 65 72 76 65 72 50 6f 72 74 20 ess:$serverPort
12c0: 63 61 6e 6e 6f 74 20 73 74 61 72 74 3a 20 24 6d cannot start: $m
12d0: 73 67 22 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 sg".} else {.
12e0: 20 76 77 61 69 74 20 5f 5f 73 65 72 76 65 72 5f vwait __server_
12f0: 77 61 69 74 5f 76 61 72 69 61 62 6c 65 5f 5f 0a wait_variable__.
1300: 7d 0a }.