TclTLS: Hex Artifact Content

Artifact 26f53255a5a95b226211d7897c9be0f93d7b628b:

Executable file tests/remote.tcl — part of check-in [977988aed6] at 2000-07-21 05:32:56 on branch tls-1-3-io-rewrite — * tests/tlsIO.test: corrected various tests to be correct for TLS stacked channels (as opposed to the standard sockets the test suite was adopted from). Key differences are that TLS cannot operate in one process without all channels being non-blocking, or the handshake will block, and handshaking must be forced in some cases. Also, handshakes don't seem to complete unless the client has placed at least one byte for the server to read in the channel. * tests/remote.tcl: corrected the finding of tests certificates * tlsIO.c (TlsCloseProc): removed deleting of timer handler as that is handled by Tls_Clean. * tls.tcl (tls::_accept): corrected the internal _accept to trickle callback errors to the user. * Makefile.in: made the install-binaries target regenerate the pkgIndex.tcl correctly. The test target probably shouldn't screw it up, but this is to be on the safe side. (user: hobbs, size: 4866) [annotate] [blame] [check-ins using]
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 2e 32 2e 31 20 32 30 30 30 2f 30 37   1.4.2.1 2000/07
01e0: 2f 32 31 20 30 35 3a 33 32 3a 35 37 20 68 6f 62  /21 05:32:57 hob
01f0: 62 73 20 45 78 70 20 24 0a 0a 23 20 6c 6f 61 64  bs Exp $..# load
0200: 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63   tls package.pac
0210: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73  kage require tls
0220: 0a 0a 23 20 49 6e 69 74 69 61 6c 69 7a 65 20 6d  ..# Initialize m
0230: 65 73 73 61 67 65 20 64 65 6c 69 6d 69 74 6f 72  essage delimitor
0240: 0a 0a 23 20 49 6e 69 74 69 61 6c 69 7a 65 20 63  ..# Initialize c
0250: 6f 6d 6d 61 6e 64 20 61 72 72 61 79 0a 63 61 74  ommand array.cat
0260: 63 68 20 7b 75 6e 73 65 74 20 63 6f 6d 6d 61 6e  ch {unset comman
0270: 64 7d 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 28 30  d}.set command(0
0280: 29 20 22 22 0a 73 65 74 20 63 61 6c 6c 65 72 53  ) "".set callerS
0290: 6f 63 6b 65 74 20 22 22 0a 0a 23 20 44 65 74 65  ocket ""..# Dete
02a0: 63 74 20 77 68 65 74 68 65 72 20 77 65 20 73 68  ct whether we sh
02b0: 6f 75 6c 64 20 70 72 69 6e 74 20 6f 75 74 20 63  ould print out c
02c0: 6f 6e 6e 65 63 74 69 6f 6e 20 6d 65 73 73 61 67  onnection messag
02d0: 65 73 20 65 74 63 2e 0a 23 20 73 65 74 20 56 45  es etc..# set VE
02e0: 52 42 4f 53 45 20 31 0a 69 66 20 7b 21 5b 69 6e  RBOSE 1.if {![in
02f0: 66 6f 20 65 78 69 73 74 73 20 56 45 52 42 4f 53  fo exists VERBOS
0300: 45 5d 7d 20 7b 0a 20 20 20 20 73 65 74 20 56 45  E]} {.    set VE
0310: 52 42 4f 53 45 20 30 0a 7d 0a 0a 70 72 6f 63 20  RBOSE 0.}..proc 
0320: 5f 5f 64 6f 43 6f 6d 6d 61 6e 64 73 5f 5f 20 7b  __doCommands__ {
0330: 6c 20 73 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61  l s} {.    globa
0340: 6c 20 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 56  l callerSocket V
0350: 45 52 42 4f 53 45 0a 0a 20 20 20 20 69 66 20 7b  ERBOSE..    if {
0360: 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 70 75 74  $VERBOSE} {..put
0370: 73 20 22 2d 2d 2d 20 53 65 72 76 65 72 20 65 78  s "--- Server ex
0380: 65 63 75 74 69 6e 67 20 74 68 65 20 66 6f 6c 6c  ecuting the foll
0390: 6f 77 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74  owing for socket
03a0: 20 24 73 3a 22 0a 09 70 75 74 73 20 24 6c 0a 09   $s:"..puts $l..
03b0: 70 75 74 73 20 22 2d 2d 2d 22 0a 20 20 20 20 7d  puts "---".    }
03c0: 0a 20 20 20 20 69 66 20 7b 30 7d 20 7b 0a 09 73  .    if {0} {..s
03d0: 65 74 20 66 64 20 5b 6f 70 65 6e 20 72 65 6d 6f  et fd [open remo
03e0: 74 65 53 65 72 76 65 72 2e 6c 6f 67 20 61 5d 0a  teServer.log a].
03f0: 09 63 61 74 63 68 20 7b 70 75 74 73 20 24 66 64  .catch {puts $fd
0400: 20 22 73 6b 65 79 3a 20 24 73 65 72 76 65 72 4b   "skey: $serverK
0410: 65 79 22 7d 0a 09 70 75 74 73 20 24 66 64 20 22  ey"}..puts $fd "
0420: 2d 2d 2d 20 53 65 72 76 65 72 20 65 78 65 63 75  --- Server execu
0430: 74 69 6e 67 20 74 68 65 20 66 6f 6c 6c 6f 77 69  ting the followi
0440: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 24 73  ng for socket $s
0450: 3a 22 0a 09 70 75 74 73 20 24 66 64 20 24 6c 0a  :"..puts $fd $l.
0460: 09 70 75 74 73 20 24 66 64 20 22 2d 2d 2d 22 0a  .puts $fd "---".
0470: 09 63 6c 6f 73 65 20 24 66 64 0a 20 20 20 20 7d  .close $fd.    }
0480: 0a 20 20 20 20 73 65 74 20 63 61 6c 6c 65 72 53  .    set callerS
0490: 6f 63 6b 65 74 20 24 73 0a 20 20 20 20 69 66 20  ocket $s.    if 
04a0: 7b 5b 63 61 74 63 68 20 7b 75 70 6c 65 76 65 6c  {[catch {uplevel
04b0: 20 23 30 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 6c 69 73 74 20 65 72 72 6f 72 20 24 6d  }..list error $m
0530: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a  sg.    } else {.
0540: 09 6c 69 73 74 20 73 75 63 63 65 73 73 20 24 6d  .list success $m
0550: 73 67 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63  sg.    }.}..proc
0560: 20 5f 5f 72 65 61 64 41 6e 64 45 78 65 63 75 74   __readAndExecut
0570: 65 5f 5f 20 7b 73 7d 20 7b 0a 20 20 20 20 67 6c  e__ {s} {.    gl
0580: 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 20 56 45 52  obal command VER
0590: 42 4f 53 45 0a 0a 20 20 20 20 73 65 74 20 6c 20  BOSE..    set l 
05a0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 69 66  [gets $s].    if
05b0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72   {[string compar
05c0: 65 20 24 6c 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d  e $l "--Marker--
05d0: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d  Marker--Marker--
05e0: 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 69 66 20 7b  "] == 0} {..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 5b 73 74 72 69 6e 67  .    if {[string
0680: 20 63 6f 6d 70 61 72 65 20 24 6c 20 22 22 5d 20   compare $l ""] 
0690: 3d 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 65 6f  == 0} {..if {[eo
06a0: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 66  f $s]} {..    if
06b0: 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09 09   {$VERBOSE} {...
06c0: 70 75 74 73 20 22 53 65 72 76 65 72 20 63 6c 6f  puts "Server clo
06d0: 73 69 6e 67 20 24 73 2c 20 65 6f 66 20 66 72 6f  sing $s, eof fro
06e0: 6d 20 63 6c 69 65 6e 74 22 0a 09 20 20 20 20 7d  m client"..    }
06f0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09  ..    close $s..
0700: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a  }..return.    }.
0710: 20 20 20 20 61 70 70 65 6e 64 20 63 6f 6d 6d 61      append comma
0720: 6e 64 28 24 73 29 20 24 6c 20 22 5c 6e 22 0a 20  nd($s) $l "\n". 
0730: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d     if {[info com
0740: 70 6c 65 74 65 20 24 63 6f 6d 6d 61 6e 64 28 24  plete $command($
0750: 73 29 5d 7d 20 7b 0a 09 73 65 74 20 63 6d 64 73  s)]} {..set cmds
0760: 20 24 63 6f 6d 6d 61 6e 64 28 24 73 29 0a 09 75   $command($s)..u
0770: 6e 73 65 74 20 63 6f 6d 6d 61 6e 64 28 24 73 29  nset command($s)
0780: 0a 09 70 75 74 73 20 24 73 20 5b 5f 5f 64 6f 43  ..puts $s [__doC
0790: 6f 6d 6d 61 6e 64 73 5f 5f 20 24 63 6d 64 73 20  ommands__ $cmds 
07a0: 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 69 66  $s].    }.    if
07b0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 69   {[eof $s]} {..i
07c0: 66 20 7b 24 56 45 52 42 4f 53 45 7d 20 7b 0a 09  f {$VERBOSE} {..
07d0: 20 20 20 20 70 75 74 73 20 22 53 65 72 76 65 72      puts "Server
07e0: 20 63 6c 6f 73 69 6e 67 20 24 73 2c 20 65 6f 66   closing $s, eof
07f0: 20 66 72 6f 6d 20 63 6c 69 65 6e 74 22 0a 09 7d   from client"..}
0800: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d  ..close $s.    }
0810: 0a 7d 0a 0a 70 72 6f 63 20 5f 5f 61 63 63 65 70  .}..proc __accep
0820: 74 5f 5f 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20  t__ {s a p} {.  
0830: 20 20 67 6c 6f 62 61 6c 20 56 45 52 42 4f 53 45    global VERBOSE
0840: 0a 0a 20 20 20 20 69 66 20 7b 24 56 45 52 42 4f  ..    if {$VERBO
0850: 53 45 7d 20 7b 0a 09 70 75 74 73 20 22 53 65 72  SE} {..puts "Ser
0860: 76 65 72 20 61 63 63 65 70 74 73 20 6e 65 77 20  ver accepts new 
0870: 63 6f 6e 6e 65 63 74 69 6f 6e 20 66 72 6f 6d 20  connection from 
0880: 24 61 3a 24 70 20 6f 6e 20 24 73 22 0a 20 20 20  $a:$p on $s".   
0890: 20 7d 0a 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64   }.    tls::hand
08a0: 73 68 61 6b 65 20 24 73 0a 20 20 20 20 66 69 6c  shake $s.    fil
08b0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62  eevent $s readab
08c0: 6c 65 20 5b 6c 69 73 74 20 5f 5f 72 65 61 64 41  le [list __readA
08d0: 6e 64 45 78 65 63 75 74 65 5f 5f 20 24 73 5d 0a  ndExecute__ $s].
08e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24      fconfigure $
08f0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e  s -buffering lin
0900: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63  e -translation c
0910: 72 6c 66 0a 7d 0a 0a 73 65 74 20 73 65 72 76 65  rlf.}..set serve
0920: 72 49 73 53 69 6c 65 6e 74 20 30 0a 66 6f 72 20  rIsSilent 0.for 
0930: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20  {set i 0} {$i < 
0940: 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69 7d 20  $argc} {incr i} 
0950: 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e  {.    if {[strin
0960: 67 20 63 6f 6d 70 61 72 65 20 2d 73 65 72 76 65  g compare -serve
0970: 72 49 73 53 69 6c 65 6e 74 20 5b 6c 69 6e 64 65  rIsSilent [linde
0980: 78 20 24 61 72 67 76 20 24 69 5d 5d 20 3d 3d 20  x $argv $i]] == 
0990: 30 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72  0} {..set server
09a0: 49 73 53 69 6c 65 6e 74 20 31 0a 09 62 72 65 61  IsSilent 1..brea
09b0: 6b 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b  k.    }.}.if {![
09c0: 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72 76  info exists serv
09d0: 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69  erPort]} {.    i
09e0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20  f {[info exists 
09f0: 65 6e 76 28 73 65 72 76 65 72 50 6f 72 74 29 5d  env(serverPort)]
0a00: 7d 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 50  } {..set serverP
0a10: 6f 72 74 20 24 65 6e 76 28 73 65 72 76 65 72 50  ort $env(serverP
0a20: 6f 72 74 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20  ort).    }.}.if 
0a30: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73  {![info exists s
0a40: 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20  erverPort]} {.  
0a50: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20    for {set i 0} 
0a60: 7b 24 69 20 3c 20 24 61 72 67 63 7d 20 7b 69 6e  {$i < $argc} {in
0a70: 63 72 20 69 7d 20 7b 0a 09 69 66 20 7b 5b 73 74  cr i} {..if {[st
0a80: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 2d 70 6f  ring compare -po
0a90: 72 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  rt [lindex $argv
0aa0: 20 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20   $i]] == 0} {.. 
0ab0: 20 20 20 69 66 20 7b 24 69 20 3c 20 5b 65 78 70     if {$i < [exp
0ac0: 72 20 24 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a  r $argc - 1]} {.
0ad0: 09 09 73 65 74 20 73 65 72 76 65 72 50 6f 72 74  ..set serverPort
0ae0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20 5b   [lindex $argv [
0af0: 65 78 70 72 20 24 69 20 2b 20 31 5d 5d 0a 09 20  expr $i + 1]].. 
0b00: 20 20 20 7d 0a 09 20 20 20 20 62 72 65 61 6b 0a     }..    break.
0b10: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21  .}.    }.}.if {!
0b20: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73 65 72  [info exists ser
0b30: 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20  verPort]} {.    
0b40: 73 65 74 20 73 65 72 76 65 72 50 6f 72 74 20 38  set serverPort 8
0b50: 30 34 38 0a 7d 0a 0a 69 66 20 7b 21 5b 69 6e 66  048.}..if {![inf
0b60: 6f 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41  o exists serverA
0b70: 64 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 69  ddress]} {.    i
0b80: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20  f {[info exists 
0b90: 65 6e 76 28 73 65 72 76 65 72 41 64 64 72 65 73  env(serverAddres
0ba0: 73 29 5d 7d 20 7b 0a 09 73 65 74 20 73 65 72 76  s)]} {..set serv
0bb0: 65 72 41 64 64 72 65 73 73 20 24 65 6e 76 28 73  erAddress $env(s
0bc0: 65 72 76 65 72 41 64 64 72 65 73 73 29 0a 20 20  erverAddress).  
0bd0: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f    }.}.if {![info
0be0: 20 65 78 69 73 74 73 20 73 65 72 76 65 72 41 64   exists serverAd
0bf0: 64 72 65 73 73 5d 7d 20 7b 0a 20 20 20 20 66 6f  dress]} {.    fo
0c00: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20  r {set i 0} {$i 
0c10: 3c 20 24 61 72 67 63 7d 20 7b 69 6e 63 72 20 69  < $argc} {incr i
0c20: 7d 20 7b 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67  } {..if {[string
0c30: 20 63 6f 6d 70 61 72 65 20 2d 61 64 64 72 65 73   compare -addres
0c40: 73 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76 20  s [lindex $argv 
0c50: 24 69 5d 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20  $i]] == 0} {..  
0c60: 20 20 69 66 20 7b 24 69 20 3c 20 5b 65 78 70 72    if {$i < [expr
0c70: 20 24 61 72 67 63 20 2d 20 31 5d 7d 20 7b 0a 09   $argc - 1]} {..
0c80: 09 73 65 74 20 73 65 72 76 65 72 41 64 64 72 65  .set serverAddre
0c90: 73 73 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 76  ss [lindex $argv
0ca0: 20 5b 65 78 70 72 20 24 69 20 2b 20 31 5d 5d 0a   [expr $i + 1]].
0cb0: 09 20 20 20 20 7d 0a 09 20 20 20 20 62 72 65 61  .    }..    brea
0cc0: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 69 66 20  k..}.    }.}.if 
0cd0: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 73  {![info exists s
0ce0: 65 72 76 65 72 41 64 64 72 65 73 73 5d 7d 20 7b  erverAddress]} {
0cf0: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 41  .    set serverA
0d00: 64 64 72 65 73 73 20 30 2e 30 2e 30 2e 30 0a 7d  ddress 0.0.0.0.}
0d10: 0a 0a 69 66 20 7b 24 73 65 72 76 65 72 49 73 53  ..if {$serverIsS
0d20: 69 6c 65 6e 74 20 3d 3d 20 30 7d 20 7b 0a 20 20  ilent == 0} {.  
0d30: 20 20 73 65 74 20 6c 20 22 52 65 6d 6f 74 65 20    set l "Remote 
0d40: 73 65 72 76 65 72 20 6c 69 73 74 65 6e 69 6e 67  server listening
0d50: 20 6f 6e 20 70 6f 72 74 20 24 73 65 72 76 65 72   on port $server
0d60: 50 6f 72 74 2c 20 49 50 20 24 73 65 72 76 65 72  Port, IP $server
0d70: 41 64 64 72 65 73 73 2e 22 0a 20 20 20 20 70 75  Address.".    pu
0d80: 74 73 20 22 22 0a 20 20 20 20 70 75 74 73 20 24  ts "".    puts $
0d90: 6c 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63  l.    for {set c
0da0: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20   [string length 
0db0: 24 6c 5d 7d 20 7b 24 63 20 3e 20 30 7d 20 7b 69  $l]} {$c > 0} {i
0dc0: 6e 63 72 20 63 20 2d 31 7d 20 7b 70 75 74 73 20  ncr c -1} {puts 
0dd0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 2d 22 7d 0a  -nonewline "-"}.
0de0: 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20 20      puts "".    
0df0: 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73  puts "".    puts
0e00: 20 22 59 6f 75 20 68 61 76 65 20 73 65 74 20 74   "You have set t
0e10: 68 65 20 54 63 6c 20 76 61 72 69 61 62 6c 65 73  he Tcl variables
0e20: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 74   serverAddress t
0e30: 6f 20 24 73 65 72 76 65 72 41 64 64 72 65 73 73  o $serverAddress
0e40: 20 61 6e 64 22 0a 20 20 20 20 70 75 74 73 20 22   and".    puts "
0e50: 73 65 72 76 65 72 50 6f 72 74 20 74 6f 20 24 73  serverPort to $s
0e60: 65 72 76 65 72 50 6f 72 74 2e 20 59 6f 75 20 63  erverPort. You c
0e70: 61 6e 20 73 65 74 20 74 68 65 73 65 20 77 69 74  an set these wit
0e80: 68 20 74 68 65 20 2d 61 64 64 72 65 73 73 20 61  h the -address a
0e90: 6e 64 22 0a 20 20 20 20 70 75 74 73 20 22 2d 70  nd".    puts "-p
0ea0: 6f 72 74 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65  ort command line
0eb0: 20 6f 70 74 69 6f 6e 73 2c 20 6f 72 20 61 73 20   options, or as 
0ec0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69  environment vari
0ed0: 61 62 6c 65 73 20 69 6e 20 79 6f 75 72 22 0a 20  ables in your". 
0ee0: 20 20 20 70 75 74 73 20 22 73 68 65 6c 6c 2e 22     puts "shell."
0ef0: 0a 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20  .    puts "".   
0f00: 20 70 75 74 73 20 22 4e 4f 54 45 3a 20 54 68 65   puts "NOTE: The
0f10: 20 74 65 73 74 73 20 77 69 6c 6c 20 6e 6f 74 20   tests will not 
0f20: 77 6f 72 6b 20 70 72 6f 70 65 72 6c 79 20 69 66  work properly if
0f30: 20 73 65 72 76 65 72 41 64 64 72 65 73 73 20 69   serverAddress i
0f40: 73 20 73 65 74 20 74 6f 22 0a 20 20 20 20 70 75  s set to".    pu
0f50: 74 73 20 22 5c 22 6c 6f 63 61 6c 68 6f 73 74 5c  ts "\"localhost\
0f60: 22 20 6f 72 20 31 32 37 2e 30 2e 30 2e 31 2e 22  " or 127.0.0.1."
0f70: 0a 20 20 20 20 70 75 74 73 20 22 22 0a 20 20 20  .    puts "".   
0f80: 20 70 75 74 73 20 22 57 68 65 6e 20 79 6f 75 20   puts "When you 
0f90: 69 6e 76 6f 6b 65 20 74 63 6c 74 65 73 74 20 74  invoke tcltest t
0fa0: 6f 20 72 75 6e 20 74 68 65 20 74 65 73 74 73 2c  o run the tests,
0fb0: 20 73 65 74 20 74 68 65 20 76 61 72 69 61 62 6c   set the variabl
0fc0: 65 73 22 0a 20 20 20 20 70 75 74 73 20 22 72 65  es".    puts "re
0fd0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 74  moteServerPort t
0fe0: 6f 20 24 73 65 72 76 65 72 50 6f 72 74 20 61 6e  o $serverPort an
0ff0: 64 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50  d remoteServerIP
1000: 20 74 6f 22 0a 20 20 20 20 70 75 74 73 20 22 5b   to".    puts "[
1010: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 2e 20  info hostname]. 
1020: 59 6f 75 20 63 61 6e 20 73 65 74 20 74 68 65 73  You can set thes
1030: 65 20 61 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74  e as environment
1040: 20 76 61 72 69 61 62 6c 65 73 22 0a 20 20 20 20   variables".    
1050: 70 75 74 73 20 22 66 72 6f 6d 20 74 68 65 20 73  puts "from the s
1060: 68 65 6c 6c 2e 20 54 68 65 20 74 65 73 74 73 20  hell. The tests 
1070: 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 70 72  will not work pr
1080: 6f 70 65 72 6c 79 20 69 66 20 79 6f 75 20 73 65  operly if you se
1090: 74 22 0a 20 20 20 20 70 75 74 73 20 22 72 65 6d  t".    puts "rem
10a0: 6f 74 65 53 65 72 76 65 72 49 50 20 74 6f 20 5c  oteServerIP to \
10b0: 22 6c 6f 63 61 6c 68 6f 73 74 5c 22 20 6f 72 20  "localhost\" or 
10c0: 31 32 37 2e 30 2e 30 2e 31 2e 22 0a 20 20 20 20  127.0.0.1.".    
10d0: 70 75 74 73 20 22 22 0a 20 20 20 20 70 75 74 73  puts "".    puts
10e0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22 54 79 70   -nonewline "Typ
10f0: 65 20 43 74 72 6c 2d 43 20 74 6f 20 74 65 72 6d  e Ctrl-C to term
1100: 69 6e 61 74 65 2d 2d 3e 20 22 0a 20 20 20 20 66  inate--> ".    f
1110: 6c 75 73 68 20 73 74 64 6f 75 74 0a 7d 0a 0a 73  lush stdout.}..s
1120: 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c  et certsDir.[fil
1130: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72  e join [file dir
1140: 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70  name [info scrip
1150: 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 74 20 73  t]] certs].set s
1160: 65 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20  erverCert.[file 
1170: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73  join $certsDir s
1180: 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63  erver.pem].set c
1190: 61 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e  aCert.[file join
11a0: 20 24 63 65 72 74 73 44 69 72 20 63 61 63 65 72   $certsDir cacer
11b0: 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 65  t.pem].set serve
11c0: 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20  rKey.[file join 
11d0: 24 63 65 72 74 73 44 69 72 20 73 6b 65 79 2e 70  $certsDir skey.p
11e0: 65 6d 5d 0a 69 66 20 7b 5b 63 61 74 63 68 20 7b  em].if {[catch {
11f0: 73 65 74 20 73 65 72 76 65 72 53 6f 63 6b 65 74  set serverSocket
1200: 20 5c 0a 09 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74   \..[tls::socket
1210: 20 2d 6d 79 61 64 64 72 20 24 73 65 72 76 65 72   -myaddr $server
1220: 41 64 64 72 65 73 73 20 2d 73 65 72 76 65 72 20  Address -server 
1230: 5f 5f 61 63 63 65 70 74 5f 5f 20 5c 0a 09 2d 63  __accept__ \..-c
1240: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 63  afile $caCert -c
1250: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43  ertfile $serverC
1260: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65  ert -keyfile $se
1270: 72 76 65 72 4b 65 79 20 5c 0a 09 24 73 65 72 76  rverKey \..$serv
1280: 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 7d 20 7b  erPort]} msg]} {
1290: 0a 20 20 20 20 70 75 74 73 20 22 53 65 72 76 65  .    puts "Serve
12a0: 72 20 6f 6e 20 24 73 65 72 76 65 72 41 64 64 72  r on $serverAddr
12b0: 65 73 73 3a 24 73 65 72 76 65 72 50 6f 72 74 20  ess:$serverPort 
12c0: 63 61 6e 6e 6f 74 20 73 74 61 72 74 3a 20 24 6d  cannot start: $m
12d0: 73 67 22 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20  sg".} else {.   
12e0: 20 76 77 61 69 74 20 5f 5f 73 65 72 76 65 72 5f   vwait __server_
12f0: 77 61 69 74 5f 76 61 72 69 61 62 6c 65 5f 5f 0a  wait_variable__.
1300: 7d 0a                                            }.