Artifact
c3cdab9b3f01401038dce3c69fa7f45bc674c22a
File
modules/devtools/dialog.tcl
— part of check-in
[54433351f5]
at
2009-04-13 22:00:16
on branch trunk
—
* dialog.tcl: Extended to allow dialog over a socket secured by
SSL (via package tls).
(user:
andreas_kupries
size: 7830)
0000: 23 20 2d 2a 2d 20 74 63 6c 20 2d 2a 2d 0a 23 20 # -*- tcl -*-.#
0010: 44 69 61 6c 6f 67 20 2d 20 44 69 61 6c 6f 67 20 Dialog - Dialog
0020: 44 65 6d 6f 6e 20 28 53 65 72 76 65 72 2c 20 6f Demon (Server, o
0030: 72 20 43 6c 69 65 6e 74 29 0a 23 20 43 6f 70 79 r Client).# Copy
0040: 72 69 67 68 74 20 28 63 29 20 32 30 30 34 2c 20 right (c) 2004,
0050: 41 6e 64 72 65 61 73 20 4b 75 70 72 69 65 73 20 Andreas Kupries
0060: 3c 61 6e 64 72 65 61 73 5f 6b 75 70 72 69 65 73 <andreas_kupries
0070: 40 75 73 65 72 73 2e 73 6f 75 72 63 65 66 6f 72 @users.sourcefor
0080: 67 65 2e 6e 65 74 3e 0a 0a 70 75 74 73 20 22 2d ge.net>..puts "-
0090: 20 64 69 61 6c 6f 67 20 28 63 6f 73 65 72 76 2d dialog (coserv-
00a0: 62 61 73 65 64 29 22 0a 0a 23 20 23 23 23 20 23 based)"..# ### #
00b0: 23 23 20 23 23 23 20 23 23 23 23 23 23 23 23 23 ## ### #########
00c0: 20 23 23 23 23 23 23 23 23 23 20 23 23 23 23 23 ######### #####
00d0: 23 23 23 23 0a 23 23 20 43 6f 6d 6d 61 6e 64 73 ####.## Commands
00e0: 20 6f 6e 20 74 6f 70 20 6f 66 20 61 20 70 6c 61 on top of a pla
00f0: 69 6e 20 63 6f 6d 6d 20 73 65 72 76 65 72 2e 0a in comm server..
0100: 23 23 20 41 73 73 75 6d 65 73 20 74 68 61 74 20 ## Assumes that
0110: 74 68 65 20 63 6f 6d 6d 20 73 65 72 76 65 72 20 the comm server
0120: 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 23 23 20 69 environment.## i
0130: 73 20 70 72 65 73 65 6e 74 2e 20 50 72 6f 76 69 s present. Provi
0140: 64 65 73 20 73 65 74 20 75 70 20 61 6e 64 20 65 des set up and e
0150: 78 65 63 75 74 69 6f 6e 0a 23 23 20 6f 66 20 61 xecution.## of a
0160: 20 66 69 78 65 64 20 6c 69 6e 65 61 72 20 64 69 fixed linear di
0170: 61 6c 6f 67 2c 20 64 6f 6e 65 20 66 72 6f 6d 20 alog, done from
0180: 74 68 65 0a 23 20 70 65 72 73 70 65 63 74 69 76 the.# perspectiv
0190: 65 20 6f 66 20 61 20 73 65 72 76 65 72 20 61 70 e of a server ap
01a0: 70 6c 69 63 61 74 69 6f 6e 2e 0a 0a 23 20 23 23 plication...# ##
01b0: 23 20 23 23 23 20 23 23 23 20 23 23 23 23 23 23 # ### ### ######
01c0: 23 23 23 20 23 23 23 23 23 23 23 23 23 20 23 23 ### ######### ##
01d0: 23 23 23 23 23 23 23 0a 23 23 20 4c 6f 61 64 20 #######.## Load
01e0: 22 63 6f 6d 6d 22 20 69 6e 74 6f 20 74 68 65 20 "comm" into the
01f0: 6d 61 73 74 65 72 2e 0a 0a 6e 61 6d 65 73 70 61 master...namespa
0200: 63 65 20 65 76 61 6c 20 3a 3a 64 69 61 6c 6f 67 ce eval ::dialog
0210: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
0220: 64 74 72 61 63 65 20 20 20 20 7b 7d 0a 7d 0a 0a dtrace {}.}..
0230: 23 20 23 23 23 20 23 23 23 20 23 23 23 20 23 23 # ### ### ### ##
0240: 23 23 23 23 23 23 23 20 23 23 23 23 23 23 23 23 ####### ########
0250: 23 20 23 23 23 23 23 23 23 23 23 0a 23 23 20 53 # #########.## S
0260: 74 61 72 74 20 61 20 6e 65 77 20 64 69 61 6c 6f tart a new dialo
0270: 67 20 73 65 72 76 65 72 2e 0a 0a 70 72 6f 63 20 g server...proc
0280: 3a 3a 64 69 61 6c 6f 67 3a 3a 73 65 74 75 70 20 ::dialog::setup
0290: 7b 74 79 70 65 20 63 6f 6f 6b 69 65 20 7b 73 73 {type cookie {ss
02a0: 6c 20 30 7d 7d 20 7b 0a 20 20 20 20 76 61 72 69 l 0}} {. vari
02b0: 61 62 6c 65 20 69 64 0a 20 20 20 20 76 61 72 69 able id. vari
02c0: 61 62 6c 65 20 70 6f 72 74 0a 0a 20 20 20 20 73 able port.. s
02d0: 77 69 74 63 68 20 2d 2d 20 24 74 79 70 65 20 7b witch -- $type {
02e0: 0a 09 73 65 72 76 65 72 20 20 7b 73 65 74 20 73 ..server {set s
02f0: 65 72 76 65 72 20 31 7d 0a 09 63 6c 69 65 6e 74 erver 1}..client
0300: 20 20 7b 73 65 74 20 73 65 72 76 65 72 20 30 7d {set server 0}
0310: 0a 09 64 65 66 61 75 6c 74 20 7b 72 65 74 75 72 ..default {retur
0320: 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 42 n -code error "B
0330: 61 64 20 64 69 61 6c 6f 67 20 74 79 70 65 20 5c ad dialog type \
0340: 22 24 74 79 70 65 5c 22 2c 20 65 78 70 65 63 74 "$type\", expect
0350: 65 64 20 73 65 72 76 65 72 2c 20 6f 72 20 63 6c ed server, or cl
0360: 69 65 6e 74 22 7d 0a 20 20 20 20 7d 0a 0a 20 20 ient"}. }..
0370: 20 20 73 65 74 20 69 64 20 5b 3a 3a 63 6f 73 65 set id [::cose
0380: 72 76 3a 3a 73 74 61 72 74 20 22 24 74 79 70 65 rv::start "$type
0390: 3a 20 24 63 6f 6f 6b 69 65 22 5d 0a 20 20 20 20 : $cookie"].
03a0: 3a 3a 63 6f 73 65 72 76 3a 3a 72 75 6e 20 24 69 ::coserv::run $i
03b0: 64 20 7b 0a 09 73 65 74 20 72 65 73 70 6f 6e 73 d {..set respons
03c0: 65 73 20 7b 7d 0a 09 73 65 74 20 73 74 72 61 63 es {}..set strac
03d0: 65 20 20 20 20 7b 7d 0a 09 73 65 74 20 72 65 63 e {}..set rec
03e0: 65 69 76 65 64 20 20 7b 7d 0a 09 73 65 74 20 63 eived {}..set c
03f0: 6f 6e 6e 20 20 20 20 20 20 7b 7d 0a 09 73 65 74 onn {}..set
0400: 20 69 6c 6f 67 20 20 20 20 20 20 7b 7d 0a 0a 09 ilog {}...
0410: 70 72 6f 63 20 4c 6f 67 20 7b 74 65 78 74 7d 20 proc Log {text}
0420: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 69 6c {.. global il
0430: 6f 67 20 3b 20 6c 61 70 70 65 6e 64 20 69 6c 6f og ; lappend ilo
0440: 67 20 24 74 65 78 74 0a 09 7d 0a 09 70 72 6f 63 g $text..}..proc
0450: 20 53 74 72 61 63 65 20 7b 74 65 78 74 7d 20 7b Strace {text} {
0460: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 74 72 .. global str
0470: 61 63 65 20 3b 20 6c 61 70 70 65 6e 64 20 73 74 ace ; lappend st
0480: 72 61 63 65 20 24 74 65 78 74 0a 09 7d 0a 09 70 race $text..}..p
0490: 72 6f 63 20 45 78 69 74 20 7b 73 6f 63 6b 20 72 roc Exit {sock r
04a0: 65 61 73 6f 6e 7d 20 7b 0a 09 20 20 20 20 53 74 eason} {.. St
04b0: 72 61 63 65 20 24 72 65 61 73 6f 6e 0a 09 20 20 race $reason..
04c0: 20 20 4c 6f 67 20 20 20 20 5b 6c 69 73 74 20 24 Log [list $
04d0: 72 65 61 73 6f 6e 20 24 73 6f 63 6b 5d 0a 09 20 reason $sock]..
04e0: 20 20 20 63 6c 6f 73 65 20 20 24 73 6f 63 6b 0a close $sock.
04f0: 09 20 20 20 20 44 6f 6e 65 0a 09 7d 0a 09 70 72 . Done..}..pr
0500: 6f 63 20 44 6f 6e 65 20 7b 7d 20 7b 0a 09 20 20 oc Done {} {..
0510: 20 20 67 6c 6f 62 61 6c 20 6d 61 69 6e 20 73 74 global main st
0520: 72 61 63 65 20 69 6c 6f 67 0a 09 20 20 20 20 63 race ilog.. c
0530: 6f 6d 6d 3a 3a 63 6f 6d 6d 20 73 65 6e 64 20 24 omm::comm send $
0540: 6d 61 69 6e 20 5b 6c 69 73 74 20 64 69 61 6c 6f main [list dialo
0550: 67 3a 3a 64 6f 6e 65 20 5b 6c 69 73 74 20 24 73 g::done [list $s
0560: 74 72 61 63 65 20 24 69 6c 6f 67 5d 5d 0a 09 20 trace $ilog]]..
0570: 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a 09 70 72 return..}..pr
0580: 6f 63 20 43 6c 65 61 72 54 72 61 63 65 73 20 7b oc ClearTraces {
0590: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
05a0: 73 74 72 61 63 65 20 3b 20 73 65 74 20 73 74 72 strace ; set str
05b0: 61 63 65 20 7b 7d 0a 09 20 20 20 20 67 6c 6f 62 ace {}.. glob
05c0: 61 6c 20 69 6c 6f 67 20 20 20 3b 20 73 65 74 20 al ilog ; set
05d0: 69 6c 6f 67 20 20 20 7b 7d 0a 09 20 20 20 20 72 ilog {}.. r
05e0: 65 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 53 eturn..}..proc S
05f0: 74 65 70 20 7b 73 6f 63 6b 7d 20 7b 0a 09 20 20 tep {sock} {..
0600: 20 20 67 6c 6f 62 61 6c 20 72 65 73 70 6f 6e 73 global respons
0610: 65 73 20 74 72 61 63 65 0a 0a 09 20 20 20 20 69 es trace... i
0620: 66 20 7b 21 5b 6c 6c 65 6e 67 74 68 20 24 72 65 f {![llength $re
0630: 73 70 6f 6e 73 65 73 5d 7d 20 7b 0a 09 09 45 78 sponses]} {...Ex
0640: 69 74 20 24 73 6f 63 6b 20 65 6d 70 74 79 0a 09 it $sock empty..
0650: 09 72 65 74 75 72 6e 0a 09 20 20 20 20 7d 0a 0a .return.. }..
0660: 09 20 20 20 20 73 65 74 20 6e 6f 77 20 20 20 20 . set now
0670: 20 20 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 [lindex $resp
0680: 6f 6e 73 65 73 20 30 5d 0a 09 20 20 20 20 73 65 onses 0].. se
0690: 74 20 72 65 73 70 6f 6e 73 65 73 20 5b 6c 72 61 t responses [lra
06a0: 6e 67 65 20 24 72 65 73 70 6f 6e 73 65 73 20 31 nge $responses 1
06b0: 20 65 6e 64 5d 0a 0a 09 20 20 20 20 4c 6f 67 20 end]... Log
06c0: 20 5b 6c 69 73 74 20 2a 2a 20 24 73 6f 63 6b 20 [list ** $sock
06d0: 24 6e 6f 77 5d 0a 09 20 20 20 20 65 76 61 6c 20 $now].. eval
06e0: 5b 6c 69 6e 73 65 72 74 20 24 6e 6f 77 20 65 6e [linsert $now en
06f0: 64 20 24 73 6f 63 6b 5d 0a 09 20 20 20 20 72 65 d $sock].. re
0700: 74 75 72 6e 0a 09 7d 0a 0a 09 23 20 53 74 65 70 turn..}...# Step
0710: 20 63 6f 6d 6d 61 6e 64 73 20 2e 2e 2e 0a 0a 09 commands ......
0720: 70 72 6f 63 20 2e 43 72 6c 66 20 7b 73 6f 63 6b proc .Crlf {sock
0730: 7d 20 7b 0a 09 20 20 20 20 53 74 72 61 63 65 20 } {.. Strace
0740: 63 72 6c 66 0a 09 20 20 20 20 4c 6f 67 20 63 72 crlf.. Log cr
0750: 6c 66 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 lf.. fconfigu
0760: 72 65 20 24 73 6f 63 6b 20 2d 74 72 61 6e 73 6c re $sock -transl
0770: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 20 20 20 20 ation crlf..
0780: 53 74 65 70 20 24 73 6f 63 6b 0a 09 20 20 20 20 Step $sock..
0790: 72 65 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 return..}..proc
07a0: 2e 42 69 6e 61 72 79 20 7b 73 6f 63 6b 7d 20 7b .Binary {sock} {
07b0: 0a 09 20 20 20 20 53 74 72 61 63 65 20 62 69 6e .. Strace bin
07c0: 0a 09 20 20 20 20 4c 6f 67 20 62 69 6e 61 72 79 .. Log binary
07d0: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
07e0: 20 24 73 6f 63 6b 20 2d 74 72 61 6e 73 6c 61 74 $sock -translat
07f0: 69 6f 6e 20 62 69 6e 61 72 79 0a 09 20 20 20 20 ion binary..
0800: 53 74 65 70 20 24 73 6f 63 6b 0a 09 20 20 20 20 Step $sock..
0810: 72 65 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 return..}..proc
0820: 2e 48 61 6c 74 4b 65 65 70 20 7b 73 6f 63 6b 7d .HaltKeep {sock}
0830: 20 7b 0a 09 20 20 20 20 4c 6f 67 20 68 61 6c 74 {.. Log halt
0840: 2e 6b 65 65 70 0a 09 20 20 20 20 44 6f 6e 65 0a .keep.. Done.
0850: 09 20 20 20 20 67 6c 6f 62 61 6c 20 72 65 73 70 . global resp
0860: 6f 6e 73 65 73 0a 09 20 20 20 20 73 65 74 20 20 onses.. set
0870: 20 20 72 65 73 70 6f 6e 73 65 73 20 7b 7d 0a 09 responses {}..
0880: 20 20 20 20 23 20 4e 6f 20 66 75 72 74 68 65 72 # No further
0890: 20 73 74 65 70 70 69 6e 67 2e 0a 09 20 20 20 20 stepping...
08a0: 23 20 54 68 69 73 20 6b 65 65 70 73 20 74 68 65 # This keeps the
08b0: 20 73 6f 63 6b 65 74 20 6f 70 65 6e 2e 0a 09 20 socket open...
08c0: 20 20 20 23 20 4e 65 65 64 73 20 65 78 74 65 72 # Needs exter
08d0: 6e 61 6c 20 72 65 73 65 74 2f 63 6c 65 61 6e 75 nal reset/cleanu
08e0: 70 0a 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d p.. return..}
08f0: 0a 09 70 72 6f 63 20 2e 53 65 6e 64 20 7b 6c 69 ..proc .Send {li
0900: 6e 65 20 73 6f 63 6b 7d 20 7b 0a 09 20 20 20 20 ne sock} {..
0910: 53 74 72 61 63 65 20 5b 6c 69 73 74 20 3e 3e 20 Strace [list >>
0920: 24 6c 69 6e 65 5d 0a 09 20 20 20 20 4c 6f 67 20 $line].. Log
0930: 20 20 20 5b 6c 69 73 74 20 3e 3e 20 24 6c 69 6e [list >> $lin
0940: 65 5d 0a 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 e]... if {[ca
0950: 74 63 68 20 7b 0a 09 09 70 75 74 73 20 20 24 73 tch {...puts $s
0960: 6f 63 6b 20 24 6c 69 6e 65 0a 09 09 66 6c 75 73 ock $line...flus
0970: 68 20 24 73 6f 63 6b 0a 09 20 20 20 20 7d 20 6d h $sock.. } m
0980: 73 67 5d 7d 20 7b 0a 09 09 45 78 69 74 20 24 73 sg]} {...Exit $s
0990: 6f 63 6b 20 62 72 6f 6b 65 6e 0a 09 09 72 65 74 ock broken...ret
09a0: 75 72 6e 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 urn.. }..
09b0: 53 74 65 70 20 24 73 6f 63 6b 0a 09 20 20 20 20 Step $sock..
09c0: 72 65 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 return..}..proc
09d0: 2e 47 65 76 61 6c 20 7b 73 63 72 69 70 74 20 73 .Geval {script s
09e0: 6f 63 6b 7d 20 7b 0a 09 20 20 20 20 4c 6f 67 20 ock} {.. Log
09f0: 67 65 76 61 6c 0a 09 20 20 20 20 75 70 6c 65 76 geval.. uplev
0a00: 65 6c 20 23 30 20 24 73 63 72 69 70 74 0a 09 20 el #0 $script..
0a10: 20 20 20 53 74 65 70 20 24 73 6f 63 6b 0a 09 20 Step $sock..
0a20: 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a 09 70 72 return..}..pr
0a30: 6f 63 20 2e 45 76 61 6c 20 7b 73 63 72 69 70 74 oc .Eval {script
0a40: 20 73 6f 63 6b 7d 20 7b 0a 09 20 20 20 20 4c 6f sock} {.. Lo
0a50: 67 20 65 76 61 6c 0a 09 20 20 20 20 65 76 61 6c g eval.. eval
0a60: 20 24 73 63 72 69 70 74 0a 09 20 20 20 20 53 74 $script.. St
0a70: 65 70 20 24 73 6f 63 6b 0a 09 20 20 20 20 72 65 ep $sock.. re
0a80: 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 2e 53 turn..}..proc .S
0a90: 65 6e 64 47 76 61 72 20 7b 76 6e 61 6d 65 20 73 endGvar {vname s
0aa0: 6f 63 6b 7d 20 7b 0a 09 20 20 20 20 75 70 76 61 ock} {.. upva
0ab0: 72 20 23 30 20 24 76 6e 61 6d 65 20 6c 69 6e 65 r #0 $vname line
0ac0: 0a 09 20 20 20 20 2e 53 65 6e 64 20 24 6c 69 6e .. .Send $lin
0ad0: 65 20 24 73 6f 63 6b 0a 09 20 20 20 20 72 65 74 e $sock.. ret
0ae0: 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 2e 52 65 urn..}..proc .Re
0af0: 63 65 69 76 65 20 7b 73 6f 63 6b 7d 20 7b 0a 09 ceive {sock} {..
0b00: 20 20 20 20 73 65 74 20 61 69 64 20 20 20 20 20 set aid
0b10: 5b 61 66 74 65 72 20 31 30 30 30 30 20 5b 6c 69 [after 10000 [li
0b20: 73 74 20 54 69 6d 65 6f 75 74 20 20 20 20 24 73 st Timeout $s
0b30: 6f 63 6b 5d 5d 0a 09 20 20 20 20 66 69 6c 65 65 ock]].. filee
0b40: 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 vent $sock reada
0b50: 62 6c 65 20 5b 6c 69 73 74 20 49 6e 70 75 74 20 ble [list Input
0b60: 24 61 69 64 20 24 73 6f 63 6b 5d 0a 09 20 20 20 $aid $sock]..
0b70: 20 23 20 4e 6f 20 22 53 74 65 70 22 20 68 65 72 # No "Step" her
0b80: 65 2e 20 43 6f 6d 65 73 20 74 68 72 6f 75 67 68 e. Comes through
0b90: 20 69 6e 70 75 74 2e 0a 09 20 20 20 20 4c 6f 67 input... Log
0ba0: 20 22 20 20 20 57 61 69 74 69 6e 67 20 20 20 20 " Waiting
0bb0: 5c 5b 24 61 69 64 5c 5d 22 0a 09 20 20 20 20 72 \[$aid\]".. r
0bc0: 65 74 75 72 6e 0a 09 7d 0a 09 70 72 6f 63 20 49 eturn..}..proc I
0bd0: 6e 70 75 74 20 7b 61 69 64 20 73 6f 63 6b 7d 20 nput {aid sock}
0be0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 72 65 {.. global re
0bf0: 63 65 69 76 65 64 0a 09 20 20 20 20 69 66 20 7b ceived.. if {
0c00: 5b 65 6f 66 20 24 73 6f 63 6b 5d 7d 20 7b 0a 09 [eof $sock]} {..
0c10: 09 23 20 43 6c 65 61 6e 20 74 68 65 20 74 69 6d .# Clean the tim
0c20: 65 72 20 75 70 0a 09 09 61 66 74 65 72 20 63 61 er up...after ca
0c30: 6e 63 65 6c 20 24 61 69 64 0a 09 09 45 78 69 74 ncel $aid...Exit
0c40: 20 24 73 6f 63 6b 20 63 6c 6f 73 65 0a 09 09 72 $sock close...r
0c50: 65 74 75 72 6e 0a 09 20 20 20 20 7d 0a 09 20 20 eturn.. }..
0c60: 20 20 69 66 20 7b 5b 67 65 74 73 20 24 73 6f 63 if {[gets $soc
0c70: 6b 20 6c 69 6e 65 5d 20 3c 20 30 7d 20 7b 0a 09 k line] < 0} {..
0c80: 09 4c 6f 67 20 22 20 20 20 2a 2a 7c 2f 2f 2f 2f .Log " **|////
0c90: 7c 2a 2a 22 0a 09 09 72 65 74 75 72 6e 0a 09 20 |**"...return..
0ca0: 20 20 20 7d 0a 0a 09 20 20 20 20 4c 6f 67 20 22 }... Log "
0cb0: 2d 2d 20 2d 76 2d 22 0a 09 20 20 20 20 4c 6f 67 -- -v-".. Log
0cc0: 20 22 20 20 20 45 76 65 6e 74 73 20 6f 66 66 20 " Events off
0cd0: 5c 5b 24 61 69 64 2c 20 24 73 6f 63 6b 5c 5d 22 \[$aid, $sock\]"
0ce0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
0cf0: 20 20 20 24 73 6f 63 6b 20 72 65 61 64 61 62 6c $sock readabl
0d00: 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 e {}.. after
0d10: 63 61 6e 63 65 6c 20 24 61 69 64 0a 0a 09 20 20 cancel $aid...
0d20: 20 20 53 74 72 61 63 65 20 5b 6c 69 73 74 20 3c Strace [list <
0d30: 3c 20 24 6c 69 6e 65 5d 0a 09 20 20 20 20 4c 6f < $line].. Lo
0d40: 67 20 20 20 20 5b 6c 69 73 74 20 3c 3c 20 24 6c g [list << $l
0d50: 69 6e 65 5d 0a 09 20 20 20 20 6c 61 70 70 65 6e ine].. lappen
0d60: 64 20 72 65 63 65 69 76 65 64 20 24 6c 69 6e 65 d received $line
0d70: 0a 0a 09 20 20 20 20 23 20 4e 6f 77 20 77 65 20 ... # Now we
0d80: 63 61 6e 20 73 74 65 70 20 66 75 72 74 68 65 72 can step further
0d90: 0a 09 20 20 20 20 53 74 65 70 20 24 73 6f 63 6b .. Step $sock
0da0: 0a 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a .. return..}.
0db0: 09 70 72 6f 63 20 54 69 6d 65 6f 75 74 20 7b 73 .proc Timeout {s
0dc0: 6f 63 6b 7d 20 7b 0a 09 20 20 20 20 45 78 69 74 ock} {.. Exit
0dd0: 20 24 73 6f 63 6b 20 74 69 6d 65 6f 75 74 0a 09 $sock timeout..
0de0: 20 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a 09 70 return..}..p
0df0: 72 6f 63 20 41 63 63 65 70 74 20 7b 73 6f 63 6b roc Accept {sock
0e00: 20 68 6f 73 74 20 70 6f 72 74 7d 20 7b 0a 09 20 host port} {..
0e10: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
0e20: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ock -blocking 0.
0e30: 09 20 20 20 20 43 6c 65 61 72 54 72 61 63 65 73 . ClearTraces
0e40: 0a 09 20 20 20 20 53 74 65 70 20 24 73 6f 63 6b .. Step $sock
0e50: 0a 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d 0a .. return..}.
0e60: 0a 09 70 72 6f 63 20 53 65 72 76 65 72 20 7b 7d ..proc Server {}
0e70: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 70 {.. global p
0e80: 6f 72 74 0a 09 20 20 20 20 23 20 53 74 61 72 74 ort.. # Start
0e90: 20 6c 69 73 74 65 6e 65 72 20 66 6f 72 20 64 69 listener for di
0ea0: 61 6c 6f 67 0a 09 20 20 20 20 73 65 74 20 6c 69 alog.. set li
0eb0: 73 74 65 6e 65 72 20 5b 73 6f 63 6b 65 74 20 2d stener [socket -
0ec0: 73 65 72 76 65 72 20 41 63 63 65 70 74 20 30 5d server Accept 0]
0ed0: 0a 09 20 20 20 20 73 65 74 20 70 6f 72 74 20 20 .. set port
0ee0: 20 20 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e [lindex [fcon
0ef0: 66 69 67 75 72 65 20 24 6c 69 73 74 65 6e 65 72 figure $listener
0f00: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 0a 09 -sockname] 2]..
0f10: 20 20 20 20 23 20 69 6d 70 6c 69 65 64 20 72 65 # implied re
0f20: 74 75 72 6e 20 6f 66 20 3c 70 6f 72 74 3e 0a 09 turn of <port>..
0f30: 7d 0a 0a 09 70 72 6f 63 20 43 6c 69 65 6e 74 20 }...proc Client
0f40: 7b 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c {port} {.. gl
0f50: 6f 62 61 6c 20 63 6f 6e 6e 0a 09 20 20 20 20 63 obal conn.. c
0f60: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6e atch {close $con
0f70: 6e 7d 0a 0a 09 20 20 20 20 73 65 74 20 63 6f 6e n}... set con
0f80: 6e 20 5b 73 65 74 20 73 6f 63 6b 20 5b 73 6f 63 n [set sock [soc
0f90: 6b 65 74 20 6c 6f 63 61 6c 68 6f 73 74 20 24 70 ket localhost $p
0fa0: 6f 72 74 5d 5d 0a 09 20 20 20 20 66 63 6f 6e 66 ort]].. fconf
0fb0: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
0fc0: 63 6b 69 6e 67 20 30 0a 09 20 20 20 20 43 6c 65 cking 0.. Cle
0fd0: 61 72 54 72 61 63 65 73 0a 09 20 20 20 20 4c 6f arTraces.. Lo
0fe0: 67 20 5b 6c 69 73 74 20 43 6c 69 65 6e 74 20 40 g [list Client @
0ff0: 20 24 70 6f 72 74 20 3d 20 24 73 6f 63 6b 5d 0a $port = $sock].
1000: 09 20 20 20 20 4c 6f 67 20 5b 6c 69 73 74 20 43 . Log [list C
1010: 68 61 6e 6e 65 6c 73 20 24 70 6f 72 74 20 3d 20 hannels $port =
1020: 5b 6c 73 6f 72 74 20 5b 66 69 6c 65 20 63 68 61 [lsort [file cha
1030: 6e 6e 65 6c 73 5d 5d 5d 0a 09 20 20 20 20 53 74 nnels]]].. St
1040: 65 70 20 24 73 6f 63 6b 0a 09 20 20 20 20 72 65 ep $sock.. re
1050: 74 75 72 6e 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 turn..}. }..
1060: 20 20 20 69 66 20 7b 24 73 73 6c 7d 20 7b 0a 09 if {$ssl} {..
1070: 23 20 52 65 70 6c 61 63 65 20 76 61 72 69 6f 75 # Replace variou
1080: 73 20 63 6f 6d 6d 61 6e 64 73 20 77 69 74 68 20 s commands with
1090: 74 6c 73 20 61 77 61 72 65 20 76 61 72 69 61 6e tls aware varian
10a0: 74 73 0a 09 63 6f 73 65 72 76 3a 3a 72 75 6e 20 ts..coserv::run
10b0: 24 69 64 20 5b 6c 69 73 74 20 73 65 74 20 64 65 $id [list set de
10c0: 76 74 6f 6f 6c 73 20 5b 74 63 6c 6c 69 62 50 61 vtools [tcllibPa
10d0: 74 68 20 64 65 76 74 6f 6f 6c 73 5d 5d 0a 09 63 th devtools]]..c
10e0: 6f 73 65 72 76 3a 3a 72 75 6e 20 24 69 64 20 7b oserv::run $id {
10f0: 0a 09 20 20 20 20 70 61 63 6b 61 67 65 20 72 65 .. package re
1100: 71 75 69 72 65 20 74 6c 73 0a 0a 09 20 20 20 20 quire tls...
1110: 74 6c 73 3a 3a 69 6e 69 74 20 5c 0a 09 09 2d 6b tls::init \...-k
1120: 65 79 66 69 6c 65 20 20 24 64 65 76 74 6f 6f 6c eyfile $devtool
1130: 73 2f 74 72 61 6e 73 6d 69 74 74 65 72 2e 6b 65 s/transmitter.ke
1140: 79 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 y \...-certfile
1150: 24 64 65 76 74 6f 6f 6c 73 2f 74 72 61 6e 73 6d $devtools/transm
1160: 69 74 74 65 72 2e 63 72 74 20 5c 0a 09 09 2d 63 itter.crt \...-c
1170: 61 66 69 6c 65 20 20 20 24 64 65 76 74 6f 6f 6c afile $devtool
1180: 73 2f 63 61 2e 63 72 74 20 5c 0a 09 09 2d 73 73 s/ca.crt \...-ss
1190: 6c 32 20 31 20 20 20 20 5c 0a 09 09 2d 73 73 6c l2 1 \...-ssl
11a0: 33 20 31 20 20 20 20 5c 0a 09 09 2d 74 6c 73 31 3 1 \...-tls1
11b0: 20 30 20 20 20 20 5c 0a 09 09 2d 72 65 71 75 69 0 \...-requi
11c0: 72 65 20 31 0a 0a 09 20 20 20 20 70 72 6f 63 20 re 1... proc
11d0: 53 65 72 76 65 72 20 7b 7d 20 7b 0a 09 09 67 6c Server {} {...gl
11e0: 6f 62 61 6c 20 70 6f 72 74 0a 09 09 23 20 53 74 obal port...# St
11f0: 61 72 74 20 6c 69 73 74 65 6e 65 72 20 66 6f 72 art listener for
1200: 20 64 69 61 6c 6f 67 0a 09 09 73 65 74 20 6c 69 dialog...set li
1210: 73 74 65 6e 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 stener [tls::soc
1220: 6b 65 74 20 2d 73 65 72 76 65 72 20 41 63 63 65 ket -server Acce
1230: 70 74 20 30 5d 0a 09 09 73 65 74 20 70 6f 72 74 pt 0]...set port
1240: 20 20 20 20 20 5b 6c 69 6e 64 65 78 20 5b 66 63 [lindex [fc
1250: 6f 6e 66 69 67 75 72 65 20 24 6c 69 73 74 65 6e onfigure $listen
1260: 65 72 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d er -sockname] 2]
1270: 0a 09 09 23 20 69 6d 70 6c 69 65 64 20 72 65 74 ...# implied ret
1280: 75 72 6e 20 6f 66 20 3c 70 6f 72 74 3e 0a 09 20 urn of <port>..
1290: 20 20 20 7d 0a 0a 09 20 20 20 20 70 72 6f 63 20 }... proc
12a0: 43 6c 69 65 6e 74 20 7b 70 6f 72 74 7d 20 7b 0a Client {port} {.
12b0: 09 09 67 6c 6f 62 61 6c 20 63 6f 6e 6e 0a 09 09 ..global conn...
12c0: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f catch {close $co
12d0: 6e 6e 7d 0a 0a 09 09 73 65 74 20 63 6f 6e 6e 20 nn}....set conn
12e0: 5b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a [set sock [tls::
12f0: 73 6f 63 6b 65 74 20 6c 6f 63 61 6c 68 6f 73 74 socket localhost
1300: 20 24 70 6f 72 74 5d 5d 0a 09 09 66 63 6f 6e 66 $port]]...fconf
1310: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
1320: 63 6b 69 6e 67 20 30 0a 09 09 43 6c 65 61 72 54 cking 0...ClearT
1330: 72 61 63 65 73 0a 09 09 4c 6f 67 20 5b 6c 69 73 races...Log [lis
1340: 74 20 43 6c 69 65 6e 74 20 40 20 24 70 6f 72 74 t Client @ $port
1350: 20 3d 20 24 73 6f 63 6b 5d 0a 09 09 4c 6f 67 20 = $sock]...Log
1360: 5b 6c 69 73 74 20 43 68 61 6e 6e 65 6c 73 20 24 [list Channels $
1370: 70 6f 72 74 20 3d 20 5b 6c 73 6f 72 74 20 5b 66 port = [lsort [f
1380: 69 6c 65 20 63 68 61 6e 6e 65 6c 73 5d 5d 5d 0a ile channels]]].
1390: 09 09 53 74 65 70 20 24 73 6f 63 6b 0a 09 09 72 ..Step $sock...r
13a0: 65 74 75 72 6e 0a 09 20 20 20 20 7d 0a 09 7d 0a eturn.. }..}.
13b0: 20 20 20 20 7d 0a 0a 20 20 20 20 69 66 20 7b 24 }.. if {$
13c0: 73 65 72 76 65 72 7d 20 7b 0a 09 73 65 74 20 70 server} {..set p
13d0: 6f 72 74 20 5b 63 6f 73 65 72 76 3a 3a 72 75 6e ort [coserv::run
13e0: 20 24 69 64 20 7b 53 65 72 76 65 72 7d 5d 0a 20 $id {Server}].
13f0: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 }.}..proc ::d
1400: 69 61 6c 6f 67 3a 3a 72 75 6e 63 6c 69 65 6e 74 ialog::runclient
1410: 20 7b 70 6f 72 74 7d 20 7b 0a 20 20 20 20 76 61 {port} {. va
1420: 72 69 61 62 6c 65 20 69 64 0a 20 20 20 20 76 61 riable id. va
1430: 72 69 61 62 6c 65 20 64 74 72 61 63 65 20 7b 7d riable dtrace {}
1440: 0a 20 20 20 20 63 6f 73 65 72 76 3a 3a 74 61 73 . coserv::tas
1450: 6b 20 24 69 64 20 5b 6c 69 73 74 20 43 6c 69 65 k $id [list Clie
1460: 6e 74 20 24 70 6f 72 74 5d 0a 20 20 20 20 72 65 nt $port]. re
1470: 74 75 72 6e 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 turn.}..proc ::d
1480: 69 61 6c 6f 67 3a 3a 64 69 61 6c 6f 67 5f 73 65 ialog::dialog_se
1490: 74 20 7b 72 65 73 70 6f 6e 73 65 5f 73 63 72 69 t {response_scri
14a0: 70 74 7d 20 7b 0a 20 20 20 20 62 65 67 69 6e 0a pt} {. begin.
14b0: 20 20 20 20 75 70 6c 65 76 65 6c 20 31 20 24 72 uplevel 1 $r
14c0: 65 73 70 6f 6e 73 65 5f 73 63 72 69 70 74 0a 20 esponse_script.
14d0: 20 20 20 65 6e 64 0a 20 20 20 20 72 65 74 75 72 end. retur
14e0: 6e 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 61 6c n.}..proc ::dial
14f0: 6f 67 3a 3a 62 65 67 69 6e 20 7b 7b 63 6f 6f 6b og::begin {{cook
1500: 69 65 20 7b 7d 7d 7d 20 7b 0a 20 20 20 20 76 61 ie {}}} {. va
1510: 72 69 61 62 6c 65 20 69 64 0a 20 20 20 20 3a 3a riable id. ::
1520: 63 6f 73 65 72 76 3a 3a 74 61 73 6b 20 24 69 64 coserv::task $id
1530: 20 5b 6c 69 73 74 20 73 65 74 20 72 65 73 70 6f [list set respo
1540: 6e 73 65 73 20 7b 7d 5d 0a 20 20 20 20 6c 6f 67 nses {}]. log
1550: 3a 3a 6c 6f 67 20 64 65 62 75 67 20 22 2b 3d 3d ::log debug "+==
1560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 20 24 63 6f 6f 6b ========== $cook
1590: 69 65 20 5c 5c 5c 5c 22 0a 20 20 20 20 72 65 74 ie \\\\". ret
15a0: 75 72 6e 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 urn.}..proc ::di
15b0: 61 6c 6f 67 3a 3a 63 6d 64 20 7b 63 6f 6d 6d 61 alog::cmd {comma
15c0: 6e 64 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 nd} {. variab
15d0: 6c 65 20 69 64 0a 20 20 20 20 3a 3a 63 6f 73 65 le id. ::cose
15e0: 72 76 3a 3a 74 61 73 6b 20 24 69 64 20 5b 6c 69 rv::task $id [li
15f0: 73 74 20 6c 61 70 70 65 6e 64 20 72 65 73 70 6f st lappend respo
1600: 6e 73 65 73 20 24 63 6f 6d 6d 61 6e 64 5d 0a 20 nses $command].
1610: 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 70 72 6f return.}..pro
1620: 63 20 3a 3a 64 69 61 6c 6f 67 3a 3a 65 6e 64 20 c ::dialog::end
1630: 7b 7d 20 7b 0a 20 20 20 20 23 20 54 68 69 73 20 {} {. # This
1640: 69 6d 70 6c 69 63 69 74 6c 79 20 77 61 69 74 73 implicitly waits
1650: 20 66 6f 72 20 61 6c 6c 20 70 72 65 63 65 64 69 for all precedi
1660: 6e 67 20 63 6f 6d 6d 61 6e 64 73 20 28 77 68 69 ng commands (whi
1670: 63 68 20 61 72 65 20 61 73 79 6e 63 29 20 74 6f ch are async) to
1680: 20 63 6f 6d 70 6c 65 74 65 2e 0a 20 20 20 20 76 complete.. v
1690: 61 72 69 61 62 6c 65 20 69 64 0a 20 20 20 20 73 ariable id. s
16a0: 65 74 20 72 65 73 70 6f 6e 73 65 73 20 5b 3a 3a et responses [::
16b0: 63 6f 73 65 72 76 3a 3a 72 75 6e 20 24 69 64 20 coserv::run $id
16c0: 5b 6c 69 73 74 20 73 65 74 20 72 65 73 70 6f 6e [list set respon
16d0: 73 65 73 5d 5d 0a 20 20 20 20 3a 3a 63 6f 73 65 ses]]. ::cose
16e0: 72 76 3a 3a 72 75 6e 20 24 69 64 20 7b 73 65 74 rv::run $id {set
16f0: 20 72 65 63 65 69 76 65 64 20 7b 7d 7d 0a 20 20 received {}}.
1700: 20 20 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 75 67 log::log debug
1710: 20 7c 5c 74 5b 6a 6f 69 6e 20 24 72 65 73 70 6f |\t[join $respo
1720: 6e 73 65 73 20 5c 6e 7c 5c 74 5d 0a 20 20 20 20 nses \n|\t].
1730: 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 75 67 20 2b log::log debug +
1740: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1750: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1760: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 20 20 -------------.
1770: 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 70 72 6f 63 return.}..proc
1780: 20 3a 3a 64 69 61 6c 6f 67 3a 3a 63 72 6c 66 2e ::dialog::crlf.
1790: 20 20 20 20 20 20 7b 7d 20 20 20 20 20 20 20 7b {} {
17a0: 63 6d 64 20 2e 43 72 6c 66 7d 0a 70 72 6f 63 20 cmd .Crlf}.proc
17b0: 3a 3a 64 69 61 6c 6f 67 3a 3a 62 69 6e 61 72 79 ::dialog::binary
17c0: 2e 20 20 20 20 7b 7d 20 20 20 20 20 20 20 7b 63 . {} {c
17d0: 6d 64 20 2e 42 69 6e 61 72 79 7d 0a 70 72 6f 63 md .Binary}.proc
17e0: 20 3a 3a 64 69 61 6c 6f 67 3a 3a 73 65 6e 64 2e ::dialog::send.
17f0: 20 20 20 20 20 20 7b 6c 69 6e 65 7d 20 20 20 7b {line} {
1800: 63 6d 64 20 5b 6c 69 73 74 20 2e 53 65 6e 64 20 cmd [list .Send
1810: 24 6c 69 6e 65 5d 7d 0a 70 72 6f 63 20 3a 3a 64 $line]}.proc ::d
1820: 69 61 6c 6f 67 3a 3a 72 65 63 65 69 76 65 2e 20 ialog::receive.
1830: 20 20 7b 7d 20 20 20 20 20 20 20 7b 63 6d 64 20 {} {cmd
1840: 2e 52 65 63 65 69 76 65 7d 0a 70 72 6f 63 20 3a .Receive}.proc :
1850: 3a 64 69 61 6c 6f 67 3a 3a 72 65 73 70 6f 6e 64 :dialog::respond
1860: 2e 20 20 20 7b 6c 69 6e 65 7d 20 20 20 7b 72 65 . {line} {re
1870: 63 65 69 76 65 2e 20 3b 20 73 65 6e 64 2e 20 24 ceive. ; send. $
1880: 6c 69 6e 65 7d 0a 70 72 6f 63 20 3a 3a 64 69 61 line}.proc ::dia
1890: 6c 6f 67 3a 3a 72 65 71 75 65 73 74 2e 20 20 20 log::request.
18a0: 7b 6c 69 6e 65 7d 20 20 20 7b 73 65 6e 64 2e 20 {line} {send.
18b0: 24 6c 69 6e 65 20 3b 20 72 65 63 65 69 76 65 2e $line ; receive.
18c0: 7d 0a 70 72 6f 63 20 3a 3a 64 69 61 6c 6f 67 3a }.proc ::dialog:
18d0: 3a 68 61 6c 74 2e 6b 65 65 70 2e 20 7b 7d 20 20 :halt.keep. {}
18e0: 20 20 20 20 20 7b 63 6d 64 20 2e 48 61 6c 74 4b {cmd .HaltK
18f0: 65 65 70 7d 0a 70 72 6f 63 20 3a 3a 64 69 61 6c eep}.proc ::dial
1900: 6f 67 3a 3a 73 65 6e 64 67 76 61 72 2e 20 20 7b og::sendgvar. {
1910: 76 6e 61 6d 65 7d 20 20 7b 63 6d 64 20 5b 6c 69 vname} {cmd [li
1920: 73 74 20 2e 53 65 6e 64 47 76 61 72 20 24 76 6e st .SendGvar $vn
1930: 61 6d 65 5d 7d 0a 70 72 6f 63 20 3a 3a 64 69 61 ame]}.proc ::dia
1940: 6c 6f 67 3a 3a 72 65 71 67 76 61 72 2e 20 20 20 log::reqgvar.
1950: 7b 76 6e 61 6d 65 7d 20 20 7b 73 65 6e 64 67 76 {vname} {sendgv
1960: 61 72 2e 20 24 76 6e 61 6d 65 20 3b 20 72 65 63 ar. $vname ; rec
1970: 65 69 76 65 2e 7d 0a 70 72 6f 63 20 3a 3a 64 69 eive.}.proc ::di
1980: 61 6c 6f 67 3a 3a 67 65 76 61 6c 2e 20 20 20 20 alog::geval.
1990: 20 7b 73 63 72 69 70 74 7d 20 7b 63 6d 64 20 5b {script} {cmd [
19a0: 6c 69 73 74 20 2e 47 65 76 61 6c 20 24 73 63 72 list .Geval $scr
19b0: 69 70 74 5d 7d 0a 70 72 6f 63 20 3a 3a 64 69 61 ipt]}.proc ::dia
19c0: 6c 6f 67 3a 3a 65 76 61 6c 2e 20 20 20 20 20 20 log::eval.
19d0: 7b 73 63 72 69 70 74 7d 20 7b 63 6d 64 20 5b 6c {script} {cmd [l
19e0: 69 73 74 20 2e 45 76 61 6c 20 20 24 73 63 72 69 ist .Eval $scri
19f0: 70 74 5d 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 61 pt]}..proc ::dia
1a00: 6c 6f 67 3a 3a 64 6f 6e 65 20 7b 74 72 61 63 65 log::done {trace
1a10: 73 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c s} {. variabl
1a20: 65 20 64 74 72 61 63 65 20 24 74 72 61 63 65 73 e dtrace $traces
1a30: 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 70 . return.}..p
1a40: 72 6f 63 20 3a 3a 64 69 61 6c 6f 67 3a 3a 77 61 roc ::dialog::wa
1a50: 69 74 64 6f 6e 65 20 7b 7d 20 7b 0a 20 20 20 20 itdone {} {.
1a60: 76 61 72 69 61 62 6c 65 20 64 74 72 61 63 65 0a variable dtrace.
1a70: 0a 20 20 20 20 23 20 4c 6f 6f 70 20 75 6e 74 69 . # Loop unti
1a80: 6c 20 77 65 20 68 61 76 65 20 64 61 74 61 20 66 l we have data f
1a90: 72 6f 6d 20 74 68 65 20 64 69 61 6c 6f 67 20 73 rom the dialog s
1aa0: 75 62 70 72 6f 63 65 73 73 2e 0a 20 20 20 20 23 ubprocess.. #
1ab0: 20 49 4f 57 20 77 72 69 74 65 73 20 77 68 69 63 IOW writes whic
1ac0: 68 20 64 6f 20 6e 6f 74 20 63 72 65 61 74 65 20 h do not create
1ad0: 64 61 74 61 20 61 72 65 20 69 67 6e 6f 72 65 64 data are ignored
1ae0: 2e 0a 20 20 20 20 77 68 69 6c 65 20 7b 21 5b 6c .. while {![l
1af0: 6c 65 6e 67 74 68 20 24 64 74 72 61 63 65 5d 7d length $dtrace]}
1b00: 20 7b 0a 09 76 77 61 69 74 20 3a 3a 64 69 61 6c {..vwait ::dial
1b10: 6f 67 3a 3a 64 74 72 61 63 65 0a 20 20 20 20 7d og::dtrace. }
1b20: 0a 0a 20 20 20 20 66 6f 72 65 61 63 68 20 7b 73 .. foreach {s
1b30: 74 72 61 63 65 20 69 6c 6f 67 7d 20 24 64 74 72 trace ilog} $dtr
1b40: 61 63 65 20 62 72 65 61 6b 0a 20 20 20 20 73 65 ace break. se
1b50: 74 20 64 74 72 61 63 65 20 7b 7d 0a 0a 20 20 20 t dtrace {}..
1b60: 20 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 75 67 20 log::log debug
1b70: 20 2b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d +--------------
1b80: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1b90: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a ---------------.
1ba0: 20 20 20 20 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 log::log deb
1bb0: 75 67 20 20 7c 5c 74 5b 6a 6f 69 6e 20 24 73 74 ug |\t[join $st
1bc0: 72 61 63 65 20 5c 6e 7c 5c 74 5d 0a 20 20 20 20 race \n|\t].
1bd0: 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 75 67 20 20 log::log debug
1be0: 2b 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d +---------------
1bf0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
1c00: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 20 --------------.
1c10: 20 20 20 6c 6f 67 3a 3a 6c 6f 67 20 64 65 62 75 log::log debu
1c20: 67 20 20 2f 5c 74 5b 6a 6f 69 6e 20 24 69 6c 6f g /\t[join $ilo
1c30: 67 20 5c 6e 2f 5c 74 5d 0a 20 20 20 20 6c 6f 67 g \n/\t]. log
1c40: 3a 3a 6c 6f 67 20 64 65 62 75 67 20 22 2b 3d 3d ::log debug "+==
1c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 20 2f 2f 22 0a 20 ========== //".
1c80: 20 20 20 72 65 74 75 72 6e 20 24 73 74 72 61 63 return $strac
1c90: 65 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 61 6c e.}..proc ::dial
1ca0: 6f 67 3a 3a 72 65 63 65 69 76 65 64 20 7b 7d 20 og::received {}
1cb0: 7b 0a 20 20 20 20 23 20 57 61 69 74 20 66 6f 72 {. # Wait for
1cc0: 20 61 6c 6c 20 70 72 65 63 65 64 69 6e 67 20 63 all preceding c
1cd0: 6f 6d 6d 61 6e 64 73 20 74 6f 20 63 6f 6d 70 6c ommands to compl
1ce0: 65 74 65 2e 0a 20 20 20 20 76 61 72 69 61 62 6c ete.. variabl
1cf0: 65 20 69 64 0a 20 20 20 20 73 65 74 20 72 65 63 e id. set rec
1d00: 65 69 76 65 64 20 5b 3a 3a 63 6f 73 65 72 76 3a eived [::coserv:
1d10: 3a 72 75 6e 20 24 69 64 20 5b 6c 69 73 74 20 73 :run $id [list s
1d20: 65 74 20 72 65 63 65 69 76 65 64 5d 5d 0a 20 20 et received]].
1d30: 20 20 3a 3a 63 6f 73 65 72 76 3a 3a 72 75 6e 20 ::coserv::run
1d40: 24 69 64 20 5b 6c 69 73 74 20 73 65 74 20 72 65 $id [list set re
1d50: 63 65 69 76 65 64 20 7b 7d 5d 0a 20 20 20 20 72 ceived {}]. r
1d60: 65 74 75 72 6e 20 24 72 65 63 65 69 76 65 64 0a eturn $received.
1d70: 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 61 6c 6f 67 }..proc ::dialog
1d80: 3a 3a 6c 69 73 74 65 6e 65 72 20 7b 7d 20 7b 0a ::listener {} {.
1d90: 20 20 20 20 76 61 72 69 61 62 6c 65 20 70 6f 72 variable por
1da0: 74 0a 20 20 20 20 72 65 74 75 72 6e 20 24 70 6f t. return $po
1db0: 72 74 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 64 69 61 rt.}..proc ::dia
1dc0: 6c 6f 67 3a 3a 73 68 75 74 64 6f 77 6e 20 7b 7d log::shutdown {}
1dd0: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
1de0: 69 64 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 id. variable
1df0: 70 6f 72 74 0a 20 20 20 20 76 61 72 69 61 62 6c port. variabl
1e00: 65 20 64 74 72 61 63 65 0a 0a 20 20 20 20 3a 3a e dtrace.. ::
1e10: 63 6f 73 65 72 76 3a 3a 73 68 75 74 64 6f 77 6e coserv::shutdown
1e20: 20 24 69 64 0a 0a 20 20 20 20 73 65 74 20 69 64 $id.. set id
1e30: 20 20 20 20 20 7b 7d 0a 20 20 20 20 73 65 74 20 {}. set
1e40: 70 6f 72 74 20 20 20 7b 7d 0a 20 20 20 20 73 65 port {}. se
1e50: 74 20 64 74 72 61 63 65 20 7b 7d 0a 20 20 20 20 t dtrace {}.
1e60: 72 65 74 75 72 6e 0a 7d 0a 0a 23 20 23 23 23 20 return.}..# ###
1e70: 23 23 23 20 23 23 23 20 23 23 23 23 23 23 23 23 ### ### ########
1e80: 23 20 23 23 23 23 23 23 23 23 23 20 23 23 23 23 # ######### ####
1e90: 23 23 23 23 23 0a #####.
