Artifact
ef6ea299d673becacc93d0ff1b93f2d8cd18a34ee4f6f7f24ae318a1c4946339:
0000: 23 21 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 74 #!/usr/bin/env t
0010: 63 6c 73 68 0a 23 20 54 68 69 73 20 66 69 6c 65 clsh.# This file
0020: 20 63 6f 6e 74 61 69 6e 73 20 54 63 6c 20 63 6f contains Tcl co
0030: 64 65 20 74 6f 20 69 6d 70 6c 65 6d 65 6e 74 20 de to implement
0040: 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 a remote server
0050: 74 68 61 74 20 63 61 6e 20 62 65 0a 23 20 75 73 that can be.# us
0060: 65 64 20 64 75 72 69 6e 67 20 74 65 73 74 69 6e ed during testin
0070: 67 20 6f 66 20 54 63 6c 20 73 6f 63 6b 65 74 20 g of Tcl socket
0080: 63 6f 64 65 2e 20 54 68 69 73 20 73 65 72 76 65 code. This serve
0090: 72 20 69 73 20 75 73 65 64 20 62 79 20 73 6f 6d r is used by som
00a0: 65 0a 23 20 6f 66 20 74 68 65 20 74 65 73 74 73 e.# of the tests
00b0: 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 2e in socket.test.
00c0: 0a 23 0a 23 20 53 6f 75 72 63 65 20 74 68 69 73 .#.# Source this
00d0: 20 66 69 6c 65 20 69 6e 20 74 68 65 20 72 65 6d file in the rem
00e0: 6f 74 65 20 73 65 72 76 65 72 20 79 6f 75 20 61 ote server you a
00f0: 72 65 20 75 73 69 6e 67 20 74 6f 20 74 65 73 74 re using to test
0100: 20 54 63 6c 20 61 67 61 69 6e 73 74 2e 0a 23 0a Tcl against..#.
0110: 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 # Copyright (c)
0120: 31 39 39 35 2d 31 39 39 36 20 53 75 6e 20 4d 69 1995-1996 Sun Mi
0130: 63 72 6f 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e crosystems, Inc.
0140: 0a 23 0a 23 20 53 65 65 20 74 68 65 20 66 69 6c .#.# See the fil
0150: 65 20 22 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 e "license.terms
0160: 22 20 66 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f " for informatio
0170: 6e 20 6f 6e 20 75 73 61 67 65 20 61 6e 64 20 72 n on usage and r
0180: 65 64 69 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 edistribution.#
0190: 6f 66 20 74 68 69 73 20 66 69 6c 65 2c 20 61 6e of this file, an
01a0: 64 20 66 6f 72 20 61 20 44 49 53 43 4c 41 49 4d d for a DISCLAIM
01b0: 45 52 20 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e ER OF ALL WARRAN
01c0: 54 49 45 53 2e 0a 23 0a 23 20 52 43 53 3a 20 40 TIES..#.# RCS: @
01d0: 28 23 29 20 24 49 64 3a 20 72 65 6d 6f 74 65 2e (#) $Id: remote.
01e0: 74 63 6c 2c 76 20 31 2e 36 20 32 30 30 34 2f 30 tcl,v 1.6 2004/0
01f0: 32 2f 31 31 20 32 32 3a 34 31 3a 32 35 20 72 61 2/11 22:41:25 ra
0200: 7a 7a 65 6c 6c 20 45 78 70 20 24 0a 0a 23 20 6c zzell Exp $..# l
0210: 6f 61 64 20 74 6c 73 20 70 61 63 6b 61 67 65 0a oad tls package.
0220: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0230: 74 6c 73 0a 0a 23 20 49 6e 69 74 69 61 6c 69 7a tls..# Initializ
0240: 65 20 6d 65 73 73 61 67 65 20 64 65 6c 69 6d 69 e message delimi
0250: 74 6f 72 0a 0a 23 20 49 6e 69 74 69 61 6c 69 7a tor..# Initializ
0260: 65 20 63 6f 6d 6d 61 6e 64 20 61 72 72 61 79 0a e command array.
0270: 63 61 74 63 68 20 7b 75 6e 73 65 74 20 63 6f 6d catch {unset com
0280: 6d 61 6e 64 7d 0a 73 65 74 20 63 6f 6d 6d 61 6e mand}.set comman
0290: 64 28 30 29 20 22 22 0a 73 65 74 20 63 61 6c 6c d(0) "".set call
02a0: 65 72 53 6f 63 6b 65 74 20 22 22 0a 0a 23 20 44 erSocket ""..# D
02b0: 65 74 65 63 74 20 77 68 65 74 68 65 72 20 77 65 etect whether we
02c0: 20 73 68 6f 75 6c 64 20 70 72 69 6e 74 20 6f 75 should print ou
02d0: 74 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 6d 65 73 t connection mes
02e0: 73 61 67 65 73 20 65 74 63 2e 0a 23 20 73 65 74 sages etc..# set
02f0: 20 56 45 52 42 4f 53 45 20 31 0a 69 66 20 7b 21 VERBOSE 1.if {!
0300: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 56 45 52 [info exists VER
0310: 42 4f 53 45 5d 7d 20 7b 0a 20 20 20 20 73 65 74 BOSE]} {. set
0320: 20 56 45 52 42 4f 53 45 20 30 0a 7d 0a 0a 70 72 VERBOSE 0.}..pr
0330: 6f 63 20 5f 5f 64 6f 43 6f 6d 6d 61 6e 64 73 5f oc __doCommands_
0340: 5f 20 7b 6c 20 73 7d 20 7b 0a 20 20 20 20 67 6c _ {l s} {. gl
0350: 6f 62 61 6c 20 63 61 6c 6c 65 72 53 6f 63 6b 65 obal callerSocke
0360: 74 20 56 45 52 42 4f 53 45 0a 0a 20 20 20 20 69 t VERBOSE.. i
0370: 66 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 f {$VERBOSE} {..
0380: 70 75 74 73 20 22 2d 2d 2d 20 53 65 72 76 65 72 puts "--- Server
0390: 20 65 78 65 63 75 74 69 6e 67 20 74 68 65 20 66 executing the f
03a0: 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 20 73 6f 63 ollowing for soc
03b0: 6b 65 74 20 24 73 3a 22 0a 09 70 75 74 73 20 24 ket $s:"..puts $
03c0: 6c 0a 09 70 75 74 73 20 22 2d 2d 2d 22 0a 20 20 l..puts "---".
03d0: 20 20 7d 0a 20 20 20 20 69 66 20 7b 30 7d 20 7b }. if {0} {
03e0: 0a 09 73 65 74 20 66 64 20 5b 6f 70 65 6e 20 72 ..set fd [open r
03f0: 65 6d 6f 74 65 53 65 72 76 65 72 2e 6c 6f 67 20 emoteServer.log
0400: 61 5d 0a 09 63 61 74 63 68 20 7b 70 75 74 73 20 a]..catch {puts
0410: 24 66 64 20 22 73 6b 65 79 3a 20 24 73 65 72 76 $fd "skey: $serv
0420: 65 72 4b 65 79 22 7d 0a 09 70 75 74 73 20 24 66 erKey"}..puts $f
0430: 64 20 22 2d 2d 2d 20 53 65 72 76 65 72 20 65 78 d "--- Server ex
0440: 65 63 75 74 69 6e 67 20 74 68 65 20 66 6f 6c 6c ecuting the foll
0450: 6f 77 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 owing for socket
0460: 20 24 73 3a 22 0a 09 70 75 74 73 20 24 66 64 20 $s:"..puts $fd
0470: 24 6c 0a 09 70 75 74 73 20 24 66 64 20 22 2d 2d $l..puts $fd "--
0480: 2d 22 0a 09 63 6c 6f 73 65 20 24 66 64 0a 20 20 -"..close $fd.
0490: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 61 6c 6c }. set call
04a0: 65 72 53 6f 63 6b 65 74 20 24 73 0a 20 20 20 20 erSocket $s.
04b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 75 70 6c 65 if {[catch {uple
04c0: 76 65 6c 20 23 30 20 24 6c 7d 20 6d 73 67 5d 7d vel #0 $l} msg]}
04d0: 20 7b 0a 20 20 20 20 09 69 66 20 7b 30 7d 20 7b {. .if {0} {
04e0: 0a 09 20 20 20 20 73 65 74 20 66 64 20 5b 6f 70 .. set fd [op
04f0: 65 6e 20 72 65 6d 6f 74 65 53 65 72 76 65 72 2e en remoteServer.
0500: 6c 6f 67 20 61 5d 0a 09 20 20 20 20 70 75 74 73 log a].. puts
0510: 20 24 66 64 20 22 65 72 72 6f 72 3a 20 24 6d 73 $fd "error: $ms
0520: 67 22 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 g".. close $f
0530: 64 0a 09 7d 0a 09 6c 69 73 74 20 65 72 72 6f 72 d..}..list error
0540: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
0550: 20 7b 0a 09 6c 69 73 74 20 73 75 63 63 65 73 73 {..list success
0560: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 7d 0a 0a 70 $msg. }.}..p
0570: 72 6f 63 20 5f 5f 72 65 61 64 41 6e 64 45 78 65 roc __readAndExe
0580: 63 75 74 65 5f 5f 20 7b 73 7d 20 7b 0a 20 20 20 cute__ {s} {.
0590: 20 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 20 global command
05a0: 56 45 52 42 4f 53 45 0a 0a 20 20 20 20 73 65 74 VERBOSE.. set
05b0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
05c0: 20 69 66 20 7b 24 6c 20 65 71 20 22 2d 2d 4d 61 if {$l eq "--Ma
05d0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 rker--Marker--Ma
05e0: 72 6b 65 72 2d 2d 22 7d 20 7b 0a 09 69 66 20 7b rker--"} {..if {
05f0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 63 6f 6d [info exists com
0600: 6d 61 6e 64 28 24 73 29 5d 7d 20 7b 0a 09 20 20 mand($s)]} {..
0610: 20 20 70 75 74 73 20 24 73 20 5b 6c 69 73 74 20 puts $s [list
0620: 65 72 72 6f 72 20 69 6e 63 6f 6d 70 6c 65 74 65 error incomplete
0630: 5f 63 6f 6d 6d 61 6e 64 5d 0a 09 7d 0a 09 70 75 _command]..}..pu
0640: 74 73 20 24 73 20 22 2d 2d 4d 61 72 6b 65 72 2d ts $s "--Marker-
0650: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
0660: 2d 22 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d -"..return. }
0670: 0a 20 20 20 20 69 66 20 7b 24 6c 20 65 71 20 22 . if {$l eq "
0680: 22 7d 20 7b 0a 09 69 66 20 7b 5b 65 6f 66 20 24 "} {..if {[eof $
0690: 73 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 s]} {.. if {$
06a0: 56 45 52 42 4f 53 45 7d 20 7b 0a 09 09 70 75 74 VERBOSE} {...put
06b0: 73 20 22 53 65 72 76 65 72 20 63 6c 6f 73 69 6e s "Server closin
06c0: 67 20 24 73 2c 20 65 6f 66 20 66 72 6f 6d 20 63 g $s, eof from c
06d0: 6c 69 65 6e 74 22 0a 09 20 20 20 20 7d 0a 09 20 lient".. }..
06e0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 09 close $s..}..
06f0: 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 return. }.
0700: 20 61 70 70 65 6e 64 20 63 6f 6d 6d 61 6e 64 28 append command(
0710: 24 73 29 20 24 6c 20 22 5c 6e 22 0a 20 20 20 20 $s) $l "\n".
0720: 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 70 6c 65 if {[info comple
0730: 74 65 20 24 63 6f 6d 6d 61 6e 64 28 24 73 29 5d te $command($s)]
0740: 7d 20 7b 0a 09 73 65 74 20 63 6d 64 73 20 24 63 } {..set cmds $c
0750: 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 75 6e 73 65 ommand($s)..unse
0760: 74 20 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 70 t command($s)..p
0770: 75 74 73 20 24 73 20 5b 5f 5f 64 6f 43 6f 6d 6d uts $s [__doComm
0780: 61 6e 64 73 5f 5f 20 24 63 6d 64 73 20 24 73 5d ands__ $cmds $s]
0790: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b . }. if {[
07a0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 69 66 20 7b eof $s]} {..if {
07b0: 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 20 20 20 $VERBOSE} {..
07c0: 20 70 75 74 73 20 22 53 65 72 76 65 72 20 63 6c puts "Server cl
07d0: 6f 73 69 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 osing $s, eof fr
07e0: 6f 6d 20 63 6c 69 65 6e 74 22 0a 09 7d 0a 09 63 om client"..}..c
07f0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 7d 0a lose $s. }.}.
0800: 0a 70 72 6f 63 20 5f 5f 61 63 63 65 70 74 5f 5f .proc __accept__
0810: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 67 {s a p} {. g
0820: 6c 6f 62 61 6c 20 56 45 52 42 4f 53 45 0a 0a 20 lobal VERBOSE..
0830: 20 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 7d if {$VERBOSE}
0840: 20 7b 0a 09 70 75 74 73 20 22 53 65 72 76 65 72 {..puts "Server
0850: 20 61 63 63 65 70 74 73 20 6e 65 77 20 63 6f 6e accepts new con
0860: 6e 65 63 74 69 6f 6e 20 66 72 6f 6d 20 24 61 3a nection from $a:
0870: 24 70 20 6f 6e 20 24 73 22 0a 20 20 20 20 7d 0a $p on $s". }.
0880: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
0890: 6b 65 20 24 73 0a 20 20 20 20 66 69 6c 65 65 76 ke $s. fileev
08a0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
08b0: 5b 6c 69 73 74 20 5f 5f 72 65 61 64 41 6e 64 45 [list __readAndE
08c0: 78 65 63 75 74 65 5f 5f 20 24 73 5d 0a 20 20 20 xecute__ $s].
08d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
08e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
08f0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
0900: 0a 7d 0a 0a 73 65 74 20 73 65 72 76 65 72 49 73 .}..set serverIs
0910: 53 69 6c 65 6e 74 20 30 0a 66 6f 72 20 7b 73 65 Silent 0.for {se
0920: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 t i 0} {$i < $ar
0930: 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 20 gc} {incr i} {.
0940: 20 20 20 69 66 20 7b 5b 6c 69 6e 64 65 78 20 24 if {[lindex $
0950: 61 72 67 76 20 24 69 5d 20 65 71 20 22 2d 73 65 argv $i] eq "-se
0960: 72 76 65 72 49 73 53 69 6c 65 6e 74 22 7d 20 7b rverIsSilent"} {
0970: 0a 09 73 65 74 20 73 65 72 76 65 72 49 73 53 69 ..set serverIsSi
0980: 6c 65 6e 74 20 31 0a 09 62 72 65 61 6b 0a 20 20 lent 1..break.
0990: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f }.}.if {![info
09a0: 20 65 78 69 73 74 73 20 73 65 72 76 65 72 50 6f exists serverPo
09b0: 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b rt]} {. if {[
09c0: 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 info exists env(
09d0: 73 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a serverPort)]} {.
09e0: 09 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 .set serverPort
09f0: 24 65 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 $env(serverPort)
0a00: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0a10: 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 nfo exists serve
0a20: 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 66 6f rPort]} {. fo
0a30: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
0a40: 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 < $argc} {incr i
0a50: 7d 20 7b 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78 } {..if {[lindex
0a60: 20 24 61 72 67 76 20 24 69 5d 20 65 71 20 22 2d $argv $i] eq "-
0a70: 70 6f 72 74 22 7d 20 7b 0a 09 20 20 20 20 69 66 port"} {.. if
0a80: 20 7b 24 69 20 3c 20 5b 65 78 70 72 20 24 61 72 {$i < [expr $ar
0a90: 67 63 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 74 gc - 1]} {...set
0aa0: 20 73 65 72 76 65 72 50 6f 72 74 20 5b 6c 69 6e serverPort [lin
0ab0: 64 65 78 20 24 61 72 67 76 20 5b 65 78 70 72 20 dex $argv [expr
0ac0: 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 20 7d 0a $i + 1]].. }.
0ad0: 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 . break..}.
0ae0: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f }.}.if {![info
0af0: 20 65 78 69 73 74 73 20 73 65 72 76 65 72 50 6f exists serverPo
0b00: 72 74 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 rt]} {. set s
0b10: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 7d erverPort 8048.}
0b20: 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 ..if {![info exi
0b30: 73 74 73 20 73 65 72 76 65 72 41 64 64 72 65 73 sts serverAddres
0b40: 73 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 s]} {. if {[i
0b50: 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 73 nfo exists env(s
0b60: 65 72 76 65 72 41 64 64 72 65 73 73 29 5d 7d 20 erverAddress)]}
0b70: 7b 0a 09 73 65 74 20 73 65 72 76 65 72 41 64 64 {..set serverAdd
0b80: 72 65 73 73 20 24 65 6e 76 28 73 65 72 76 65 72 ress $env(server
0b90: 41 64 64 72 65 73 73 29 0a 20 20 20 20 7d 0a 7d Address). }.}
0ba0: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0bb0: 74 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 ts serverAddress
0bc0: 5d 7d 20 7b 0a 20 20 20 20 66 6f 72 20 7b 73 65 ]} {. for {se
0bd0: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 t i 0} {$i < $ar
0be0: 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 gc} {incr i} {..
0bf0: 69 66 20 7b 5b 6c 69 6e 64 65 78 20 24 61 72 67 if {[lindex $arg
0c00: 76 20 24 69 5d 20 65 71 20 22 2d 61 64 64 72 65 v $i] eq "-addre
0c10: 73 73 22 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b ss"} {.. if {
0c20: 24 69 20 3c 20 5b 65 78 70 72 20 24 61 72 67 63 $i < [expr $argc
0c30: 20 2d 20 31 5d 7d 20 7b 0a 09 09 73 65 74 20 73 - 1]} {...set s
0c40: 65 72 76 65 72 41 64 64 72 65 73 73 20 5b 6c 69 erverAddress [li
0c50: 6e 64 65 78 20 24 61 72 67 76 20 5b 65 78 70 72 ndex $argv [expr
0c60: 20 24 69 20 2b 20 31 5d 5d 0a 09 20 20 20 20 7d $i + 1]].. }
0c70: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
0c80: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0c90: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41 o exists serverA
0ca0: 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 73 ddress]} {. s
0cb0: 65 74 20 73 65 72 76 65 72 41 64 64 72 65 73 73 et serverAddress
0cc0: 20 30 2e 30 2e 30 2e 30 0a 7d 0a 0a 69 66 20 7b 0.0.0.0.}..if {
0cd0: 24 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 $serverIsSilent
0ce0: 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 73 65 74 20 == 0} {. set
0cf0: 6c 20 22 52 65 6d 6f 74 65 20 73 65 72 76 65 72 l "Remote server
0d00: 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f listening on po
0d10: 72 74 20 24 73 65 72 76 65 72 50 6f 72 74 2c 20 rt $serverPort,
0d20: 49 50 20 24 73 65 72 76 65 72 41 64 64 72 65 73 IP $serverAddres
0d30: 73 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 0a s.". puts "".
0d40: 20 20 20 20 70 75 74 73 20 24 6c 0a 20 20 20 20 puts $l.
0d50: 66 6f 72 20 7b 73 65 74 20 63 20 5b 73 74 72 69 for {set c [stri
0d60: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 7d 20 7b ng length $l]} {
0d70: 24 63 20 3e 20 30 7d 20 7b 69 6e 63 72 20 63 20 $c > 0} {incr c
0d80: 2d 31 7d 20 7b 70 75 74 73 20 2d 6e 6f 6e 65 77 -1} {puts -nonew
0d90: 6c 69 6e 65 20 22 2d 22 7d 0a 20 20 20 20 70 75 line "-"}. pu
0da0: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 22 ts "". puts "
0db0: 22 0a 20 20 20 20 70 75 74 73 20 22 59 6f 75 20 ". puts "You
0dc0: 68 61 76 65 20 73 65 74 20 74 68 65 20 54 63 6c have set the Tcl
0dd0: 20 76 61 72 69 61 62 6c 65 73 20 73 65 72 76 65 variables serve
0de0: 72 41 64 64 72 65 73 73 20 74 6f 20 24 73 65 72 rAddress to $ser
0df0: 76 65 72 41 64 64 72 65 73 73 20 61 6e 64 22 0a verAddress and".
0e00: 20 20 20 20 70 75 74 73 20 22 73 65 72 76 65 72 puts "server
0e10: 50 6f 72 74 20 74 6f 20 24 73 65 72 76 65 72 50 Port to $serverP
0e20: 6f 72 74 2e 20 59 6f 75 20 63 61 6e 20 73 65 74 ort. You can set
0e30: 20 74 68 65 73 65 20 77 69 74 68 20 74 68 65 20 these with the
0e40: 2d 61 64 64 72 65 73 73 20 61 6e 64 22 0a 20 20 -address and".
0e50: 20 20 70 75 74 73 20 22 2d 70 6f 72 74 20 63 6f puts "-port co
0e60: 6d 6d 61 6e 64 20 6c 69 6e 65 20 6f 70 74 69 6f mmand line optio
0e70: 6e 73 2c 20 6f 72 20 61 73 20 65 6e 76 69 72 6f ns, or as enviro
0e80: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 nment variables
0e90: 69 6e 20 79 6f 75 72 22 0a 20 20 20 20 70 75 74 in your". put
0ea0: 73 20 22 73 68 65 6c 6c 2e 22 0a 20 20 20 20 70 s "shell.". p
0eb0: 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 uts "". puts
0ec0: 22 4e 4f 54 45 3a 20 54 68 65 20 74 65 73 74 73 "NOTE: The tests
0ed0: 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 70 will not work p
0ee0: 72 6f 70 65 72 6c 79 20 69 66 20 73 65 72 76 65 roperly if serve
0ef0: 72 41 64 64 72 65 73 73 20 69 73 20 73 65 74 20 rAddress is set
0f00: 74 6f 22 0a 20 20 20 20 70 75 74 73 20 22 5c 22 to". puts "\"
0f10: 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 20 31 localhost\" or 1
0f20: 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 20 70 27.0.0.1.". p
0f30: 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 uts "". puts
0f40: 22 57 68 65 6e 20 79 6f 75 20 69 6e 76 6f 6b 65 "When you invoke
0f50: 20 74 63 6c 74 65 73 74 20 74 6f 20 72 75 6e 20 tcltest to run
0f60: 74 68 65 20 74 65 73 74 73 2c 20 73 65 74 20 74 the tests, set t
0f70: 68 65 20 76 61 72 69 61 62 6c 65 73 22 0a 20 20 he variables".
0f80: 20 20 70 75 74 73 20 22 72 65 6d 6f 74 65 53 65 puts "remoteSe
0f90: 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73 65 72 rverPort to $ser
0fa0: 76 65 72 50 6f 72 74 20 61 6e 64 20 72 65 6d 6f verPort and remo
0fb0: 74 65 53 65 72 76 65 72 49 50 20 74 6f 22 0a 20 teServerIP to".
0fc0: 20 20 20 70 75 74 73 20 22 5b 69 6e 66 6f 20 68 puts "[info h
0fd0: 6f 73 74 6e 61 6d 65 5d 2e 20 59 6f 75 20 63 61 ostname]. You ca
0fe0: 6e 20 73 65 74 20 74 68 65 73 65 20 61 73 20 65 n set these as e
0ff0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
1000: 62 6c 65 73 22 0a 20 20 20 20 70 75 74 73 20 22 bles". puts "
1010: 66 72 6f 6d 20 74 68 65 20 73 68 65 6c 6c 2e 20 from the shell.
1020: 54 68 65 20 74 65 73 74 73 20 77 69 6c 6c 20 6e The tests will n
1030: 6f 74 20 77 6f 72 6b 20 70 72 6f 70 65 72 6c 79 ot work properly
1040: 20 69 66 20 79 6f 75 20 73 65 74 22 0a 20 20 20 if you set".
1050: 20 70 75 74 73 20 22 72 65 6d 6f 74 65 53 65 72 puts "remoteSer
1060: 76 65 72 49 50 20 74 6f 20 5c 22 6c 6f 63 61 6c verIP to \"local
1070: 68 6f 73 74 5c 22 20 6f 72 20 31 32 37 2e 30 2e host\" or 127.0.
1080: 30 2e 31 2e 22 0a 20 20 20 20 70 75 74 73 20 22 0.1.". puts "
1090: 22 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 ". puts -none
10a0: 77 6c 69 6e 65 20 22 54 79 70 65 20 43 74 72 6c wline "Type Ctrl
10b0: 2d 43 20 74 6f 20 74 65 72 6d 69 6e 61 74 65 2d -C to terminate-
10c0: 2d 3e 20 22 0a 20 20 20 20 66 6c 75 73 68 20 73 -> ". flush s
10d0: 74 64 6f 75 74 0a 7d 0a 0a 73 65 74 20 63 65 72 tdout.}..set cer
10e0: 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e tsDir.[file join
10f0: 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b [file dirname [
1100: 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 info script]] ce
1110: 72 74 73 5d 0a 73 65 74 20 73 65 72 76 65 72 43 rts].set serverC
1120: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
1130: 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e certsDir server.
1140: 70 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 74 09 pem].set caCert.
1150: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
1160: 73 44 69 72 20 63 61 63 65 72 74 2e 70 65 6d 5d sDir cacert.pem]
1170: 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b .set serverKey.[
1180: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
1190: 44 69 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a Dir server.key].
11a0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
11b0: 73 65 72 76 65 72 53 6f 63 6b 65 74 20 5c 0a 09 serverSocket \..
11c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 [tls::socket -my
11d0: 61 64 64 72 20 24 73 65 72 76 65 72 41 64 64 72 addr $serverAddr
11e0: 65 73 73 20 2d 73 65 72 76 65 72 20 5f 5f 61 63 ess -server __ac
11f0: 63 65 70 74 5f 5f 20 5c 0a 09 2d 63 61 66 69 6c cept__ \..-cafil
1200: 65 20 24 63 61 43 65 72 74 20 2d 63 65 72 74 66 e $caCert -certf
1210: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
1220: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
1230: 4b 65 79 20 5c 0a 09 24 73 65 72 76 65 72 50 6f Key \..$serverPo
1240: 72 74 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 rt]} msg]} {.
1250: 20 70 75 74 73 20 22 53 65 72 76 65 72 20 6f 6e puts "Server on
1260: 20 24 73 65 72 76 65 72 41 64 64 72 65 73 73 3a $serverAddress:
1270: 24 73 65 72 76 65 72 50 6f 72 74 20 63 61 6e 6e $serverPort cann
1280: 6f 74 20 73 74 61 72 74 3a 20 24 6d 73 67 22 0a ot start: $msg".
1290: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 76 77 61 } else {. vwa
12a0: 69 74 20 5f 5f 73 65 72 76 65 72 5f 77 61 69 74 it __server_wait
12b0: 5f 76 61 72 69 61 62 6c 65 5f 5f 0a 7d 0a _variable__.}.