Artifact
9670d4fe20fcba146029bf1707bbe2203590c4c953ba22100461b890a0284107:
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 0a 23 20 54 68 69 73 20 66 69 clsh.#.# This fi
0020: 6c 65 20 63 6f 6e 74 61 69 6e 73 20 54 63 6c 20 le contains Tcl
0030: 63 6f 64 65 20 74 6f 20 69 6d 70 6c 65 6d 65 6e code to implemen
0040: 74 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 t a remote serve
0050: 72 20 74 68 61 74 20 63 61 6e 20 62 65 0a 23 20 r that can be.#
0060: 75 73 65 64 20 64 75 72 69 6e 67 20 74 65 73 74 used during test
0070: 69 6e 67 20 6f 66 20 54 63 6c 20 73 6f 63 6b 65 ing of Tcl socke
0080: 74 20 63 6f 64 65 2e 20 54 68 69 73 20 73 65 72 t code. This ser
0090: 76 65 72 20 69 73 20 75 73 65 64 20 62 79 20 73 ver is used by s
00a0: 6f 6d 65 0a 23 20 6f 66 20 74 68 65 20 74 65 73 ome.# of the tes
00b0: 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 ts in socket.tes
00c0: 74 2e 0a 23 0a 23 20 53 6f 75 72 63 65 20 74 68 t..#.# Source th
00d0: 69 73 20 66 69 6c 65 20 69 6e 20 74 68 65 20 72 is file in the r
00e0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 79 6f 75 emote server you
00f0: 20 61 72 65 20 75 73 69 6e 67 20 74 6f 20 74 65 are using to te
0100: 73 74 20 54 63 6c 20 61 67 61 69 6e 73 74 2e 0a st Tcl against..
0110: 23 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 #.# Copyright (c
0120: 29 20 31 39 39 35 2d 31 39 39 36 20 53 75 6e 20 ) 1995-1996 Sun
0130: 4d 69 63 72 6f 73 79 73 74 65 6d 73 2c 20 49 6e Microsystems, In
0140: 63 2e 0a 23 0a 23 20 53 65 65 20 74 68 65 20 66 c..#.# See the f
0150: 69 6c 65 20 22 6c 69 63 65 6e 73 65 2e 74 65 72 ile "license.ter
0160: 6d 73 22 20 66 6f 72 20 69 6e 66 6f 72 6d 61 74 ms" for informat
0170: 69 6f 6e 20 6f 6e 20 75 73 61 67 65 20 61 6e 64 ion on usage and
0180: 20 72 65 64 69 73 74 72 69 62 75 74 69 6f 6e 0a redistribution.
0190: 23 20 6f 66 20 74 68 69 73 20 66 69 6c 65 2c 20 # of this file,
01a0: 61 6e 64 20 66 6f 72 20 61 20 44 49 53 43 4c 41 and for a DISCLA
01b0: 49 4d 45 52 20 4f 46 20 41 4c 4c 20 57 41 52 52 IMER OF ALL WARR
01c0: 41 4e 54 49 45 53 2e 0a 23 0a 0a 23 20 6c 6f 61 ANTIES..#..# loa
01d0: 64 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 d tls package.pa
01e0: 63 6b 61 67 65 20 70 72 65 66 65 72 20 6c 61 74 ckage prefer lat
01f0: 65 73 74 0a 70 61 63 6b 61 67 65 20 72 65 71 75 est.package requ
0200: 69 72 65 20 74 6c 73 0a 0a 23 20 49 6e 69 74 69 ire tls..# Initi
0210: 61 6c 69 7a 65 20 6d 65 73 73 61 67 65 20 64 65 alize message de
0220: 6c 69 6d 69 74 65 72 0a 0a 23 20 49 6e 69 74 69 limiter..# Initi
0230: 61 6c 69 7a 65 20 63 6f 6d 6d 61 6e 64 20 61 72 alize command ar
0240: 72 61 79 0a 63 61 74 63 68 20 7b 75 6e 73 65 74 ray.catch {unset
0250: 20 63 6f 6d 6d 61 6e 64 7d 0a 73 65 74 20 63 6f command}.set co
0260: 6d 6d 61 6e 64 28 30 29 20 22 22 0a 73 65 74 20 mmand(0) "".set
0270: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 22 22 0a callerSocket "".
0280: 0a 23 20 44 65 74 65 63 74 20 77 68 65 74 68 65 .# Detect whethe
0290: 72 20 77 65 20 73 68 6f 75 6c 64 20 70 72 69 6e r we should prin
02a0: 74 20 6f 75 74 20 63 6f 6e 6e 65 63 74 69 6f 6e t out connection
02b0: 20 6d 65 73 73 61 67 65 73 20 65 74 63 2e 0a 23 messages etc..#
02c0: 20 73 65 74 20 56 45 52 42 4f 53 45 20 31 0a 69 set VERBOSE 1.i
02d0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
02e0: 20 56 45 52 42 4f 53 45 5d 7d 20 7b 0a 20 20 20 VERBOSE]} {.
02f0: 20 73 65 74 20 56 45 52 42 4f 53 45 20 30 0a 7d set VERBOSE 0.}
0300: 0a 0a 70 72 6f 63 20 5f 5f 64 6f 43 6f 6d 6d 61 ..proc __doComma
0310: 6e 64 73 5f 5f 20 7b 6c 20 73 7d 20 7b 0a 20 20 nds__ {l s} {.
0320: 20 20 67 6c 6f 62 61 6c 20 63 61 6c 6c 65 72 53 global callerS
0330: 6f 63 6b 65 74 20 56 45 52 42 4f 53 45 0a 0a 20 ocket VERBOSE..
0340: 20 20 20 69 66 20 7b 24 56 45 52 42 4f 53 45 7d if {$VERBOSE}
0350: 20 7b 0a 09 70 75 74 73 20 22 2d 2d 2d 20 53 65 {..puts "--- Se
0360: 72 76 65 72 20 65 78 65 63 75 74 69 6e 67 20 74 rver executing t
0370: 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 he following for
0380: 20 73 6f 63 6b 65 74 20 24 73 3a 22 0a 09 70 75 socket $s:"..pu
0390: 74 73 20 24 6c 0a 09 70 75 74 73 20 22 2d 2d 2d ts $l..puts "---
03a0: 22 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b ". }. if {
03b0: 30 7d 20 7b 0a 09 73 65 74 20 66 64 20 5b 6f 70 0} {..set fd [op
03c0: 65 6e 20 72 65 6d 6f 74 65 53 65 72 76 65 72 2e en remoteServer.
03d0: 6c 6f 67 20 61 5d 0a 09 63 61 74 63 68 20 7b 70 log a]..catch {p
03e0: 75 74 73 20 24 66 64 20 22 73 6b 65 79 3a 20 24 uts $fd "skey: $
03f0: 73 65 72 76 65 72 4b 65 79 22 7d 0a 09 70 75 74 serverKey"}..put
0400: 73 20 24 66 64 20 22 2d 2d 2d 20 53 65 72 76 65 s $fd "--- Serve
0410: 72 20 65 78 65 63 75 74 69 6e 67 20 74 68 65 20 r executing the
0420: 66 6f 6c 6c 6f 77 69 6e 67 20 66 6f 72 20 73 6f following for so
0430: 63 6b 65 74 20 24 73 3a 22 0a 09 70 75 74 73 20 cket $s:"..puts
0440: 24 66 64 20 24 6c 0a 09 70 75 74 73 20 24 66 64 $fd $l..puts $fd
0450: 20 22 2d 2d 2d 22 0a 09 63 6c 6f 73 65 20 24 66 "---"..close $f
0460: 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 d. }. set
0470: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 24 73 0a callerSocket $s.
0480: 20 20 20 20 73 65 74 20 3a 3a 65 72 72 6f 72 49 set ::errorI
0490: 6e 66 6f 20 22 22 0a 20 20 20 20 69 66 20 7b 5b nfo "". if {[
04a0: 63 61 74 63 68 20 7b 75 70 6c 65 76 65 6c 20 22 catch {uplevel "
04b0: 23 30 22 20 24 6c 7d 20 6d 73 67 5d 7d 20 7b 0a #0" $l} msg]} {.
04c0: 20 20 20 20 09 69 66 20 7b 30 7d 20 7b 0a 09 20 .if {0} {..
04d0: 20 20 20 73 65 74 20 66 64 20 5b 6f 70 65 6e 20 set fd [open
04e0: 72 65 6d 6f 74 65 53 65 72 76 65 72 2e 6c 6f 67 remoteServer.log
04f0: 20 61 5d 0a 09 20 20 20 20 70 75 74 73 20 24 66 a].. puts $f
0500: 64 20 22 65 72 72 6f 72 3a 20 24 6d 73 67 22 0a d "error: $msg".
0510: 09 20 20 20 20 63 6c 6f 73 65 20 24 66 64 0a 09 . close $fd..
0520: 7d 0a 09 73 65 74 20 63 6f 64 65 20 65 72 72 6f }..set code erro
0530: 72 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 r. } else {..
0540: 73 65 74 20 63 6f 64 65 20 73 75 63 63 65 73 73 set code success
0550: 0a 20 20 20 20 7d 0a 20 20 20 20 23 72 65 74 75 . }. #retu
0560: 72 6e 20 5b 6c 69 73 74 20 24 63 6f 64 65 20 24 rn [list $code $
0570: 3a 3a 65 72 72 6f 72 49 6e 66 6f 20 24 6d 73 67 ::errorInfo $msg
0580: 5d 0a 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 ]. return [li
0590: 73 74 20 24 63 6f 64 65 20 24 6d 73 67 5d 0a 7d st $code $msg].}
05a0: 0a 0a 70 72 6f 63 20 5f 5f 72 65 61 64 41 6e 64 ..proc __readAnd
05b0: 45 78 65 63 75 74 65 5f 5f 20 7b 73 7d 20 7b 0a Execute__ {s} {.
05c0: 20 20 20 20 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 global comma
05d0: 6e 64 20 56 45 52 42 4f 53 45 0a 0a 20 20 20 20 nd VERBOSE..
05e0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
05f0: 20 20 20 20 69 66 20 7b 24 6c 20 65 71 20 22 2d if {$l eq "-
0600: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
0610: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 7b 0a 09 69 -Marker--"} {..i
0620: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0630: 63 6f 6d 6d 61 6e 64 28 24 73 29 5d 7d 20 7b 0a command($s)]} {.
0640: 09 20 20 20 20 70 75 74 73 20 24 73 20 5b 6c 69 . puts $s [li
0650: 73 74 20 65 72 72 6f 72 20 69 6e 63 6f 6d 70 6c st error incompl
0660: 65 74 65 5f 63 6f 6d 6d 61 6e 64 5d 0a 09 7d 0a ete_command]..}.
0670: 09 70 75 74 73 20 24 73 20 22 2d 2d 4d 61 72 6b .puts $s "--Mark
0680: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
0690: 65 72 2d 2d 22 0a 09 72 65 74 75 72 6e 0a 20 20 er--"..return.
06a0: 20 20 7d 0a 20 20 20 20 69 66 20 7b 24 6c 20 65 }. if {$l e
06b0: 71 20 22 22 7d 20 7b 0a 09 69 66 20 7b 5b 65 6f q ""} {..if {[eo
06c0: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 66 f $s]} {.. if
06d0: 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 09 {$VERBOSE} {...
06e0: 70 75 74 73 20 22 53 65 72 76 65 72 20 63 6c 6f puts "Server clo
06f0: 73 69 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 6f sing $s, eof fro
0700: 6d 20 63 6c 69 65 6e 74 22 0a 09 20 20 20 20 7d m client".. }
0710: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
0720: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
0730: 20 20 20 20 61 70 70 65 6e 64 20 63 6f 6d 6d 61 append comma
0740: 6e 64 28 24 73 29 20 24 6c 20 22 5c 6e 22 0a 20 nd($s) $l "\n".
0750: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d if {[info com
0760: 70 6c 65 74 65 20 24 63 6f 6d 6d 61 6e 64 28 24 plete $command($
0770: 73 29 5d 7d 20 7b 0a 09 73 65 74 20 63 6d 64 73 s)]} {..set cmds
0780: 20 24 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 75 $command($s)..u
0790: 6e 73 65 74 20 63 6f 6d 6d 61 6e 64 28 24 73 29 nset command($s)
07a0: 0a 09 70 75 74 73 20 24 73 20 5b 5f 5f 64 6f 43 ..puts $s [__doC
07b0: 6f 6d 6d 61 6e 64 73 5f 5f 20 24 63 6d 64 73 20 ommands__ $cmds
07c0: 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 $s]. }. if
07d0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 69 {[eof $s]} {..i
07e0: 66 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 f {$VERBOSE} {..
07f0: 20 20 20 20 70 75 74 73 20 22 53 65 72 76 65 72 puts "Server
0800: 20 63 6c 6f 73 69 6e 67 20 24 73 2c 20 65 6f 66 closing $s, eof
0810: 20 66 72 6f 6d 20 63 6c 69 65 6e 74 22 0a 09 7d from client"..}
0820: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
0830: 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 61 63 63 65 70 .}..proc __accep
0840: 74 5f 5f 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 t__ {s a p} {.
0850: 20 20 67 6c 6f 62 61 6c 20 56 45 52 42 4f 53 45 global VERBOSE
0860: 0a 0a 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f .. if {$VERBO
0870: 53 45 7d 20 7b 0a 09 70 75 74 73 20 22 53 65 72 SE} {..puts "Ser
0880: 76 65 72 20 61 63 63 65 70 74 73 20 6e 65 77 20 ver accepts new
0890: 63 6f 6e 6e 65 63 74 69 6f 6e 20 66 72 6f 6d 20 connection from
08a0: 24 61 3a 24 70 20 6f 6e 20 24 73 22 0a 20 20 20 $a:$p on $s".
08b0: 20 7d 0a 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 }. tls::hand
08c0: 73 68 61 6b 65 20 24 73 0a 20 20 20 20 66 63 6f shake $s. fco
08d0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
08e0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
08f0: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 20 20 20 slation crlf.
0900: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
0910: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 5f 5f 72 adable [list __r
0920: 65 61 64 41 6e 64 45 78 65 63 75 74 65 5f 5f 20 eadAndExecute__
0930: 24 73 5d 0a 7d 0a 0a 73 65 74 20 73 65 72 76 65 $s].}..set serve
0940: 72 49 73 53 69 6c 65 6e 74 20 30 0a 66 6f 72 20 rIsSilent 0.for
0950: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
0960: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20 $argc} {incr i}
0970: 7b 0a 20 20 20 20 69 66 20 7b 5b 6c 69 6e 64 65 {. if {[linde
0980: 78 20 24 61 72 67 76 20 24 69 5d 20 65 71 20 22 x $argv $i] eq "
0990: 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 22 -serverIsSilent"
09a0: 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 49 } {..set serverI
09b0: 73 53 69 6c 65 6e 74 20 31 0a 09 62 72 65 61 6b sSilent 1..break
09c0: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
09d0: 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 nfo exists serve
09e0: 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 rPort]} {. if
09f0: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 {[info exists e
0a00: 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 5d 7d nv(serverPort)]}
0a10: 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 50 6f {..set serverPo
0a20: 72 74 20 24 65 6e 76 28 73 65 72 76 65 72 50 6f rt $env(serverPo
0a30: 72 74 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b rt). }.}.if {
0a40: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 ![info exists se
0a50: 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 rverPort]} {.
0a60: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
0a70: 24 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 $i < $argc} {inc
0a80: 72 20 69 7d 20 7b 0a 09 69 66 20 7b 5b 6c 69 6e r i} {..if {[lin
0a90: 64 65 78 20 24 61 72 67 76 20 24 69 5d 20 65 71 dex $argv $i] eq
0aa0: 20 22 2d 70 6f 72 74 22 7d 20 7b 0a 09 20 20 20 "-port"} {..
0ab0: 20 69 66 20 7b 24 69 20 3c 20 24 61 72 67 63 20 if {$i < $argc
0ac0: 2d 20 31 7d 20 7b 0a 09 09 73 65 74 20 73 65 72 - 1} {...set ser
0ad0: 76 65 72 50 6f 72 74 20 5b 6c 69 6e 64 65 78 20 verPort [lindex
0ae0: 24 61 72 67 76 20 5b 65 78 70 72 20 7b 24 69 20 $argv [expr {$i
0af0: 2b 20 31 7d 5d 5d 0a 09 20 20 20 20 7d 0a 09 20 + 1}]].. }..
0b00: 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 break..}.
0b10: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
0b20: 78 69 73 74 73 20 73 65 72 76 65 72 50 6f 72 74 xists serverPort
0b30: 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 65 72 ]} {. set ser
0b40: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 7d 0a 0a verPort 8048.}..
0b50: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
0b60: 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 5d s serverAddress]
0b70: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
0b80: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 73 65 72 o exists env(ser
0b90: 76 65 72 41 64 64 72 65 73 73 29 5d 7d 20 7b 0a verAddress)]} {.
0ba0: 09 73 65 74 20 73 65 72 76 65 72 41 64 64 72 65 .set serverAddre
0bb0: 73 73 20 24 65 6e 76 28 73 65 72 76 65 72 41 64 ss $env(serverAd
0bc0: 64 72 65 73 73 29 0a 20 20 20 20 7d 0a 7d 0a 69 dress). }.}.i
0bd0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
0be0: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 5d 7d serverAddress]}
0bf0: 20 7b 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 {. for {set
0c00: 69 20 30 7d 20 7b 24 69 20 3c 20 24 61 72 67 63 i 0} {$i < $argc
0c10: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 69 66 } {incr i} {..if
0c20: 20 7b 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 {[lindex $argv
0c30: 24 69 5d 20 65 71 20 22 2d 61 64 64 72 65 73 73 $i] eq "-address
0c40: 22 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 69 "} {.. if {$i
0c50: 20 3c 20 24 61 72 67 63 20 2d 20 31 7d 20 7b 0a < $argc - 1} {.
0c60: 09 09 73 65 74 20 73 65 72 76 65 72 41 64 64 72 ..set serverAddr
0c70: 65 73 73 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 ess [lindex $arg
0c80: 76 20 5b 65 78 70 72 20 7b 24 69 20 2b 20 31 7d v [expr {$i + 1}
0c90: 5d 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 62 ]].. }.. b
0ca0: 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a reak..}. }.}.
0cb0: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
0cc0: 73 20 73 65 72 76 65 72 41 64 64 72 65 73 73 5d s serverAddress]
0cd0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 65 72 76 } {. set serv
0ce0: 65 72 41 64 64 72 65 73 73 20 30 2e 30 2e 30 2e erAddress 0.0.0.
0cf0: 30 0a 7d 0a 0a 69 66 20 7b 24 73 65 72 76 65 72 0.}..if {$server
0d00: 49 73 53 69 6c 65 6e 74 20 3d 3d 20 30 7d 20 7b IsSilent == 0} {
0d10: 0a 20 20 20 20 73 65 74 20 6c 20 22 52 65 6d 6f . set l "Remo
0d20: 74 65 20 73 65 72 76 65 72 20 6c 69 73 74 65 6e te server listen
0d30: 69 6e 67 20 6f 6e 20 70 6f 72 74 20 24 73 65 72 ing on port $ser
0d40: 76 65 72 50 6f 72 74 2c 20 49 50 20 24 73 65 72 verPort, IP $ser
0d50: 76 65 72 41 64 64 72 65 73 73 2e 22 0a 20 20 20 verAddress.".
0d60: 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 puts "". put
0d70: 73 20 24 6c 0a 20 20 20 20 66 6f 72 20 7b 73 65 s $l. for {se
0d80: 74 20 63 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 t c [string leng
0d90: 74 68 20 24 6c 5d 7d 20 7b 24 63 20 3e 20 30 7d th $l]} {$c > 0}
0da0: 20 7b 69 6e 63 72 20 63 20 2d 31 7d 20 7b 70 75 {incr c -1} {pu
0db0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 2d ts -nonewline "-
0dc0: 22 7d 0a 20 20 20 20 70 75 74 73 20 22 22 0a 20 "}. puts "".
0dd0: 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 puts "". p
0de0: 75 74 73 20 22 59 6f 75 20 68 61 76 65 20 73 65 uts "You have se
0df0: 74 20 74 68 65 20 54 63 6c 20 76 61 72 69 61 62 t the Tcl variab
0e00: 6c 65 73 20 73 65 72 76 65 72 41 64 64 72 65 73 les serverAddres
0e10: 73 20 74 6f 20 24 73 65 72 76 65 72 41 64 64 72 s to $serverAddr
0e20: 65 73 73 20 61 6e 64 22 0a 20 20 20 20 70 75 74 ess and". put
0e30: 73 20 22 73 65 72 76 65 72 50 6f 72 74 20 74 6f s "serverPort to
0e40: 20 24 73 65 72 76 65 72 50 6f 72 74 2e 20 59 6f $serverPort. Yo
0e50: 75 20 63 61 6e 20 73 65 74 20 74 68 65 73 65 20 u can set these
0e60: 77 69 74 68 20 74 68 65 20 2d 61 64 64 72 65 73 with the -addres
0e70: 73 20 61 6e 64 22 0a 20 20 20 20 70 75 74 73 20 s and". puts
0e80: 22 2d 70 6f 72 74 20 63 6f 6d 6d 61 6e 64 20 6c "-port command l
0e90: 69 6e 65 20 6f 70 74 69 6f 6e 73 2c 20 6f 72 20 ine options, or
0ea0: 61 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 as environment v
0eb0: 61 72 69 61 62 6c 65 73 20 69 6e 20 79 6f 75 72 ariables in your
0ec0: 22 0a 20 20 20 20 70 75 74 73 20 22 73 68 65 6c ". puts "shel
0ed0: 6c 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 0a l.". puts "".
0ee0: 20 20 20 20 70 75 74 73 20 22 4e 4f 54 45 3a 20 puts "NOTE:
0ef0: 54 68 65 20 74 65 73 74 73 20 77 69 6c 6c 20 6e The tests will n
0f00: 6f 74 20 77 6f 72 6b 20 70 72 6f 70 65 72 6c 79 ot work properly
0f10: 20 69 66 20 73 65 72 76 65 72 41 64 64 72 65 73 if serverAddres
0f20: 73 20 69 73 20 73 65 74 20 74 6f 22 0a 20 20 20 s is set to".
0f30: 20 70 75 74 73 20 22 5c 22 6c 6f 63 61 6c 68 6f puts "\"localho
0f40: 73 74 5c 22 20 6f 72 20 31 32 37 2e 30 2e 30 2e st\" or 127.0.0.
0f50: 31 2e 22 0a 20 20 20 20 70 75 74 73 20 22 22 0a 1.". puts "".
0f60: 20 20 20 20 70 75 74 73 20 22 57 68 65 6e 20 79 puts "When y
0f70: 6f 75 20 69 6e 76 6f 6b 65 20 74 63 6c 74 65 73 ou invoke tcltes
0f80: 74 20 74 6f 20 72 75 6e 20 74 68 65 20 74 65 73 t to run the tes
0f90: 74 73 2c 20 73 65 74 20 74 68 65 20 76 61 72 69 ts, set the vari
0fa0: 61 62 6c 65 73 22 0a 20 20 20 20 70 75 74 73 20 ables". puts
0fb0: 22 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 "remoteServerPor
0fc0: 74 20 74 6f 20 24 73 65 72 76 65 72 50 6f 72 74 t to $serverPort
0fd0: 20 61 6e 64 20 72 65 6d 6f 74 65 53 65 72 76 65 and remoteServe
0fe0: 72 49 50 20 74 6f 22 0a 20 20 20 20 70 75 74 73 rIP to". puts
0ff0: 20 22 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 "[info hostname
1000: 5d 2e 20 59 6f 75 20 63 61 6e 20 73 65 74 20 74 ]. You can set t
1010: 68 65 73 65 20 61 73 20 65 6e 76 69 72 6f 6e 6d hese as environm
1020: 65 6e 74 20 76 61 72 69 61 62 6c 65 73 22 0a 20 ent variables".
1030: 20 20 20 70 75 74 73 20 22 66 72 6f 6d 20 74 68 puts "from th
1040: 65 20 73 68 65 6c 6c 2e 20 54 68 65 20 74 65 73 e shell. The tes
1050: 74 73 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b ts will not work
1060: 20 70 72 6f 70 65 72 6c 79 20 69 66 20 79 6f 75 properly if you
1070: 20 73 65 74 22 0a 20 20 20 20 70 75 74 73 20 22 set". puts "
1080: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 74 remoteServerIP t
1090: 6f 20 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 o \"localhost\"
10a0: 6f 72 20 31 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 or 127.0.0.1.".
10b0: 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20 70 puts "". p
10c0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 uts -nonewline "
10d0: 54 79 70 65 20 43 74 72 6c 2d 43 20 74 6f 20 74 Type Ctrl-C to t
10e0: 65 72 6d 69 6e 61 74 65 2d 2d 3e 20 22 0a 20 20 erminate--> ".
10f0: 20 20 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 7d flush stdout.}
1100: 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 09 5b ..set certsDir.[
1110: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
1120: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 dirname [info sc
1130: 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 ript]] certs].se
1140: 74 20 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 t serverCert.[fi
1150: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
1160: 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 r server.pem].se
1170: 74 20 63 61 43 65 72 74 09 5b 66 69 6c 65 20 6a t caCert.[file j
1180: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 oin $certsDir ca
1190: 63 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 cert.pem].set se
11a0: 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f rverKey.[file jo
11b0: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 in $certsDir ser
11c0: 76 65 72 2e 6b 65 79 5d 0a 69 66 20 7b 5b 63 61 ver.key].if {[ca
11d0: 74 63 68 20 7b 73 65 74 20 73 65 72 76 65 72 53 tch {set serverS
11e0: 6f 63 6b 65 74 20 5c 0a 09 5b 74 6c 73 3a 3a 73 ocket \..[tls::s
11f0: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
1200: 20 2d 6d 79 61 64 64 72 20 24 73 65 72 76 65 72 -myaddr $server
1210: 41 64 64 72 65 73 73 20 2d 73 65 72 76 65 72 20 Address -server
1220: 5f 5f 61 63 63 65 70 74 5f 5f 20 5c 0a 09 2d 63 __accept__ \..-c
1230: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 63 afile $caCert -c
1240: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
1250: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
1260: 72 76 65 72 4b 65 79 20 5c 0a 09 24 73 65 72 76 rverKey \..$serv
1270: 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 7d 20 7b erPort]} msg]} {
1280: 0a 20 20 20 20 70 75 74 73 20 22 53 65 72 76 65 . puts "Serve
1290: 72 20 6f 6e 20 24 73 65 72 76 65 72 41 64 64 72 r on $serverAddr
12a0: 65 73 73 3a 24 73 65 72 76 65 72 50 6f 72 74 20 ess:$serverPort
12b0: 63 61 6e 6e 6f 74 20 73 74 61 72 74 3a 20 24 6d cannot start: $m
12c0: 73 67 22 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 sg".} else {.
12d0: 20 70 75 74 73 20 72 65 61 64 79 0a 20 20 20 20 puts ready.
12e0: 76 77 61 69 74 20 5f 5f 73 65 72 76 65 72 5f 77 vwait __server_w
12f0: 61 69 74 5f 76 61 72 69 61 62 6c 65 5f 5f 0a 7d ait_variable__.}
1300: 0a .