Artifact
6420d365aecd4e5d77d0f42f20f1122f00a3de75:
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 32 20 32 30 30 30 2f 30 36 2f 30 33 20 1.2 2000/06/03
01e0: 30 32 3a 33 30 3a 30 33 20 61 77 62 20 45 78 70 02:30:03 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 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
08a0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 5f 5f 72 adable [list __r
08b0: 65 61 64 41 6e 64 45 78 65 63 75 74 65 5f 5f 20 eadAndExecute__
08c0: 24 73 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 $s]. fconfigu
08d0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
08e0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
08f0: 6f 6e 20 63 72 6c 66 0a 7d 0a 0a 73 65 74 20 73 on crlf.}..set s
0900: 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 30 0a erverIsSilent 0.
0910: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
0920: 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 i < $argc} {incr
0930: 20 69 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 i} {. if {[s
0940: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 2d 73 tring compare -s
0950: 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 5b 6c erverIsSilent [l
0960: 69 6e 64 65 78 20 24 61 72 67 76 20 24 69 5d 5d index $argv $i]]
0970: 20 3d 3d 20 30 7d 20 7b 0a 09 73 65 74 20 73 65 == 0} {..set se
0980: 72 76 65 72 49 73 53 69 6c 65 6e 74 20 31 0a 09 rverIsSilent 1..
0990: 62 72 65 61 6b 0a 20 20 20 20 7d 0a 7d 0a 69 66 break. }.}.if
09a0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
09b0: 73 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 serverPort]} {.
09c0: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
09d0: 73 74 73 20 65 6e 76 28 73 65 72 76 65 72 50 6f sts env(serverPo
09e0: 72 74 29 5d 7d 20 7b 0a 09 73 65 74 20 73 65 72 rt)]} {..set ser
09f0: 76 65 72 50 6f 72 74 20 24 65 6e 76 28 73 65 72 verPort $env(ser
0a00: 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d 0a 7d verPort). }.}
0a10: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0a20: 74 73 20 73 65 72 76 65 72 50 6f 72 74 5d 7d 20 ts serverPort]}
0a30: 7b 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 {. for {set i
0a40: 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 67 63 7d 0} {$i < $argc}
0a50: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 69 66 20 {incr i} {..if
0a60: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
0a70: 20 2d 70 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 -port [lindex $
0a80: 61 72 67 76 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 argv $i]] == 0}
0a90: 7b 0a 09 20 20 20 20 69 66 20 7b 24 69 20 3c 20 {.. if {$i <
0aa0: 5b 65 78 70 72 20 24 61 72 67 63 20 2d 20 31 5d [expr $argc - 1]
0ab0: 7d 20 7b 0a 09 09 73 65 74 20 73 65 72 76 65 72 } {...set server
0ac0: 50 6f 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 Port [lindex $ar
0ad0: 67 76 20 5b 65 78 70 72 20 24 69 20 2b 20 31 5d gv [expr $i + 1]
0ae0: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 62 72 ].. }.. br
0af0: 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 eak..}. }.}.i
0b00: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
0b10: 20 73 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a serverPort]} {.
0b20: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 50 6f set serverPo
0b30: 72 74 20 32 30 34 38 0a 7d 0a 0a 69 66 20 7b 21 rt 2048.}..if {!
0b40: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 [info exists ser
0b50: 76 65 72 41 64 64 72 65 73 73 5d 7d 20 7b 0a 20 verAddress]} {.
0b60: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0b70: 73 74 73 20 65 6e 76 28 73 65 72 76 65 72 41 64 sts env(serverAd
0b80: 64 72 65 73 73 29 5d 7d 20 7b 0a 09 73 65 74 20 dress)]} {..set
0b90: 73 65 72 76 65 72 41 64 64 72 65 73 73 20 24 65 serverAddress $e
0ba0: 6e 76 28 73 65 72 76 65 72 41 64 64 72 65 73 73 nv(serverAddress
0bb0: 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b ). }.}.if {![
0bc0: 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 info exists serv
0bd0: 65 72 41 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 erAddress]} {.
0be0: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
0bf0: 7b 24 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e {$i < $argc} {in
0c00: 63 72 20 69 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 cr i} {..if {[st
0c10: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 2d 61 64 ring compare -ad
0c20: 64 72 65 73 73 20 5b 6c 69 6e 64 65 78 20 24 61 dress [lindex $a
0c30: 72 67 76 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b rgv $i]] == 0} {
0c40: 0a 09 20 20 20 20 69 66 20 7b 24 69 20 3c 20 5b .. if {$i < [
0c50: 65 78 70 72 20 24 61 72 67 63 20 2d 20 31 5d 7d expr $argc - 1]}
0c60: 20 7b 0a 09 09 73 65 74 20 73 65 72 76 65 72 41 {...set serverA
0c70: 64 64 72 65 73 73 20 5b 6c 69 6e 64 65 78 20 24 ddress [lindex $
0c80: 61 72 67 76 20 5b 65 78 70 72 20 24 69 20 2b 20 argv [expr $i +
0c90: 31 5d 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 1]].. }..
0ca0: 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 7d break..}. }.}
0cb0: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0cc0: 74 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 ts serverAddress
0cd0: 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 65 72 ]} {. set ser
0ce0: 76 65 72 41 64 64 72 65 73 73 20 30 2e 30 2e 30 verAddress 0.0.0
0cf0: 2e 30 0a 7d 0a 0a 69 66 20 7b 24 73 65 72 76 65 .0.}..if {$serve
0d00: 72 49 73 53 69 6c 65 6e 74 20 3d 3d 20 30 7d 20 rIsSilent == 0}
0d10: 7b 0a 20 20 20 20 73 65 74 20 6c 20 22 52 65 6d {. set l "Rem
0d20: 6f 74 65 20 73 65 72 76 65 72 20 6c 69 73 74 65 ote server liste
0d30: 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 24 73 65 ning on port $se
0d40: 72 76 65 72 50 6f 72 74 2c 20 49 50 20 24 73 65 rverPort, IP $se
0d50: 72 76 65 72 41 64 64 72 65 73 73 2e 22 0a 20 20 rverAddress.".
0d60: 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 puts "". pu
0d70: 74 73 20 24 6c 0a 20 20 20 20 66 6f 72 20 7b 73 ts $l. for {s
0d80: 65 74 20 63 20 5b 73 74 72 69 6e 67 20 6c 65 6e et c [string len
0d90: 67 74 68 20 24 6c 5d 7d 20 7b 24 63 20 3e 20 30 gth $l]} {$c > 0
0da0: 7d 20 7b 69 6e 63 72 20 63 20 2d 31 7d 20 7b 70 } {incr c -1} {p
0db0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 uts -nonewline "
0dc0: 2d 22 7d 0a 20 20 20 20 70 75 74 73 20 22 22 0a -"}. puts "".
0dd0: 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 puts "".
0de0: 70 75 74 73 20 22 59 6f 75 20 68 61 76 65 20 73 puts "You have s
0df0: 65 74 20 74 68 65 20 54 63 6c 20 76 61 72 69 61 et the Tcl varia
0e00: 62 6c 65 73 20 73 65 72 76 65 72 41 64 64 72 65 bles serverAddre
0e10: 73 73 20 74 6f 20 24 73 65 72 76 65 72 41 64 64 ss to $serverAdd
0e20: 72 65 73 73 20 61 6e 64 22 0a 20 20 20 20 70 75 ress and". pu
0e30: 74 73 20 22 73 65 72 76 65 72 50 6f 72 74 20 74 ts "serverPort t
0e40: 6f 20 24 73 65 72 76 65 72 50 6f 72 74 2e 20 59 o $serverPort. Y
0e50: 6f 75 20 63 61 6e 20 73 65 74 20 74 68 65 73 65 ou can set these
0e60: 20 77 69 74 68 20 74 68 65 20 2d 61 64 64 72 65 with the -addre
0e70: 73 73 20 61 6e 64 22 0a 20 20 20 20 70 75 74 73 ss and". puts
0e80: 20 22 2d 70 6f 72 74 20 63 6f 6d 6d 61 6e 64 20 "-port command
0e90: 6c 69 6e 65 20 6f 70 74 69 6f 6e 73 2c 20 6f 72 line options, or
0ea0: 20 61 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 as environment
0eb0: 76 61 72 69 61 62 6c 65 73 20 69 6e 20 79 6f 75 variables in you
0ec0: 72 22 0a 20 20 20 20 70 75 74 73 20 22 73 68 65 r". puts "she
0ed0: 6c 6c 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 ll.". puts ""
0ee0: 0a 20 20 20 20 70 75 74 73 20 22 4e 4f 54 45 3a . puts "NOTE:
0ef0: 20 54 68 65 20 74 65 73 74 73 20 77 69 6c 6c 20 The tests will
0f00: 6e 6f 74 20 77 6f 72 6b 20 70 72 6f 70 65 72 6c not work properl
0f10: 79 20 69 66 20 73 65 72 76 65 72 41 64 64 72 65 y if serverAddre
0f20: 73 73 20 69 73 20 73 65 74 20 74 6f 22 0a 20 20 ss is set to".
0f30: 20 20 70 75 74 73 20 22 5c 22 6c 6f 63 61 6c 68 puts "\"localh
0f40: 6f 73 74 5c 22 20 6f 72 20 31 32 37 2e 30 2e 30 ost\" or 127.0.0
0f50: 2e 31 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 .1.". puts ""
0f60: 0a 20 20 20 20 70 75 74 73 20 22 57 68 65 6e 20 . puts "When
0f70: 79 6f 75 20 69 6e 76 6f 6b 65 20 74 63 6c 74 65 you invoke tclte
0f80: 73 74 20 74 6f 20 72 75 6e 20 74 68 65 20 74 65 st to run the te
0f90: 73 74 73 2c 20 73 65 74 20 74 68 65 20 76 61 72 sts, set the var
0fa0: 69 61 62 6c 65 73 22 0a 20 20 20 20 70 75 74 73 iables". puts
0fb0: 20 22 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f "remoteServerPo
0fc0: 72 74 20 74 6f 20 24 73 65 72 76 65 72 50 6f 72 rt to $serverPor
0fd0: 74 20 61 6e 64 20 72 65 6d 6f 74 65 53 65 72 76 t and remoteServ
0fe0: 65 72 49 50 20 74 6f 22 0a 20 20 20 20 70 75 74 erIP to". put
0ff0: 73 20 22 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d s "[info hostnam
1000: 65 5d 2e 20 59 6f 75 20 63 61 6e 20 73 65 74 20 e]. You can set
1010: 74 68 65 73 65 20 61 73 20 65 6e 76 69 72 6f 6e these as environ
1020: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 22 0a ment variables".
1030: 20 20 20 20 70 75 74 73 20 22 66 72 6f 6d 20 74 puts "from t
1040: 68 65 20 73 68 65 6c 6c 2e 20 54 68 65 20 74 65 he shell. The te
1050: 73 74 73 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 sts will not wor
1060: 6b 20 70 72 6f 70 65 72 6c 79 20 69 66 20 79 6f k properly if yo
1070: 75 20 73 65 74 22 0a 20 20 20 20 70 75 74 73 20 u set". puts
1080: 22 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 "remoteServerIP
1090: 74 6f 20 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 to \"localhost\"
10a0: 20 6f 72 20 31 32 37 2e 30 2e 30 2e 31 2e 22 0a or 127.0.0.1.".
10b0: 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 puts "".
10c0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
10d0: 22 54 79 70 65 20 43 74 72 6c 2d 43 20 74 6f 20 "Type Ctrl-C to
10e0: 74 65 72 6d 69 6e 61 74 65 2d 2d 3e 20 22 0a 20 terminate--> ".
10f0: 20 20 20 66 6c 75 73 68 20 73 74 64 6f 75 74 0a flush stdout.
1100: 7d 0a 0a 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 }..if {[catch {s
1110: 65 74 20 73 65 72 76 65 72 53 6f 63 6b 65 74 20 et serverSocket
1120: 5c 0a 20 20 20 20 5b 74 6c 73 3a 3a 73 6f 63 6b \. [tls::sock
1130: 65 74 20 2d 6d 79 61 64 64 72 20 24 73 65 72 76 et -myaddr $serv
1140: 65 72 41 64 64 72 65 73 73 20 2d 73 65 72 76 65 erAddress -serve
1150: 72 20 5f 5f 61 63 63 65 70 74 5f 5f 20 5c 0a 20 r __accept__ \.
1160: 20 20 20 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c .-cafile [fil
1170: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
1180: 74 73 20 63 61 63 65 72 74 2e 70 65 6d 5d 20 5c ts cacert.pem] \
1190: 0a 20 20 20 20 09 2d 63 65 72 74 66 69 6c 65 20 . .-certfile
11a0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d [file join [pwd]
11b0: 20 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 certs server.pe
11c0: 6d 5d 20 5c 0a 20 20 20 20 09 2d 6b 65 79 66 69 m] \. .-keyfi
11d0: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
11e0: 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 wd] certs skey.p
11f0: 65 6d 5d 20 5c 0a 09 24 73 65 72 76 65 72 50 6f em] \..$serverPo
1200: 72 74 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 rt]} msg]} {.
1210: 20 70 75 74 73 20 22 53 65 72 76 65 72 20 6f 6e puts "Server on
1220: 20 24 73 65 72 76 65 72 41 64 64 72 65 73 73 3a $serverAddress:
1230: 24 73 65 72 76 65 72 50 6f 72 74 20 63 61 6e 6e $serverPort cann
1240: 6f 74 20 73 74 61 72 74 3a 20 24 6d 73 67 22 0a ot start: $msg".
1250: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 76 77 61 } else {. vwa
1260: 69 74 20 5f 5f 73 65 72 76 65 72 5f 77 61 69 74 it __server_wait
1270: 5f 76 61 72 69 61 62 6c 65 5f 5f 0a 7d 0a 0a 0a _variable__.}...
1280: 0a 0a 0a 0a 0a 0a 0a 0a 0a .........