Artifact
822d07082f5292a9adad7ad89213953ef605a979:
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 34 20 32 30 30 30 2f 30 36 2f 30 36 20 1.4 2000/06/06
01e0: 32 32 3a 30 31 3a 34 31 20 61 62 6f 72 72 20 45 22:01:41 aborr E
01f0: 78 70 20 24 0a 0a 23 20 6c 6f 61 64 20 74 6c 73 xp $..# load tls
0200: 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 67 65 package.package
0210: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a 23 20 require tls..#
0220: 49 6e 69 74 69 61 6c 69 7a 65 20 6d 65 73 73 61 Initialize messa
0230: 67 65 20 64 65 6c 69 6d 69 74 6f 72 0a 0a 23 20 ge delimitor..#
0240: 49 6e 69 74 69 61 6c 69 7a 65 20 63 6f 6d 6d 61 Initialize comma
0250: 6e 64 20 61 72 72 61 79 0a 63 61 74 63 68 20 7b nd array.catch {
0260: 75 6e 73 65 74 20 63 6f 6d 6d 61 6e 64 7d 0a 73 unset command}.s
0270: 65 74 20 63 6f 6d 6d 61 6e 64 28 30 29 20 22 22 et command(0) ""
0280: 0a 73 65 74 20 63 61 6c 6c 65 72 53 6f 63 6b 65 .set callerSocke
0290: 74 20 22 22 0a 0a 23 20 44 65 74 65 63 74 20 77 t ""..# Detect w
02a0: 68 65 74 68 65 72 20 77 65 20 73 68 6f 75 6c 64 hether we should
02b0: 20 70 72 69 6e 74 20 6f 75 74 20 63 6f 6e 6e 65 print out conne
02c0: 63 74 69 6f 6e 20 6d 65 73 73 61 67 65 73 20 65 ction messages e
02d0: 74 63 2e 0a 23 20 73 65 74 20 56 45 52 42 4f 53 tc..# set VERBOS
02e0: 45 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 E 1.if {![info e
02f0: 78 69 73 74 73 20 56 45 52 42 4f 53 45 5d 7d 20 xists VERBOSE]}
0300: 7b 0a 20 20 20 20 73 65 74 20 56 45 52 42 4f 53 {. set VERBOS
0310: 45 20 30 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 64 6f E 0.}..proc __do
0320: 43 6f 6d 6d 61 6e 64 73 5f 5f 20 7b 6c 20 73 7d Commands__ {l s}
0330: 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 63 61 {. global ca
0340: 6c 6c 65 72 53 6f 63 6b 65 74 20 56 45 52 42 4f llerSocket VERBO
0350: 53 45 0a 0a 20 20 20 20 69 66 20 7b 24 56 45 52 SE.. if {$VER
0360: 42 4f 53 45 7d 20 7b 0a 09 70 75 74 73 20 22 2d BOSE} {..puts "-
0370: 2d 2d 20 53 65 72 76 65 72 20 65 78 65 63 75 74 -- Server execut
0380: 69 6e 67 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e ing the followin
0390: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 24 73 3a g for socket $s:
03a0: 22 0a 09 70 75 74 73 20 24 6c 0a 09 70 75 74 73 "..puts $l..puts
03b0: 20 22 2d 2d 2d 22 0a 20 20 20 20 7d 0a 20 20 20 "---". }.
03c0: 20 69 66 20 7b 30 7d 20 7b 0a 09 73 65 74 20 66 if {0} {..set f
03d0: 64 20 5b 6f 70 65 6e 20 72 65 6d 6f 74 65 53 65 d [open remoteSe
03e0: 72 76 65 72 2e 6c 6f 67 20 61 5d 0a 09 63 61 74 rver.log a]..cat
03f0: 63 68 20 7b 70 75 74 73 20 24 66 64 20 22 73 6b ch {puts $fd "sk
0400: 65 79 3a 20 24 73 65 72 76 65 72 4b 65 79 22 7d ey: $serverKey"}
0410: 0a 09 70 75 74 73 20 24 66 64 20 22 2d 2d 2d 20 ..puts $fd "---
0420: 53 65 72 76 65 72 20 65 78 65 63 75 74 69 6e 67 Server executing
0430: 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 the following f
0440: 6f 72 20 73 6f 63 6b 65 74 20 24 73 3a 22 0a 09 or socket $s:"..
0450: 70 75 74 73 20 24 66 64 20 24 6c 0a 09 70 75 74 puts $fd $l..put
0460: 73 20 24 66 64 20 22 2d 2d 2d 22 0a 09 63 6c 6f s $fd "---"..clo
0470: 73 65 20 24 66 64 0a 20 20 20 20 7d 0a 20 20 20 se $fd. }.
0480: 20 73 65 74 20 63 61 6c 6c 65 72 53 6f 63 6b 65 set callerSocke
0490: 74 20 24 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 t $s. if {[ca
04a0: 74 63 68 20 7b 75 70 6c 65 76 65 6c 20 23 30 20 tch {uplevel #0
04b0: 24 6c 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 $l} msg]} {.
04c0: 09 69 66 20 7b 30 7d 20 7b 0a 09 20 20 20 20 73 .if {0} {.. s
04d0: 65 74 20 66 64 20 5b 6f 70 65 6e 20 72 65 6d 6f et fd [open remo
04e0: 74 65 53 65 72 76 65 72 2e 6c 6f 67 20 61 5d 0a teServer.log a].
04f0: 09 20 20 20 20 70 75 74 73 20 24 66 64 20 22 65 . puts $fd "e
0500: 72 72 6f 72 3a 20 24 6d 73 67 22 0a 09 20 20 20 rror: $msg"..
0510: 20 63 6c 6f 73 65 20 24 66 64 0a 09 7d 0a 09 6c close $fd..}..l
0520: 69 73 74 20 65 72 72 6f 72 20 24 6d 73 67 0a 20 ist error $msg.
0530: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 6c 69 73 } else {..lis
0540: 74 20 73 75 63 63 65 73 73 20 24 6d 73 67 0a 20 t success $msg.
0550: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 72 }.}..proc __r
0560: 65 61 64 41 6e 64 45 78 65 63 75 74 65 5f 5f 20 eadAndExecute__
0570: 7b 73 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c {s} {. global
0580: 20 63 6f 6d 6d 61 6e 64 20 56 45 52 42 4f 53 45 command VERBOSE
0590: 0a 0a 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
05a0: 73 20 24 73 5d 0a 20 20 20 20 69 66 20 7b 5b 73 s $s]. if {[s
05b0: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 6c tring compare $l
05c0: 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b "--Marker--Mark
05d0: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d er--Marker--"] =
05e0: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
05f0: 6f 20 65 78 69 73 74 73 20 63 6f 6d 6d 61 6e 64 o exists command
0600: 28 24 73 29 5d 7d 20 7b 0a 09 20 20 20 20 70 75 ($s)]} {.. pu
0610: 74 73 20 24 73 20 5b 6c 69 73 74 20 65 72 72 6f ts $s [list erro
0620: 72 20 69 6e 63 6f 6d 70 6c 65 74 65 5f 63 6f 6d r incomplete_com
0630: 6d 61 6e 64 5d 0a 09 7d 0a 09 70 75 74 73 20 24 mand]..}..puts $
0640: 73 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 s "--Marker--Mar
0650: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 0a 09 ker--Marker--"..
0660: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 return. }.
0670: 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d if {[string com
0680: 70 61 72 65 20 24 6c 20 22 22 5d 20 3d 3d 20 30 pare $l ""] == 0
0690: 7d 20 7b 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 } {..if {[eof $s
06a0: 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 56 ]} {.. if {$V
06b0: 45 52 42 4f 53 45 7d 20 7b 0a 09 09 70 75 74 73 ERBOSE} {...puts
06c0: 20 22 53 65 72 76 65 72 20 63 6c 6f 73 69 6e 67 "Server closing
06d0: 20 24 73 2c 20 65 6f 66 20 66 72 6f 6d 20 63 6c $s, eof from cl
06e0: 69 65 6e 74 22 0a 09 20 20 20 20 7d 0a 09 20 20 ient".. }..
06f0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 09 72 close $s..}..r
0700: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
0710: 61 70 70 65 6e 64 20 63 6f 6d 6d 61 6e 64 28 24 append command($
0720: 73 29 20 24 6c 20 22 5c 6e 22 0a 20 20 20 20 69 s) $l "\n". i
0730: 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 70 6c 65 74 f {[info complet
0740: 65 20 24 63 6f 6d 6d 61 6e 64 28 24 73 29 5d 7d e $command($s)]}
0750: 20 7b 0a 09 73 65 74 20 63 6d 64 73 20 24 63 6f {..set cmds $co
0760: 6d 6d 61 6e 64 28 24 73 29 0a 09 75 6e 73 65 74 mmand($s)..unset
0770: 20 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 70 75 command($s)..pu
0780: 74 73 20 24 73 20 5b 5f 5f 64 6f 43 6f 6d 6d 61 ts $s [__doComma
0790: 6e 64 73 5f 5f 20 24 63 6d 64 73 20 24 73 5d 0a nds__ $cmds $s].
07a0: 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b 65 }. if {[e
07b0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 69 66 20 7b 24 of $s]} {..if {$
07c0: 56 45 52 42 4f 53 45 7d 20 7b 0a 09 20 20 20 20 VERBOSE} {..
07d0: 70 75 74 73 20 22 53 65 72 76 65 72 20 63 6c 6f puts "Server clo
07e0: 73 69 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 6f sing $s, eof fro
07f0: 6d 20 63 6c 69 65 6e 74 22 0a 09 7d 0a 09 63 6c m client"..}..cl
0800: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 7d 0a 0a ose $s. }.}..
0810: 70 72 6f 63 20 5f 5f 61 63 63 65 70 74 5f 5f 20 proc __accept__
0820: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 67 6c {s a p} {. gl
0830: 6f 62 61 6c 20 56 45 52 42 4f 53 45 0a 0a 20 20 obal VERBOSE..
0840: 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 7d 20 if {$VERBOSE}
0850: 7b 0a 09 70 75 74 73 20 22 53 65 72 76 65 72 20 {..puts "Server
0860: 61 63 63 65 70 74 73 20 6e 65 77 20 63 6f 6e 6e accepts new conn
0870: 65 63 74 69 6f 6e 20 66 72 6f 6d 20 24 61 3a 24 ection from $a:$
0880: 70 20 6f 6e 20 24 73 22 0a 20 20 20 20 7d 0a 20 p on $s". }.
0890: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
08a0: 65 20 24 73 0a 20 20 20 20 66 69 6c 65 65 76 65 e $s. fileeve
08b0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
08c0: 6c 69 73 74 20 5f 5f 72 65 61 64 41 6e 64 45 78 list __readAndEx
08d0: 65 63 75 74 65 5f 5f 20 24 73 5d 0a 20 20 20 20 ecute__ $s].
08e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
08f0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
0900: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
0910: 7d 0a 0a 73 65 74 20 73 65 72 76 65 72 49 73 53 }..set serverIsS
0920: 69 6c 65 6e 74 20 30 0a 66 6f 72 20 7b 73 65 74 ilent 0.for {set
0930: 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 67 i 0} {$i < $arg
0940: 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20 20 c} {incr i} {.
0950: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f if {[string co
0960: 6d 70 61 72 65 20 2d 73 65 72 76 65 72 49 73 53 mpare -serverIsS
0970: 69 6c 65 6e 74 20 5b 6c 69 6e 64 65 78 20 24 61 ilent [lindex $a
0980: 72 67 76 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b rgv $i]] == 0} {
0990: 0a 09 73 65 74 20 73 65 72 76 65 72 49 73 53 69 ..set serverIsSi
09a0: 6c 65 6e 74 20 31 0a 09 62 72 65 61 6b 0a 20 20 lent 1..break.
09b0: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f }.}.if {![info
09c0: 20 65 78 69 73 74 73 20 73 65 72 76 65 72 50 6f exists serverPo
09d0: 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b rt]} {. if {[
09e0: 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 info exists env(
09f0: 73 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a serverPort)]} {.
0a00: 09 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 .set serverPort
0a10: 24 65 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 $env(serverPort)
0a20: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0a30: 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 nfo exists serve
0a40: 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 66 6f rPort]} {. fo
0a50: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
0a60: 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 < $argc} {incr i
0a70: 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 } {..if {[string
0a80: 20 63 6f 6d 70 61 72 65 20 2d 70 6f 72 74 20 5b compare -port [
0a90: 6c 69 6e 64 65 78 20 24 61 72 67 76 20 24 69 5d lindex $argv $i]
0aa0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
0ab0: 66 20 7b 24 69 20 3c 20 5b 65 78 70 72 20 24 61 f {$i < [expr $a
0ac0: 72 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 rgc - 1]} {...se
0ad0: 74 20 73 65 72 76 65 72 50 6f 72 74 20 5b 6c 69 t serverPort [li
0ae0: 6e 64 65 78 20 24 61 72 67 76 20 5b 65 78 70 72 ndex $argv [expr
0af0: 20 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 20 7d $i + 1]].. }
0b00: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
0b10: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0b20: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 50 o exists serverP
0b30: 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 ort]} {. set
0b40: 73 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a serverPort 8048.
0b50: 7d 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 }..if {![info ex
0b60: 69 73 74 73 20 73 65 72 76 65 72 41 64 64 72 65 ists serverAddre
0b70: 73 73 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b ss]} {. if {[
0b80: 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 info exists env(
0b90: 73 65 72 76 65 72 41 64 64 72 65 73 73 29 5d 7d serverAddress)]}
0ba0: 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 41 64 {..set serverAd
0bb0: 64 72 65 73 73 20 24 65 6e 76 28 73 65 72 76 65 dress $env(serve
0bc0: 72 41 64 64 72 65 73 73 29 0a 20 20 20 20 7d 0a rAddress). }.
0bd0: 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 }.if {![info exi
0be0: 73 74 73 20 73 65 72 76 65 72 41 64 64 72 65 73 sts serverAddres
0bf0: 73 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 20 7b 73 s]} {. for {s
0c00: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 et i 0} {$i < $a
0c10: 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a rgc} {incr i} {.
0c20: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
0c30: 70 61 72 65 20 2d 61 64 64 72 65 73 73 20 5b 6c pare -address [l
0c40: 69 6e 64 65 78 20 24 61 72 67 76 20 24 69 5d 5d index $argv $i]]
0c50: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
0c60: 20 7b 24 69 20 3c 20 5b 65 78 70 72 20 24 61 72 {$i < [expr $ar
0c70: 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 74 gc - 1]} {...set
0c80: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 5b serverAddress [
0c90: 6c 69 6e 64 65 78 20 24 61 72 67 76 20 5b 65 78 lindex $argv [ex
0ca0: 70 72 20 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 pr $i + 1]]..
0cb0: 20 7d 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d }.. break..}
0cc0: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0cd0: 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 nfo exists serve
0ce0: 72 41 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 rAddress]} {.
0cf0: 20 73 65 74 20 73 65 72 76 65 72 41 64 64 72 65 set serverAddre
0d00: 73 73 20 30 2e 30 2e 30 2e 30 0a 7d 0a 0a 69 66 ss 0.0.0.0.}..if
0d10: 20 7b 24 73 65 72 76 65 72 49 73 53 69 6c 65 6e {$serverIsSilen
0d20: 74 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 73 65 t == 0} {. se
0d30: 74 20 6c 20 22 52 65 6d 6f 74 65 20 73 65 72 76 t l "Remote serv
0d40: 65 72 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 er listening on
0d50: 70 6f 72 74 20 24 73 65 72 76 65 72 50 6f 72 74 port $serverPort
0d60: 2c 20 49 50 20 24 73 65 72 76 65 72 41 64 64 72 , IP $serverAddr
0d70: 65 73 73 2e 22 0a 20 20 20 20 70 75 74 73 20 22 ess.". puts "
0d80: 22 0a 20 20 20 20 70 75 74 73 20 24 6c 0a 20 20 ". puts $l.
0d90: 20 20 66 6f 72 20 7b 73 65 74 20 63 20 5b 73 74 for {set c [st
0da0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 7d ring length $l]}
0db0: 20 7b 24 63 20 3e 20 30 7d 20 7b 69 6e 63 72 20 {$c > 0} {incr
0dc0: 63 20 2d 31 7d 20 7b 70 75 74 73 20 2d 6e 6f 6e c -1} {puts -non
0dd0: 65 77 6c 69 6e 65 20 22 2d 22 7d 0a 20 20 20 20 ewline "-"}.
0de0: 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 puts "". puts
0df0: 20 22 22 0a 20 20 20 20 70 75 74 73 20 22 59 6f "". puts "Yo
0e00: 75 20 68 61 76 65 20 73 65 74 20 74 68 65 20 54 u have set the T
0e10: 63 6c 20 76 61 72 69 61 62 6c 65 73 20 73 65 72 cl variables ser
0e20: 76 65 72 41 64 64 72 65 73 73 20 74 6f 20 24 73 verAddress to $s
0e30: 65 72 76 65 72 41 64 64 72 65 73 73 20 61 6e 64 erverAddress and
0e40: 22 0a 20 20 20 20 70 75 74 73 20 22 73 65 72 76 ". puts "serv
0e50: 65 72 50 6f 72 74 20 74 6f 20 24 73 65 72 76 65 erPort to $serve
0e60: 72 50 6f 72 74 2e 20 59 6f 75 20 63 61 6e 20 73 rPort. You can s
0e70: 65 74 20 74 68 65 73 65 20 77 69 74 68 20 74 68 et these with th
0e80: 65 20 2d 61 64 64 72 65 73 73 20 61 6e 64 22 0a e -address and".
0e90: 20 20 20 20 70 75 74 73 20 22 2d 70 6f 72 74 20 puts "-port
0ea0: 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 6f 70 74 command line opt
0eb0: 69 6f 6e 73 2c 20 6f 72 20 61 73 20 65 6e 76 69 ions, or as envi
0ec0: 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 ronment variable
0ed0: 73 20 69 6e 20 79 6f 75 72 22 0a 20 20 20 20 70 s in your". p
0ee0: 75 74 73 20 22 73 68 65 6c 6c 2e 22 0a 20 20 20 uts "shell.".
0ef0: 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 puts "". put
0f00: 73 20 22 4e 4f 54 45 3a 20 54 68 65 20 74 65 73 s "NOTE: The tes
0f10: 74 73 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b ts will not work
0f20: 20 70 72 6f 70 65 72 6c 79 20 69 66 20 73 65 72 properly if ser
0f30: 76 65 72 41 64 64 72 65 73 73 20 69 73 20 73 65 verAddress is se
0f40: 74 20 74 6f 22 0a 20 20 20 20 70 75 74 73 20 22 t to". puts "
0f50: 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 \"localhost\" or
0f60: 20 31 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 127.0.0.1.".
0f70: 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 puts "". put
0f80: 73 20 22 57 68 65 6e 20 79 6f 75 20 69 6e 76 6f s "When you invo
0f90: 6b 65 20 74 63 6c 74 65 73 74 20 74 6f 20 72 75 ke tcltest to ru
0fa0: 6e 20 74 68 65 20 74 65 73 74 73 2c 20 73 65 74 n the tests, set
0fb0: 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 22 0a the variables".
0fc0: 20 20 20 20 70 75 74 73 20 22 72 65 6d 6f 74 65 puts "remote
0fd0: 53 65 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73 ServerPort to $s
0fe0: 65 72 76 65 72 50 6f 72 74 20 61 6e 64 20 72 65 erverPort and re
0ff0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 74 6f 22 moteServerIP to"
1000: 0a 20 20 20 20 70 75 74 73 20 22 5b 69 6e 66 6f . puts "[info
1010: 20 68 6f 73 74 6e 61 6d 65 5d 2e 20 59 6f 75 20 hostname]. You
1020: 63 61 6e 20 73 65 74 20 74 68 65 73 65 20 61 73 can set these as
1030: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 environment var
1040: 69 61 62 6c 65 73 22 0a 20 20 20 20 70 75 74 73 iables". puts
1050: 20 22 66 72 6f 6d 20 74 68 65 20 73 68 65 6c 6c "from the shell
1060: 2e 20 54 68 65 20 74 65 73 74 73 20 77 69 6c 6c . The tests will
1070: 20 6e 6f 74 20 77 6f 72 6b 20 70 72 6f 70 65 72 not work proper
1080: 6c 79 20 69 66 20 79 6f 75 20 73 65 74 22 0a 20 ly if you set".
1090: 20 20 20 70 75 74 73 20 22 72 65 6d 6f 74 65 53 puts "remoteS
10a0: 65 72 76 65 72 49 50 20 74 6f 20 5c 22 6c 6f 63 erverIP to \"loc
10b0: 61 6c 68 6f 73 74 5c 22 20 6f 72 20 31 32 37 2e alhost\" or 127.
10c0: 30 2e 30 2e 31 2e 22 0a 20 20 20 20 70 75 74 73 0.0.1.". puts
10d0: 20 22 22 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f "". puts -no
10e0: 6e 65 77 6c 69 6e 65 20 22 54 79 70 65 20 43 74 newline "Type Ct
10f0: 72 6c 2d 43 20 74 6f 20 74 65 72 6d 69 6e 61 74 rl-C to terminat
1100: 65 2d 2d 3e 20 22 0a 20 20 20 20 66 6c 75 73 68 e--> ". flush
1110: 20 73 74 64 6f 75 74 0a 7d 0a 0a 69 66 20 7b 5b stdout.}..if {[
1120: 63 61 74 63 68 20 7b 73 65 74 20 73 65 72 76 65 catch {set serve
1130: 72 53 6f 63 6b 65 74 20 5c 0a 20 20 20 20 5b 74 rSocket \. [t
1140: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 ls::socket -myad
1150: 64 72 20 24 73 65 72 76 65 72 41 64 64 72 65 73 dr $serverAddres
1160: 73 20 2d 73 65 72 76 65 72 20 5f 5f 61 63 63 65 s -server __acce
1170: 70 74 5f 5f 20 5c 0a 20 20 20 20 09 2d 63 61 66 pt__ \. .-caf
1180: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ile [file join [
1190: 70 77 64 5d 20 63 65 72 74 73 20 63 61 63 65 72 pwd] certs cacer
11a0: 74 2e 70 65 6d 5d 20 5c 0a 20 20 20 20 09 2d 63 t.pem] \. .-c
11b0: 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f ertfile [file jo
11c0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
11d0: 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 20 20 20 erver.pem] \.
11e0: 20 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 .-keyfile [file
11f0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
1200: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 24 s skey.pem] \..$
1210: 73 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 serverPort]} msg
1220: 5d 7d 20 7b 0a 20 20 20 20 70 75 74 73 20 22 53 ]} {. puts "S
1230: 65 72 76 65 72 20 6f 6e 20 24 73 65 72 76 65 72 erver on $server
1240: 41 64 64 72 65 73 73 3a 24 73 65 72 76 65 72 50 Address:$serverP
1250: 6f 72 74 20 63 61 6e 6e 6f 74 20 73 74 61 72 74 ort cannot start
1260: 3a 20 24 6d 73 67 22 0a 7d 20 65 6c 73 65 20 7b : $msg".} else {
1270: 0a 20 20 20 20 76 77 61 69 74 20 5f 5f 73 65 72 . vwait __ser
1280: 76 65 72 5f 77 61 69 74 5f 76 61 72 69 61 62 6c ver_wait_variabl
1290: 65 5f 5f 0a 7d 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a e__.}...........
12a0: 0a .