Artifact
89ceb816c30fadbc3167a5dc36e2ecbd5cada185:
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 33 20 32 30 30 30 2f 30 36 2f 30 33 20 1.3 2000/06/03
01e0: 30 35 3a 30 31 3a 33 32 20 61 77 62 20 45 78 70 05:01:32 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 23 20 73 65 74 20 56 45 52 42 4f 53 45 20 ..# set VERBOSE
02e0: 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 1.if {![info exi
02f0: 73 74 73 20 56 45 52 42 4f 53 45 5d 7d 20 7b 0a sts VERBOSE]} {.
0300: 20 20 20 20 73 65 74 20 56 45 52 42 4f 53 45 20 set VERBOSE
0310: 30 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 64 6f 43 6f 0.}..proc __doCo
0320: 6d 6d 61 6e 64 73 5f 5f 20 7b 6c 20 73 7d 20 7b mmands__ {l s} {
0330: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 63 61 6c 6c . global call
0340: 65 72 53 6f 63 6b 65 74 20 56 45 52 42 4f 53 45 erSocket VERBOSE
0350: 0a 0a 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f .. if {$VERBO
0360: 53 45 7d 20 7b 0a 09 70 75 74 73 20 22 2d 2d 2d SE} {..puts "---
0370: 20 53 65 72 76 65 72 20 65 78 65 63 75 74 69 6e Server executin
0380: 67 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 g the following
0390: 66 6f 72 20 73 6f 63 6b 65 74 20 24 73 3a 22 0a for socket $s:".
03a0: 09 70 75 74 73 20 24 6c 0a 09 70 75 74 73 20 22 .puts $l..puts "
03b0: 2d 2d 2d 22 0a 20 20 20 20 7d 0a 20 20 20 20 69 ---". }. i
03c0: 66 20 7b 30 7d 20 7b 0a 09 73 65 74 20 66 64 20 f {0} {..set fd
03d0: 5b 6f 70 65 6e 20 72 65 6d 6f 74 65 53 65 72 76 [open remoteServ
03e0: 65 72 2e 6c 6f 67 20 61 5d 0a 09 63 61 74 63 68 er.log a]..catch
03f0: 20 7b 70 75 74 73 20 24 66 64 20 22 73 6b 65 79 {puts $fd "skey
0400: 3a 20 24 73 65 72 76 65 72 4b 65 79 22 7d 0a 09 : $serverKey"}..
0410: 70 75 74 73 20 24 66 64 20 22 2d 2d 2d 20 53 65 puts $fd "--- Se
0420: 72 76 65 72 20 65 78 65 63 75 74 69 6e 67 20 74 rver executing t
0430: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 he following for
0440: 20 73 6f 63 6b 65 74 20 24 73 3a 22 0a 09 70 75 socket $s:"..pu
0450: 74 73 20 24 66 64 20 24 6c 0a 09 70 75 74 73 20 ts $fd $l..puts
0460: 24 66 64 20 22 2d 2d 2d 22 0a 09 63 6c 6f 73 65 $fd "---"..close
0470: 20 24 66 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 $fd. }. s
0480: 65 74 20 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 et callerSocket
0490: 24 73 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 $s. if {[catc
04a0: 68 20 7b 75 70 6c 65 76 65 6c 20 23 30 20 24 6c h {uplevel #0 $l
04b0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 09 69 } msg]} {. .i
04c0: 66 20 7b 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 f {0} {.. set
04d0: 20 66 64 20 5b 6f 70 65 6e 20 72 65 6d 6f 74 65 fd [open remote
04e0: 53 65 72 76 65 72 2e 6c 6f 67 20 61 5d 0a 09 20 Server.log a]..
04f0: 20 20 20 70 75 74 73 20 24 66 64 20 22 65 72 72 puts $fd "err
0500: 6f 72 3a 20 24 6d 73 67 22 0a 09 20 20 20 20 63 or: $msg".. c
0510: 6c 6f 73 65 20 24 66 64 0a 09 7d 0a 09 6c 69 73 lose $fd..}..lis
0520: 74 20 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 t error $msg.
0530: 20 7d 20 65 6c 73 65 20 7b 0a 09 6c 69 73 74 20 } else {..list
0540: 73 75 63 63 65 73 73 20 24 6d 73 67 0a 20 20 20 success $msg.
0550: 20 7d 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 72 65 61 }.}..proc __rea
0560: 64 41 6e 64 45 78 65 63 75 74 65 5f 5f 20 7b 73 dAndExecute__ {s
0570: 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 63 } {. global c
0580: 6f 6d 6d 61 6e 64 20 56 45 52 42 4f 53 45 0a 0a ommand VERBOSE..
0590: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
05a0: 24 73 5d 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 $s]. if {[str
05b0: 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 6c 20 22 ing compare $l "
05c0: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
05d0: 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 --Marker--"] ==
05e0: 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 0} {..if {[info
05f0: 65 78 69 73 74 73 20 63 6f 6d 6d 61 6e 64 28 24 exists command($
0600: 73 29 5d 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 s)]} {.. puts
0610: 20 24 73 20 5b 6c 69 73 74 20 65 72 72 6f 72 20 $s [list error
0620: 69 6e 63 6f 6d 70 6c 65 74 65 5f 63 6f 6d 6d 61 incomplete_comma
0630: 6e 64 5d 0a 09 7d 0a 09 70 75 74 73 20 24 73 20 nd]..}..puts $s
0640: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
0650: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 0a 09 72 65 r--Marker--"..re
0660: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 69 turn. }. i
0670: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
0680: 72 65 20 24 6c 20 22 22 5d 20 3d 3d 20 30 7d 20 re $l ""] == 0}
0690: 7b 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d {..if {[eof $s]}
06a0: 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 56 45 52 {.. if {$VER
06b0: 42 4f 53 45 7d 20 7b 0a 09 09 70 75 74 73 20 22 BOSE} {...puts "
06c0: 53 65 72 76 65 72 20 63 6c 6f 73 69 6e 67 20 24 Server closing $
06d0: 73 2c 20 65 6f 66 20 66 72 6f 6d 20 63 6c 69 65 s, eof from clie
06e0: 6e 74 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 nt".. }..
06f0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 09 72 65 74 close $s..}..ret
0700: 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 61 70 urn. }. ap
0710: 70 65 6e 64 20 63 6f 6d 6d 61 6e 64 28 24 73 29 pend command($s)
0720: 20 24 6c 20 22 5c 6e 22 0a 20 20 20 20 69 66 20 $l "\n". if
0730: 7b 5b 69 6e 66 6f 20 63 6f 6d 70 6c 65 74 65 20 {[info complete
0740: 24 63 6f 6d 6d 61 6e 64 28 24 73 29 5d 7d 20 7b $command($s)]} {
0750: 0a 09 73 65 74 20 63 6d 64 73 20 24 63 6f 6d 6d ..set cmds $comm
0760: 61 6e 64 28 24 73 29 0a 09 75 6e 73 65 74 20 63 and($s)..unset c
0770: 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 70 75 74 73 ommand($s)..puts
0780: 20 24 73 20 5b 5f 5f 64 6f 43 6f 6d 6d 61 6e 64 $s [__doCommand
0790: 73 5f 5f 20 24 63 6d 64 73 20 24 73 5d 0a 20 20 s__ $cmds $s].
07a0: 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b 65 6f 66 }. if {[eof
07b0: 20 24 73 5d 7d 20 7b 0a 09 69 66 20 7b 24 56 45 $s]} {..if {$VE
07c0: 52 42 4f 53 45 7d 20 7b 0a 09 20 20 20 20 70 75 RBOSE} {.. pu
07d0: 74 73 20 22 53 65 72 76 65 72 20 63 6c 6f 73 69 ts "Server closi
07e0: 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 6f 6d 20 ng $s, eof from
07f0: 63 6c 69 65 6e 74 22 0a 09 7d 0a 09 63 6c 6f 73 client"..}..clos
0800: 65 20 24 73 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 e $s. }.}..pr
0810: 6f 63 20 5f 5f 61 63 63 65 70 74 5f 5f 20 7b 73 oc __accept__ {s
0820: 20 61 20 70 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 a p} {. glob
0830: 61 6c 20 56 45 52 42 4f 53 45 0a 0a 20 20 20 20 al VERBOSE..
0840: 69 66 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a if {$VERBOSE} {.
0850: 09 70 75 74 73 20 22 53 65 72 76 65 72 20 61 63 .puts "Server ac
0860: 63 65 70 74 73 20 6e 65 77 20 63 6f 6e 6e 65 63 cepts new connec
0870: 74 69 6f 6e 20 66 72 6f 6d 20 24 61 3a 24 70 20 tion from $a:$p
0880: 6f 6e 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 on $s". }.
0890: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
08a0: 24 73 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 $s. fileevent
08b0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
08c0: 73 74 20 5f 5f 72 65 61 64 41 6e 64 45 78 65 63 st __readAndExec
08d0: 75 74 65 5f 5f 20 24 73 5d 0a 20 20 20 20 66 63 ute__ $s]. fc
08e0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
08f0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
0900: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 7d 0a nslation crlf.}.
0910: 0a 73 65 74 20 73 65 72 76 65 72 49 73 53 69 6c .set serverIsSil
0920: 65 6e 74 20 30 0a 66 6f 72 20 7b 73 65 74 20 69 ent 0.for {set i
0930: 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 67 63 7d 0} {$i < $argc}
0940: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20 20 20 20 {incr i} {.
0950: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
0960: 61 72 65 20 2d 73 65 72 76 65 72 49 73 53 69 6c are -serverIsSil
0970: 65 6e 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 ent [lindex $arg
0980: 76 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 v $i]] == 0} {..
0990: 73 65 74 20 73 65 72 76 65 72 49 73 53 69 6c 65 set serverIsSile
09a0: 6e 74 20 31 0a 09 62 72 65 61 6b 0a 20 20 20 20 nt 1..break.
09b0: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
09c0: 78 69 73 74 73 20 73 65 72 76 65 72 50 6f 72 74 xists serverPort
09d0: 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e ]} {. if {[in
09e0: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 73 65 fo exists env(se
09f0: 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 rverPort)]} {..s
0a00: 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 24 65 et serverPort $e
0a10: 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 0a 20 nv(serverPort).
0a20: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0a30: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 50 o exists serverP
0a40: 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 20 ort]} {. for
0a50: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
0a60: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 $argc} {incr i}
0a70: 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 {..if {[string c
0a80: 6f 6d 70 61 72 65 20 2d 70 6f 72 74 20 5b 6c 69 ompare -port [li
0a90: 6e 64 65 78 20 24 61 72 67 76 20 24 69 5d 5d 20 ndex $argv $i]]
0aa0: 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 == 0} {.. if
0ab0: 7b 24 69 20 3c 20 5b 65 78 70 72 20 24 61 72 67 {$i < [expr $arg
0ac0: 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 74 20 c - 1]} {...set
0ad0: 73 65 72 76 65 72 50 6f 72 74 20 5b 6c 69 6e 64 serverPort [lind
0ae0: 65 78 20 24 61 72 67 76 20 5b 65 78 70 72 20 24 ex $argv [expr $
0af0: 69 20 2b 20 31 5d 5d 0a 09 20 20 20 20 7d 0a 09 i + 1]].. }..
0b00: 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 break..}.
0b10: 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 }.}.if {![info
0b20: 65 78 69 73 74 73 20 73 65 72 76 65 72 50 6f 72 exists serverPor
0b30: 74 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 65 t]} {. set se
0b40: 72 76 65 72 50 6f 72 74 20 32 30 34 38 0a 7d 0a rverPort 2048.}.
0b50: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0b60: 74 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 ts serverAddress
0b70: 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e ]} {. if {[in
0b80: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 73 65 fo exists env(se
0b90: 72 76 65 72 41 64 64 72 65 73 73 29 5d 7d 20 7b rverAddress)]} {
0ba0: 0a 09 73 65 74 20 73 65 72 76 65 72 41 64 64 72 ..set serverAddr
0bb0: 65 73 73 20 24 65 6e 76 28 73 65 72 76 65 72 41 ess $env(serverA
0bc0: 64 64 72 65 73 73 29 0a 20 20 20 20 7d 0a 7d 0a ddress). }.}.
0bd0: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
0be0: 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 5d s serverAddress]
0bf0: 7d 20 7b 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 } {. for {set
0c00: 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 67 i 0} {$i < $arg
0c10: 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 69 c} {incr i} {..i
0c20: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
0c30: 72 65 20 2d 61 64 64 72 65 73 73 20 5b 6c 69 6e re -address [lin
0c40: 64 65 78 20 24 61 72 67 76 20 24 69 5d 5d 20 3d dex $argv $i]] =
0c50: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b = 0} {.. if {
0c60: 24 69 20 3c 20 5b 65 78 70 72 20 24 61 72 67 63 $i < [expr $argc
0c70: 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 74 20 73 - 1]} {...set s
0c80: 65 72 76 65 72 41 64 64 72 65 73 73 20 5b 6c 69 erverAddress [li
0c90: 6e 64 65 78 20 24 61 72 67 76 20 5b 65 78 70 72 ndex $argv [expr
0ca0: 20 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 20 7d $i + 1]].. }
0cb0: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
0cc0: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0cd0: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41 o exists serverA
0ce0: 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 73 ddress]} {. s
0cf0: 65 74 20 73 65 72 76 65 72 41 64 64 72 65 73 73 et serverAddress
0d00: 20 30 2e 30 2e 30 2e 30 0a 7d 0a 0a 69 66 20 7b 0.0.0.0.}..if {
0d10: 24 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 $serverIsSilent
0d20: 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 73 65 74 20 == 0} {. set
0d30: 6c 20 22 52 65 6d 6f 74 65 20 73 65 72 76 65 72 l "Remote server
0d40: 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f listening on po
0d50: 72 74 20 24 73 65 72 76 65 72 50 6f 72 74 2c 20 rt $serverPort,
0d60: 49 50 20 24 73 65 72 76 65 72 41 64 64 72 65 73 IP $serverAddres
0d70: 73 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 0a s.". puts "".
0d80: 20 20 20 20 70 75 74 73 20 24 6c 0a 20 20 20 20 puts $l.
0d90: 66 6f 72 20 7b 73 65 74 20 63 20 5b 73 74 72 69 for {set c [stri
0da0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 7d 20 7b ng length $l]} {
0db0: 24 63 20 3e 20 30 7d 20 7b 69 6e 63 72 20 63 20 $c > 0} {incr c
0dc0: 2d 31 7d 20 7b 70 75 74 73 20 2d 6e 6f 6e 65 77 -1} {puts -nonew
0dd0: 6c 69 6e 65 20 22 2d 22 7d 0a 20 20 20 20 70 75 line "-"}. pu
0de0: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 22 ts "". puts "
0df0: 22 0a 20 20 20 20 70 75 74 73 20 22 59 6f 75 20 ". puts "You
0e00: 68 61 76 65 20 73 65 74 20 74 68 65 20 54 63 6c have set the Tcl
0e10: 20 76 61 72 69 61 62 6c 65 73 20 73 65 72 76 65 variables serve
0e20: 72 41 64 64 72 65 73 73 20 74 6f 20 24 73 65 72 rAddress to $ser
0e30: 76 65 72 41 64 64 72 65 73 73 20 61 6e 64 22 0a verAddress and".
0e40: 20 20 20 20 70 75 74 73 20 22 73 65 72 76 65 72 puts "server
0e50: 50 6f 72 74 20 74 6f 20 24 73 65 72 76 65 72 50 Port to $serverP
0e60: 6f 72 74 2e 20 59 6f 75 20 63 61 6e 20 73 65 74 ort. You can set
0e70: 20 74 68 65 73 65 20 77 69 74 68 20 74 68 65 20 these with the
0e80: 2d 61 64 64 72 65 73 73 20 61 6e 64 22 0a 20 20 -address and".
0e90: 20 20 70 75 74 73 20 22 2d 70 6f 72 74 20 63 6f puts "-port co
0ea0: 6d 6d 61 6e 64 20 6c 69 6e 65 20 6f 70 74 69 6f mmand line optio
0eb0: 6e 73 2c 20 6f 72 20 61 73 20 65 6e 76 69 72 6f ns, or as enviro
0ec0: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 nment variables
0ed0: 69 6e 20 79 6f 75 72 22 0a 20 20 20 20 70 75 74 in your". put
0ee0: 73 20 22 73 68 65 6c 6c 2e 22 0a 20 20 20 20 70 s "shell.". p
0ef0: 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 uts "". puts
0f00: 22 4e 4f 54 45 3a 20 54 68 65 20 74 65 73 74 73 "NOTE: The tests
0f10: 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 70 will not work p
0f20: 72 6f 70 65 72 6c 79 20 69 66 20 73 65 72 76 65 roperly if serve
0f30: 72 41 64 64 72 65 73 73 20 69 73 20 73 65 74 20 rAddress is set
0f40: 74 6f 22 0a 20 20 20 20 70 75 74 73 20 22 5c 22 to". puts "\"
0f50: 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 20 31 localhost\" or 1
0f60: 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 20 70 27.0.0.1.". p
0f70: 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 uts "". puts
0f80: 22 57 68 65 6e 20 79 6f 75 20 69 6e 76 6f 6b 65 "When you invoke
0f90: 20 74 63 6c 74 65 73 74 20 74 6f 20 72 75 6e 20 tcltest to run
0fa0: 74 68 65 20 74 65 73 74 73 2c 20 73 65 74 20 74 the tests, set t
0fb0: 68 65 20 76 61 72 69 61 62 6c 65 73 22 0a 20 20 he variables".
0fc0: 20 20 70 75 74 73 20 22 72 65 6d 6f 74 65 53 65 puts "remoteSe
0fd0: 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73 65 72 rverPort to $ser
0fe0: 76 65 72 50 6f 72 74 20 61 6e 64 20 72 65 6d 6f verPort and remo
0ff0: 74 65 53 65 72 76 65 72 49 50 20 74 6f 22 0a 20 teServerIP to".
1000: 20 20 20 70 75 74 73 20 22 5b 69 6e 66 6f 20 68 puts "[info h
1010: 6f 73 74 6e 61 6d 65 5d 2e 20 59 6f 75 20 63 61 ostname]. You ca
1020: 6e 20 73 65 74 20 74 68 65 73 65 20 61 73 20 65 n set these as e
1030: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
1040: 62 6c 65 73 22 0a 20 20 20 20 70 75 74 73 20 22 bles". puts "
1050: 66 72 6f 6d 20 74 68 65 20 73 68 65 6c 6c 2e 20 from the shell.
1060: 54 68 65 20 74 65 73 74 73 20 77 69 6c 6c 20 6e The tests will n
1070: 6f 74 20 77 6f 72 6b 20 70 72 6f 70 65 72 6c 79 ot work properly
1080: 20 69 66 20 79 6f 75 20 73 65 74 22 0a 20 20 20 if you set".
1090: 20 70 75 74 73 20 22 72 65 6d 6f 74 65 53 65 72 puts "remoteSer
10a0: 76 65 72 49 50 20 74 6f 20 5c 22 6c 6f 63 61 6c verIP to \"local
10b0: 68 6f 73 74 5c 22 20 6f 72 20 31 32 37 2e 30 2e host\" or 127.0.
10c0: 30 2e 31 2e 22 0a 20 20 20 20 70 75 74 73 20 22 0.1.". puts "
10d0: 22 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 ". puts -none
10e0: 77 6c 69 6e 65 20 22 54 79 70 65 20 43 74 72 6c wline "Type Ctrl
10f0: 2d 43 20 74 6f 20 74 65 72 6d 69 6e 61 74 65 2d -C to terminate-
1100: 2d 3e 20 22 0a 20 20 20 20 66 6c 75 73 68 20 73 -> ". flush s
1110: 74 64 6f 75 74 0a 7d 0a 0a 69 66 20 7b 5b 63 61 tdout.}..if {[ca
1120: 74 63 68 20 7b 73 65 74 20 73 65 72 76 65 72 53 tch {set serverS
1130: 6f 63 6b 65 74 20 5c 0a 20 20 20 20 5b 74 6c 73 ocket \. [tls
1140: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 ::socket -myaddr
1150: 20 24 73 65 72 76 65 72 41 64 64 72 65 73 73 20 $serverAddress
1160: 2d 73 65 72 76 65 72 20 5f 5f 61 63 63 65 70 74 -server __accept
1170: 5f 5f 20 5c 0a 20 20 20 20 09 2d 63 61 66 69 6c __ \. .-cafil
1180: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
1190: 64 5d 20 63 65 72 74 73 20 63 61 63 65 72 74 2e d] certs cacert.
11a0: 70 65 6d 5d 20 5c 0a 20 20 20 20 09 2d 63 65 72 pem] \. .-cer
11b0: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
11c0: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
11d0: 76 65 72 2e 70 65 6d 5d 20 5c 0a 20 20 20 20 09 ver.pem] \. .
11e0: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
11f0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
1200: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 24 73 65 skey.pem] \..$se
1210: 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 7d rverPort]} msg]}
1220: 20 7b 0a 20 20 20 20 70 75 74 73 20 22 53 65 72 {. puts "Ser
1230: 76 65 72 20 6f 6e 20 24 73 65 72 76 65 72 41 64 ver on $serverAd
1240: 64 72 65 73 73 3a 24 73 65 72 76 65 72 50 6f 72 dress:$serverPor
1250: 74 20 63 61 6e 6e 6f 74 20 73 74 61 72 74 3a 20 t cannot start:
1260: 24 6d 73 67 22 0a 7d 20 65 6c 73 65 20 7b 0a 20 $msg".} else {.
1270: 20 20 20 76 77 61 69 74 20 5f 5f 73 65 72 76 65 vwait __serve
1280: 72 5f 77 61 69 74 5f 76 61 72 69 61 62 6c 65 5f r_wait_variable_
1290: 5f 0a 7d 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a _.}............