Artifact
b409bf0b71d0c60677d067ec008795674971b272:
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 31 20 32 30 30 30 2f 30 36 2f 30 33 20 1.1 2000/06/03
01e0: 30 30 3a 32 30 3a 30 32 20 61 77 62 20 45 78 70 00:20:02 awb Exp
01f0: 20 24 0a 0a 23 20 6c 6f 61 64 20 74 6c 73 20 70 $..# load tls p
0200: 61 63 6b 61 67 65 0a 70 61 63 6b 61 67 65 20 72 ackage.package r
0210: 65 71 75 69 72 65 20 74 6c 73 0a 0a 23 20 49 6e equire tls..# In
0220: 69 74 69 61 6c 69 7a 65 20 6d 65 73 73 61 67 65 itialize message
0230: 20 64 65 6c 69 6d 69 74 6f 72 0a 0a 23 20 49 6e delimitor..# In
0240: 69 74 69 61 6c 69 7a 65 20 63 6f 6d 6d 61 6e 64 itialize command
0250: 20 61 72 72 61 79 0a 63 61 74 63 68 20 7b 75 6e array.catch {un
0260: 73 65 74 20 63 6f 6d 6d 61 6e 64 7d 0a 73 65 74 set command}.set
0270: 20 63 6f 6d 6d 61 6e 64 28 30 29 20 22 22 0a 73 command(0) "".s
0280: 65 74 20 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 et callerSocket
0290: 22 22 0a 0a 23 20 44 65 74 65 63 74 20 77 68 65 ""..# Detect whe
02a0: 74 68 65 72 20 77 65 20 73 68 6f 75 6c 64 20 70 ther we should p
02b0: 72 69 6e 74 20 6f 75 74 20 63 6f 6e 6e 65 63 74 rint out connect
02c0: 69 6f 6e 20 6d 65 73 73 61 67 65 73 20 65 74 63 ion messages etc
02d0: 2e 0a 73 65 74 20 56 45 52 42 4f 53 45 20 31 0a ..set VERBOSE 1.
02e0: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
02f0: 73 20 56 45 52 42 4f 53 45 5d 7d 20 7b 0a 20 20 s VERBOSE]} {.
0300: 20 20 73 65 74 20 56 45 52 42 4f 53 45 20 30 0a set VERBOSE 0.
0310: 7d 0a 0a 70 72 6f 63 20 5f 5f 64 6f 43 6f 6d 6d }..proc __doComm
0320: 61 6e 64 73 5f 5f 20 7b 6c 20 73 7d 20 7b 0a 20 ands__ {l s} {.
0330: 20 20 20 67 6c 6f 62 61 6c 20 63 61 6c 6c 65 72 global caller
0340: 53 6f 63 6b 65 74 20 56 45 52 42 4f 53 45 0a 0a Socket VERBOSE..
0350: 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 if {$VERBOSE
0360: 7d 20 7b 0a 09 70 75 74 73 20 22 2d 2d 2d 20 53 } {..puts "--- S
0370: 65 72 76 65 72 20 65 78 65 63 75 74 69 6e 67 20 erver executing
0380: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f the following fo
0390: 72 20 73 6f 63 6b 65 74 20 24 73 3a 22 0a 09 70 r socket $s:"..p
03a0: 75 74 73 20 24 6c 0a 09 70 75 74 73 20 22 2d 2d uts $l..puts "--
03b0: 2d 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 -". }. set
03c0: 20 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 24 73 callerSocket $s
03d0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
03e0: 7b 75 70 6c 65 76 65 6c 20 23 30 20 24 6c 7d 20 {uplevel #0 $l}
03f0: 6d 73 67 5d 7d 20 7b 0a 09 6c 69 73 74 20 65 72 msg]} {..list er
0400: 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 ror $msg. } e
0410: 6c 73 65 20 7b 0a 09 6c 69 73 74 20 73 75 63 63 lse {..list succ
0420: 65 73 73 20 24 6d 73 67 0a 20 20 20 20 7d 0a 7d ess $msg. }.}
0430: 0a 0a 70 72 6f 63 20 5f 5f 72 65 61 64 41 6e 64 ..proc __readAnd
0440: 45 78 65 63 75 74 65 5f 5f 20 7b 73 7d 20 7b 0a Execute__ {s} {.
0450: 20 20 20 20 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 global comma
0460: 6e 64 20 56 45 52 42 4f 53 45 0a 0a 20 20 20 20 nd VERBOSE..
0470: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
0480: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
0490: 63 6f 6d 70 61 72 65 20 24 6c 20 22 2d 2d 4d 61 compare $l "--Ma
04a0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 rker--Marker--Ma
04b0: 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b rker--"] == 0} {
04c0: 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 ..if {[info exis
04d0: 74 73 20 63 6f 6d 6d 61 6e 64 28 24 73 29 5d 7d ts command($s)]}
04e0: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
04f0: 5b 6c 69 73 74 20 65 72 72 6f 72 20 69 6e 63 6f [list error inco
0500: 6d 70 6c 65 74 65 5f 63 6f 6d 6d 61 6e 64 5d 0a mplete_command].
0510: 09 7d 0a 09 70 75 74 73 20 24 73 20 22 2d 2d 4d .}..puts $s "--M
0520: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
0530: 61 72 6b 65 72 2d 2d 22 0a 09 72 65 74 75 72 6e arker--"..return
0540: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b . }. if {[
0550: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 string compare $
0560: 6c 20 22 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 69 l ""] == 0} {..i
0570: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
0580: 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 if {$VERBOSE
0590: 7d 20 7b 0a 09 09 70 75 74 73 20 22 53 65 72 76 } {...puts "Serv
05a0: 65 72 20 63 6c 6f 73 69 6e 67 20 24 73 2c 20 65 er closing $s, e
05b0: 6f 66 20 66 72 6f 6d 20 63 6c 69 65 6e 74 22 0a of from client".
05c0: 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 . }.. clos
05d0: 65 20 24 73 0a 09 7d 0a 09 72 65 74 75 72 6e 0a e $s..}..return.
05e0: 20 20 20 20 7d 0a 20 20 20 20 61 70 70 65 6e 64 }. append
05f0: 20 63 6f 6d 6d 61 6e 64 28 24 73 29 20 24 6c 20 command($s) $l
0600: 22 5c 6e 22 0a 20 20 20 20 69 66 20 7b 5b 69 6e "\n". if {[in
0610: 66 6f 20 63 6f 6d 70 6c 65 74 65 20 24 63 6f 6d fo complete $com
0620: 6d 61 6e 64 28 24 73 29 5d 7d 20 7b 0a 09 73 65 mand($s)]} {..se
0630: 74 20 63 6d 64 73 20 24 63 6f 6d 6d 61 6e 64 28 t cmds $command(
0640: 24 73 29 0a 09 75 6e 73 65 74 20 63 6f 6d 6d 61 $s)..unset comma
0650: 6e 64 28 24 73 29 0a 09 70 75 74 73 20 24 73 20 nd($s)..puts $s
0660: 5b 5f 5f 64 6f 43 6f 6d 6d 61 6e 64 73 5f 5f 20 [__doCommands__
0670: 24 63 6d 64 73 20 24 73 5d 0a 20 20 20 20 7d 0a $cmds $s]. }.
0680: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
0690: 7d 20 7b 0a 09 69 66 20 7b 24 56 45 52 42 4f 53 } {..if {$VERBOS
06a0: 45 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 22 E} {.. puts "
06b0: 53 65 72 76 65 72 20 63 6c 6f 73 69 6e 67 20 24 Server closing $
06c0: 73 2c 20 65 6f 66 20 66 72 6f 6d 20 63 6c 69 65 s, eof from clie
06d0: 6e 74 22 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 nt"..}..close $s
06e0: 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 5f . }.}..proc _
06f0: 5f 61 63 63 65 70 74 5f 5f 20 7b 73 20 61 20 70 _accept__ {s a p
0700: 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 56 } {. global V
0710: 45 52 42 4f 53 45 0a 0a 20 20 20 20 69 66 20 7b ERBOSE.. if {
0720: 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 70 75 74 $VERBOSE} {..put
0730: 73 20 22 53 65 72 76 65 72 20 61 63 63 65 70 74 s "Server accept
0740: 73 20 6e 65 77 20 63 6f 6e 6e 65 63 74 69 6f 6e s new connection
0750: 20 66 72 6f 6d 20 24 61 3a 24 70 20 6f 6e 20 24 from $a:$p on $
0760: 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c s". }. fil
0770: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
0780: 6c 65 20 5b 6c 69 73 74 20 5f 5f 72 65 61 64 41 le [list __readA
0790: 6e 64 45 78 65 63 75 74 65 5f 5f 20 24 73 5d 0a ndExecute__ $s].
07a0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
07b0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
07c0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
07d0: 72 6c 66 0a 7d 0a 0a 73 65 74 20 73 65 72 76 65 rlf.}..set serve
07e0: 72 49 73 53 69 6c 65 6e 74 20 30 0a 66 6f 72 20 rIsSilent 0.for
07f0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
0800: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 $argc} {incr i}
0810: 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e {. if {[strin
0820: 67 20 63 6f 6d 70 61 72 65 20 2d 73 65 72 76 65 g compare -serve
0830: 72 49 73 53 69 6c 65 6e 74 20 5b 6c 69 6e 64 65 rIsSilent [linde
0840: 78 20 24 61 72 67 76 20 24 69 5d 5d 20 3d 3d 20 x $argv $i]] ==
0850: 30 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 0} {..set server
0860: 49 73 53 69 6c 65 6e 74 20 31 0a 09 62 72 65 61 IsSilent 1..brea
0870: 6b 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b k. }.}.if {![
0880: 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 info exists serv
0890: 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 erPort]} {. i
08a0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
08b0: 65 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 5d env(serverPort)]
08c0: 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 50 } {..set serverP
08d0: 6f 72 74 20 24 65 6e 76 28 73 65 72 76 65 72 50 ort $env(serverP
08e0: 6f 72 74 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 ort). }.}.if
08f0: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 {![info exists s
0900: 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 erverPort]} {.
0910: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
0920: 7b 24 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e {$i < $argc} {in
0930: 63 72 20 69 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 cr i} {..if {[st
0940: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 2d 70 6f ring compare -po
0950: 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 rt [lindex $argv
0960: 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 $i]] == 0} {..
0970: 20 20 20 69 66 20 7b 24 69 20 3c 20 5b 65 78 70 if {$i < [exp
0980: 72 20 24 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a r $argc - 1]} {.
0990: 09 09 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 ..set serverPort
09a0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 5b [lindex $argv [
09b0: 65 78 70 72 20 24 69 20 2b 20 31 5d 5d 0a 09 20 expr $i + 1]]..
09c0: 20 20 20 7d 0a 09 20 20 20 20 62 72 65 61 6b 0a }.. break.
09d0: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 .}. }.}.if {!
09e0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 [info exists ser
09f0: 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 verPort]} {.
0a00: 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 32 set serverPort 2
0a10: 30 34 38 0a 7d 0a 0a 69 66 20 7b 21 5b 69 6e 66 048.}..if {![inf
0a20: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41 o exists serverA
0a30: 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 69 ddress]} {. i
0a40: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0a50: 65 6e 76 28 73 65 72 76 65 72 41 64 64 72 65 73 env(serverAddres
0a60: 73 29 5d 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 s)]} {..set serv
0a70: 65 72 41 64 64 72 65 73 73 20 24 65 6e 76 28 73 erAddress $env(s
0a80: 65 72 76 65 72 41 64 64 72 65 73 73 29 0a 20 20 erverAddress).
0a90: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f }.}.if {![info
0aa0: 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41 64 exists serverAd
0ab0: 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 66 6f dress]} {. fo
0ac0: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
0ad0: 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 < $argc} {incr i
0ae0: 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 } {..if {[string
0af0: 20 63 6f 6d 70 61 72 65 20 2d 61 64 64 72 65 73 compare -addres
0b00: 73 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 s [lindex $argv
0b10: 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $i]] == 0} {..
0b20: 20 20 69 66 20 7b 24 69 20 3c 20 5b 65 78 70 72 if {$i < [expr
0b30: 20 24 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 $argc - 1]} {..
0b40: 09 73 65 74 20 73 65 72 76 65 72 41 64 64 72 65 .set serverAddre
0b50: 73 73 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 ss [lindex $argv
0b60: 20 5b 65 78 70 72 20 24 69 20 2b 20 31 5d 5d 0a [expr $i + 1]].
0b70: 09 20 20 20 20 7d 0a 09 20 20 20 20 62 72 65 61 . }.. brea
0b80: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 k..}. }.}.if
0b90: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 {![info exists s
0ba0: 65 72 76 65 72 41 64 64 72 65 73 73 5d 7d 20 7b erverAddress]} {
0bb0: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 41 . set serverA
0bc0: 64 64 72 65 73 73 20 30 2e 30 2e 30 2e 30 0a 7d ddress 0.0.0.0.}
0bd0: 0a 0a 69 66 20 7b 24 73 65 72 76 65 72 49 73 53 ..if {$serverIsS
0be0: 69 6c 65 6e 74 20 3d 3d 20 30 7d 20 7b 0a 20 20 ilent == 0} {.
0bf0: 20 20 73 65 74 20 6c 20 22 52 65 6d 6f 74 65 20 set l "Remote
0c00: 73 65 72 76 65 72 20 6c 69 73 74 65 6e 69 6e 67 server listening
0c10: 20 6f 6e 20 70 6f 72 74 20 24 73 65 72 76 65 72 on port $server
0c20: 50 6f 72 74 2c 20 49 50 20 24 73 65 72 76 65 72 Port, IP $server
0c30: 41 64 64 72 65 73 73 2e 22 0a 20 20 20 20 70 75 Address.". pu
0c40: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 24 ts "". puts $
0c50: 6c 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 l. for {set c
0c60: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
0c70: 24 6c 5d 7d 20 7b 24 63 20 3e 20 30 7d 20 7b 69 $l]} {$c > 0} {i
0c80: 6e 63 72 20 63 20 2d 31 7d 20 7b 70 75 74 73 20 ncr c -1} {puts
0c90: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 2d 22 7d 0a -nonewline "-"}.
0ca0: 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 puts "".
0cb0: 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 puts "". puts
0cc0: 20 22 59 6f 75 20 68 61 76 65 20 73 65 74 20 74 "You have set t
0cd0: 68 65 20 54 63 6c 20 76 61 72 69 61 62 6c 65 73 he Tcl variables
0ce0: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 74 serverAddress t
0cf0: 6f 20 24 73 65 72 76 65 72 41 64 64 72 65 73 73 o $serverAddress
0d00: 20 61 6e 64 22 0a 20 20 20 20 70 75 74 73 20 22 and". puts "
0d10: 73 65 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73 serverPort to $s
0d20: 65 72 76 65 72 50 6f 72 74 2e 20 59 6f 75 20 63 erverPort. You c
0d30: 61 6e 20 73 65 74 20 74 68 65 73 65 20 77 69 74 an set these wit
0d40: 68 20 74 68 65 20 2d 61 64 64 72 65 73 73 20 61 h the -address a
0d50: 6e 64 22 0a 20 20 20 20 70 75 74 73 20 22 2d 70 nd". puts "-p
0d60: 6f 72 74 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 ort command line
0d70: 20 6f 70 74 69 6f 6e 73 2c 20 6f 72 20 61 73 20 options, or as
0d80: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
0d90: 61 62 6c 65 73 20 69 6e 20 79 6f 75 72 22 0a 20 ables in your".
0da0: 20 20 20 70 75 74 73 20 22 73 68 65 6c 6c 2e 22 puts "shell."
0db0: 0a 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 . puts "".
0dc0: 20 70 75 74 73 20 22 4e 4f 54 45 3a 20 54 68 65 puts "NOTE: The
0dd0: 20 74 65 73 74 73 20 77 69 6c 6c 20 6e 6f 74 20 tests will not
0de0: 77 6f 72 6b 20 70 72 6f 70 65 72 6c 79 20 69 66 work properly if
0df0: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 69 serverAddress i
0e00: 73 20 73 65 74 20 74 6f 22 0a 20 20 20 20 70 75 s set to". pu
0e10: 74 73 20 22 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c ts "\"localhost\
0e20: 22 20 6f 72 20 31 32 37 2e 30 2e 30 2e 31 2e 22 " or 127.0.0.1."
0e30: 0a 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 . puts "".
0e40: 20 70 75 74 73 20 22 57 68 65 6e 20 79 6f 75 20 puts "When you
0e50: 69 6e 76 6f 6b 65 20 74 63 6c 74 65 73 74 20 74 invoke tcltest t
0e60: 6f 20 72 75 6e 20 74 68 65 20 74 65 73 74 73 2c o run the tests,
0e70: 20 73 65 74 20 74 68 65 20 76 61 72 69 61 62 6c set the variabl
0e80: 65 73 22 0a 20 20 20 20 70 75 74 73 20 22 72 65 es". puts "re
0e90: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 74 moteServerPort t
0ea0: 6f 20 24 73 65 72 76 65 72 50 6f 72 74 20 61 6e o $serverPort an
0eb0: 64 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 d remoteServerIP
0ec0: 20 74 6f 22 0a 20 20 20 20 70 75 74 73 20 22 5b to". puts "[
0ed0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 2e 20 info hostname].
0ee0: 59 6f 75 20 63 61 6e 20 73 65 74 20 74 68 65 73 You can set thes
0ef0: 65 20 61 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 e as environment
0f00: 20 76 61 72 69 61 62 6c 65 73 22 0a 20 20 20 20 variables".
0f10: 70 75 74 73 20 22 66 72 6f 6d 20 74 68 65 20 73 puts "from the s
0f20: 68 65 6c 6c 2e 20 54 68 65 20 74 65 73 74 73 20 hell. The tests
0f30: 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 70 72 will not work pr
0f40: 6f 70 65 72 6c 79 20 69 66 20 79 6f 75 20 73 65 operly if you se
0f50: 74 22 0a 20 20 20 20 70 75 74 73 20 22 72 65 6d t". puts "rem
0f60: 6f 74 65 53 65 72 76 65 72 49 50 20 74 6f 20 5c oteServerIP to \
0f70: 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 20 "localhost\" or
0f80: 31 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 20 127.0.0.1.".
0f90: 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 puts "". puts
0fa0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 54 79 70 -nonewline "Typ
0fb0: 65 20 43 74 72 6c 2d 43 20 74 6f 20 74 65 72 6d e Ctrl-C to term
0fc0: 69 6e 61 74 65 2d 2d 3e 20 22 0a 20 20 20 20 66 inate--> ". f
0fd0: 6c 75 73 68 20 73 74 64 6f 75 74 0a 7d 0a 0a 69 lush stdout.}..i
0fe0: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 f {[catch {set s
0ff0: 65 72 76 65 72 53 6f 63 6b 65 74 20 5c 0a 20 20 erverSocket \.
1000: 20 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d [tls::socket -
1010: 6d 79 61 64 64 72 20 24 73 65 72 76 65 72 41 64 myaddr $serverAd
1020: 64 72 65 73 73 20 2d 73 65 72 76 65 72 20 5f 5f dress -server __
1030: 61 63 63 65 70 74 5f 5f 20 5c 0a 20 20 20 20 09 accept__ \. .
1040: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
1050: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
1060: 61 63 65 72 74 2e 70 65 6d 5d 20 5c 0a 20 20 20 acert.pem] \.
1070: 20 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c .-certfile [fil
1080: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
1090: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
10a0: 0a 20 20 20 20 09 2d 6b 65 79 66 69 6c 65 20 5b . .-keyfile [
10b0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
10c0: 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 certs skey.pem]
10d0: 5c 0a 09 24 73 65 72 76 65 72 50 6f 72 74 5d 7d \..$serverPort]}
10e0: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 70 75 74 msg]} {. put
10f0: 73 20 22 53 65 72 76 65 72 20 6f 6e 20 24 73 65 s "Server on $se
1100: 72 76 65 72 41 64 64 72 65 73 73 3a 24 73 65 72 rverAddress:$ser
1110: 76 65 72 50 6f 72 74 20 63 61 6e 6e 6f 74 20 73 verPort cannot s
1120: 74 61 72 74 3a 20 24 6d 73 67 22 0a 7d 20 65 6c tart: $msg".} el
1130: 73 65 20 7b 0a 20 20 20 20 76 77 61 69 74 20 5f se {. vwait _
1140: 5f 73 65 72 76 65 72 5f 77 61 69 74 5f 76 61 72 _server_wait_var
1150: 69 61 62 6c 65 5f 5f 0a 7d 0a 0a 0a 0a 0a 0a 0a iable__.}.......
1160: 0a 0a 0a 0a 0a .....