source: trunk/p2p/test.tcl @ 1723

Last change on this file since 1723 was 1273, checked in by mmc, 14 years ago

Major reorganization of p2p code, and support for solicit/proffer
messages.

File size: 22.2 KB
Line 
1# ----------------------------------------------------------------------
2#  TEST HARNESS for the P2P infrastructure
3#
4#  This script drives the test setup and visualization for the P2P
5#  infrastructure.  It launches the authority server(s) and various
6#  workers, and helps to visualize their interactions.
7# ----------------------------------------------------------------------
8#  Michael McLennan (mmclennan@purdue.edu)
9# ======================================================================
10#  Copyright (c) 2008  Purdue Research Foundation
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itcl
16
17# recognize other library files in this same directory
18set dir [file dirname [info script]]
19lappend auto_path $dir
20
21set time0 [clock seconds]
22set processes ""
23set nodes(all) ""
24set nodeRadius 15
25
26option add *highlightBackground [. cget -background]
27option add *client*background gray
28option add *client*highlightBackground gray
29option add *client*troughColor darkGray
30
31# ======================================================================
32#  SHAPES
33# ======================================================================
34itcl::class Shape {
35    private variable _canvas ""      ;# shape sits on this canvas
36    private variable _ranges ""      ;# list of time ranges for shape
37    private common _shapesOnCanvas   ;# maps canvas => list of shapes
38
39    public variable command ""  ;# command template used to create shape
40
41    constructor {canvas args} {
42        # add this shape to the list of shapes on this canvas
43        lappend _shapesOnCanvas($canvas) $this
44        set _canvas $canvas
45        eval configure $args
46    }
47    destructor {
48        # remove this shape from the list of shapes on the canvas
49        set i [lsearch $_shapesOnCanvas($_canvas) $this]
50        if {$i >= 0} {
51            set _shapesOnCanvas($_canvas) \
52                [lreplace $_shapesOnCanvas($_canvas) $i $i]
53        }
54    }
55
56    # ------------------------------------------------------------------
57    #  METHOD: addRange <time0> <time1>
58    #  Declares that this shape exists during the given time range
59    #  between <time0> and <time1>.
60    # ------------------------------------------------------------------
61    public method addRange {t0 t1} {
62        # see if there's any overlap with existing ranges
63        set ri0 -1
64        set ri1 -1
65        for {set i 0} {$i < [llength $_ranges]} {incr i} {
66            set pair [lindex $_ranges $i]
67            foreach {r0 r1} $pair break
68            if {$r0 >= $t0 && $r0 <= $t1} {
69                set ri0 $i
70            }
71            if {$r1 >= $t0 && $r1 <= $t1} {
72                set ri1 $i
73            }
74            incr i
75        }
76
77        if {$ri0 < 0 && $ri1 < 1} {
78            # doesn't overlap with anything -- insert in right place
79            for {set i 0} {$i < [llength $_ranges]} {incr i} {
80                set pair [lindex $_ranges $i]
81                foreach {r0 r1} $pair break
82                if {$t0 < $r0} break
83            }
84            set _ranges [linsert $_ranges $i [list $t0 $t1]]
85        } elseif {$ri0 >= 0 && $ri1 >= 0} {
86            # overlaps on both limits -- bridge the middle part
87            set r0 [lindex [lindex $_ranges $ri0] 0]
88            set r1 [lindex [lindex $_ranges $ri1] 1]
89            set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
90        } elseif {$ri0 >= 0} {
91            # overlaps on the lower limit
92            for {set i [expr {[llength $_ranges]-1}]} {$i >= 0} {incr i -1} {
93                set pair [lindex $_ranges $i]
94                foreach {r0 r1} $pair break
95                if {$r0 > $t0 && $r1 < $t1} {
96                    # remove any ranges completely contained in this one
97                    set _ranges [lreplace $_ranges $i $i]
98                }
99                set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
100            }
101            set pair [lindex $_ranges $ri0]
102            foreach {r0 r1} $pair break
103            set _ranges [lreplace $_ranges $ri0 $ri0 [list $r0 $t1]]
104        } else {
105            # overlaps on the upper limit
106            for {set i [expr {[llength $_ranges]-1}]} {$i >= 0} {incr i -1} {
107                set pair [lindex $_ranges $i]
108                foreach {r0 r1} $pair break
109                if {$r0 > $t0 && $r1 < $t1} {
110                    # remove any ranges completely contained in this one
111                    set _ranges [lreplace $_ranges $i $i]
112                }
113                set _ranges [lreplace $_ranges $ri0 $ri1 [list $r0 $r1]]
114            }
115            set pair [lindex $_ranges $ri1]
116            foreach {r0 r1} $pair break
117            set _ranges [lreplace $_ranges $ri1 $ri1 [list $t0 $r1]]
118        }
119    }
120
121    # ------------------------------------------------------------------
122    #  METHOD: exists <time>
123    #  Checks to see if this shape exists at the given <time>.
124    #  Returns 1 if so, and 0 otherwise.
125    # ------------------------------------------------------------------
126    public method exists {t} {
127        for {set i 0} {$i < [llength $_ranges]} {incr i} {
128            set pair [lindex $_ranges $i]
129            foreach {r0 r1} $pair break
130            if {$t >= $r0 && $t <= $r1} {
131                return 1
132            }
133        }
134        return 0
135    }
136
137    # ------------------------------------------------------------------
138    #  PROC: draw <canvas> <time>
139    #  Finds the list of shapes that exist on the given <canvas> at
140    #  the specified time, and executes all of their associated
141    #  -command templates, adding them to the canvas.
142    # ------------------------------------------------------------------
143    public proc draw {canvas time} {
144        if {[info exists _shapesOnCanvas($canvas)]} {
145            foreach obj $_shapesOnCanvas($canvas) {
146                if {[$obj exists $time]} {
147                    set cmd [$obj cget -command]
148                    regsub -all %c $cmd $canvas cmd
149                    eval $cmd
150                }
151            }
152        }
153    }
154
155    # ------------------------------------------------------------------
156    #  PROC: clear <canvas>
157    #  Removes all shapes associated with the specified <canvas>.
158    # ------------------------------------------------------------------
159    public proc clear {canvas} {
160        if {[info exists _shapesOnCanvas($canvas)]} {
161            eval itcl::delete object $_shapesOnCanvas($canvas)
162        }
163    }
164}
165
166# ======================================================================
167#  Build the main interface
168# ======================================================================
169frame .client -borderwidth 8 -relief flat
170pack .client -side right -fill y
171button .client.getbids -text "Get Bids:" -command test_bids
172pack .client.getbids -side top -anchor w
173frame .client.cntls
174pack .client.cntls -side bottom -fill x
175button .client.cntls.run -text "Spend" -command test_spend
176pack .client.cntls.run -side left
177entry .client.cntls.points -width 8
178pack .client.cntls.points -side left
179label .client.cntls.pointsl -text "points"
180pack .client.cntls.pointsl -side left
181
182frame .client.bids
183pack .client.bids -side bottom -expand yes -fill both
184scrollbar .client.bids.ysbar -orient vertical -command {.client.bids.info yview}
185pack .client.bids.ysbar -side right -fill y
186listbox .client.bids.info -yscrollcommand {.client.bids.ysbar set}
187pack .client.bids.info -side left -expand yes -fill both
188
189frame .cntls
190pack .cntls -fill x
191
192button .cntls.start -text "Start" -command test_start
193pack .cntls.start -side left -padx 4 -pady 2
194
195button .cntls.stop -text "Stop" -command test_stop -state disabled
196pack .cntls.stop -side left -padx 4 -pady 2
197
198button .cntls.reload -text "Reload" -command test_reload
199pack .cntls.reload -side left -padx 4 -pady 2
200
201button .cntls.layout -text "New Layout" -command {
202    foreach key [array names nodes *-\[xy\]] {
203        unset nodes($key)
204    }
205    after idle test_reload
206}
207pack .cntls.layout -side left -padx 4 -pady 2
208
209entry .cntls.workers -width 5
210pack .cntls.workers -side right -padx {0 4} -pady 2
211.cntls.workers insert end "3"
212label .cntls.workersl -text "Workers:"
213pack .cntls.workersl -side right -pady 2
214
215frame .player
216pack .player -side bottom -fill x
217
218button .player.back -text "<" -command {test_frame_go -1 nudge}
219pack .player.back -side left -padx 4 -pady 2
220
221button .player.fwd -text ">" -command {test_frame_go 1 nudge}
222pack .player.fwd -side left -padx 4 -pady 2
223
224scale .player.scale -label "Frame" -orient horizontal \
225    -from 0 -to 1 -showvalue 0 -command {test_frame_go 1}
226pack .player.scale -side left -expand yes -fill x -padx 4 -pady 2
227
228frame .view
229pack .view -side bottom -anchor w
230label .view.show -text "Show:"
231grid .view.show -row 0 -column 0 -sticky e
232radiobutton .view.network -text "P2P Network" -variable view -value network -command test_view_change
233grid .view.network -row 0 -column 1 -sticky w
234radiobutton .view.traffic -text "Network traffic" -variable view -value traffic -command test_view_change
235grid .view.traffic -row 1 -column 1 -sticky w
236
237frame .diagram
238pack .diagram -expand yes -fill both
239canvas .diagram.network -width 500 -height 400
240canvas .diagram.traffic -width 500 -height 400
241
242after idle .view.traffic invoke
243
244proc test_stop {} {
245    global processes
246
247    # kill any existing processes
248    foreach job $processes {
249        exec kill $job
250    }
251    set processes ""
252
253    .cntls.stop configure -state disabled
254    .cntls.start configure -state normal
255
256    after idle test_reload
257}
258
259proc test_start {} {
260    global processes
261
262    # clean up existing log files...
263    foreach fname [glob -nocomplain /tmp/log*] {
264        file delete $fname
265    }
266
267    # launch a new authority server
268    lappend processes [exec tclsh authority.tcl &]
269
270    # launch a series of workers
271    for {set i 0} {$i < [.cntls.workers get]} {incr i} {
272        lappend processes [exec tclsh worker.tcl &]
273        after [expr {int(rand()*5000)}]
274    }
275
276    .cntls.start configure -state disabled
277    .cntls.stop configure -state normal
278}
279
280proc test_reload {} {
281    global time0 nodes actions nodeRadius
282
283    array set colors {
284        authority blue
285        worker gray
286    }
287
288    Shape::clear .diagram.network
289    Shape::clear .diagram.traffic
290    set tmax 0
291
292    #
293    # Scan through all files and generate positions for all nodes.
294    #
295    foreach fname [glob -nocomplain /tmp/log*] {
296        set fid [open $fname r]
297        set info [read $fid]
298        close $fid
299
300        if {[regexp -- {foreman<-} $info]} {
301            # skip log file from foreman
302            continue
303        }
304
305        # get the address for this host
306        regexp {started at port ([0-9]+)} $info match port
307        if {[regexp {options [^\n]+ ip ([^ ]+)} $info match ip]} {
308            set addr $ip:$port
309        } else {
310            set addr 127.0.0.1:$port
311        }
312
313        set lasttime ""
314        set info [split $info \n]
315        set first [lindex $info 0]
316        regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+) +(authority|worker)} $first match t0 type
317        set t0val [expr {([clock scan $t0]-$time0)*100}]
318
319        set last [lindex $info end-1]
320        regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+)} $last match t1
321        set t1val [expr {([clock scan $t1]-$time0)*100 + 99}]
322        set margin 20
323        set r $nodeRadius
324
325        set nodes($fname) $addr
326        set nodes($addr-log) $fname
327        set nodes($addr-type) $type
328        if {![info exists nodes($addr-x)]} {
329            set w [expr {[winfo width .diagram]-2*$margin}]
330            set h [expr {[winfo height .diagram]-2*$margin}]
331            set nodes($addr-x) [expr {int(rand()*$w) + $margin}]
332            set nodes($addr-y) [expr {int(rand()*$h) + $margin}]
333        }
334        set x $nodes($addr-x)
335        set y $nodes($addr-y)
336
337        foreach canv {.diagram.traffic .diagram.network} {
338            set s [Shape ::#auto $canv -command \
339                [list %c create oval [expr {$x-$r}] [expr {$y-$r}] \
340                [expr {$x+$r}] [expr {$y+$r}] \
341                -outline black -fill $colors($type) \
342                -tags [list $fname $fname-node]]]
343            $s addRange $t0val $t1val
344        }
345
346        append actions($t0val) "$type $addr online\n"
347        append actions($t1val) "$type $addr offline\n"
348
349        if {$t1val > $tmax} { set tmax $t1val }
350    }
351               
352    #
353    # Scan through files again and generate shapes for all messages
354    #
355    foreach fname [glob -nocomplain /tmp/log*] {
356        set fid [open $fname r]
357        set info [read $fid]
358        close $fid
359puts "\nscanning $fname"
360
361        if {[regexp -- {foreman<-} $info]} {
362            # skip log file from foreman
363            continue
364        }
365
366        catch {unset started}
367        set peerlist(addrs) ""
368        set peerlist(time) 0
369        set lasttime ""
370        set counter 0
371        foreach line [split $info \n] {
372            if {[regexp {^([0-9]+/[0-9]+/[0-9]+ [0-9]+:[0-9]+:[0-9]+) (.+)$} $line match time mesg]} {
373                set tval [expr {([clock scan $time]-$time0)*100}]
374
375                if {$time == $lasttime} {
376                    set tval [expr {$tval + [incr counter]}]
377                }
378                set lasttime $time
379
380                if {$tval > $tmax} { set tmax $tval }
381
382                if {[regexp {accepted: +([^ ]+) +\((.+)\)} $mesg match addr cid]} {
383                    append actions($tval) $mesg \n
384                    set started(connect$cid-time) $tval
385                    set started(connect$cid-addr) ?
386
387                } elseif {[regexp {dropped: +([^ ]+) +\((.+)\)} $mesg match addr cid] && [info exists started(connect$cid-time)]} {
388                    append actions($tval) $mesg \n
389                    set from $nodes($fname)
390                    set x0 $nodes($from-x)
391                    set y0 $nodes($from-y)
392                    set x1 $nodes($addr-x)
393                    set y1 $nodes($addr-y)
394                    set s [Shape ::#auto .diagram.traffic -command \
395                        [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
396                    $s addRange $started(connect$cid-time) $tval
397
398                    unset started(connect$cid-time)
399                    unset started(connect$cid-addr)
400
401                } elseif {[regexp {(server|client) message from ([a-zA-Z0-9\.]+:[0-9]+) \(([a-z0-9]+)\): +(.+) => (.*)} $mesg match which addr cid cmd result]} {
402                    if {![string match identity* $cmd]} {
403                        append actions($tval) $mesg \n
404                        set from $nodes($fname)
405                        set x0 $nodes($from-x)
406                        set y0 $nodes($from-y)
407                        set x1 $nodes($addr-x)
408                        set y1 $nodes($addr-y)
409                        set w [expr {[winfo width .diagram]/2}]
410
411                        set s [Shape ::#auto .diagram.traffic -command \
412                            [list %c create line [expr $x0-3] [expr $y0-3] [expr $x1-3] [expr $y1-3] -fill black -arrow first -tags transient]]
413                        $s addRange $tval $tval
414
415                        set s [Shape ::#auto .diagram.traffic -command \
416                            [list %c create text [expr {0.5*($x0+$x1)}] [expr {0.5*($y0+$y1)-1}] -width $w -fill black -anchor s -text $cmd -tags transient]]
417                        $s addRange $tval $tval
418
419                        if {"" != [string trim $result]} {
420                            if {[regexp {^ok:} $result]} {
421                                set color black
422                            } else {
423                                set color red
424                            }
425                            set s [Shape ::#auto .diagram.traffic -command \
426                                [list %c create line [expr $x0+3] [expr $y0+3] [expr $x1+3] [expr $y1+3] -fill $color -arrow last -tags transient]]
427                            $s addRange $tval $tval
428
429                            set s [Shape ::#auto .diagram.traffic -command \
430                                [list %c create text [expr {0.5*($x0+$x1)}] [expr {0.5*($y0+$y1)+1}] -width $w -fill $color -anchor n -text $result -tags transient]]
431                            $s addRange $tval $tval
432                        }
433                    }
434
435                    # no address for this client yet?  then save this info
436                    if {[info exists started(connect$cid-addr)]
437                           && $started(connect$cid-addr) == "?"} {
438                        set started(connect$cid-addr) $addr
439                    }
440
441                } elseif {[regexp {connected to peers: (.*)} $mesg match plist]} {
442                    # draw a highlight ring, indicating that peers have changed
443                    set from $nodes($fname)
444                    set x $nodes($from-x)
445                    set y $nodes($from-y)
446                    foreach canv {.diagram.traffic .diagram.network} {
447                        set s [Shape ::#auto $canv -command \
448                            [list %c create oval [expr {$x-$r-3}] [expr {$y-$r-3}] [expr {$x+$r+3}] [expr {$y+$r+3}] -outline red -fill "" -tags transient]]
449                        $s addRange $tval [expr {$tval+20}]
450                    }
451
452                    # draw lines from the previous peer list, now that
453                    # we know it's time range is done.
454                    foreach addr $peerlist(addrs) {
455                        set from $nodes($fname)
456                        set x0 $nodes($from-x)
457                        set y0 $nodes($from-y)
458                        set x1 $nodes($addr-x)
459                        set y1 $nodes($addr-y)
460                        set s [Shape ::#auto .diagram.network -command \
461                            [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
462                        $s addRange $peerlist(time) $tval
463                    }
464
465                    # save the start of this new peer list
466                    set peerlist(addrs) $plist
467                    set peerlist(time) $tval
468                }
469            }
470        }
471
472        # any connections hanging out that we haven't drawn?
473        foreach key [array names started connect*-addr] {
474            regexp {connect([^-]+)-addr} $key match cid
475            set from $nodes($fname)
476            set addr $started($key)
477
478            if {![info exists nodes($addr-x)]} {
479                unset started(connect$cid-time)
480                unset started(connect$cid-addr)
481                continue
482            }
483            set x0 $nodes($from-x)
484            set y0 $nodes($from-y)
485            set x1 $nodes($addr-x)
486            set y1 $nodes($addr-y)
487            set s [Shape ::#auto .diagram.traffic -command \
488                [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
489            $s addRange $started(connect$cid-time) $tval
490
491            unset started(connect$cid-time)
492            unset started(connect$cid-addr)
493        }
494
495        .diagram.traffic bind $fname <Enter> "
496            %W itemconfigure $fname-node -outline red
497            %W itemconfigure $fname-cnx -fill red
498            %W raise $fname-cnx
499        "
500        .diagram.traffic bind $fname <Leave> "
501            %W itemconfigure $fname-node -outline black
502            %W itemconfigure $fname-cnx -fill gray
503            %W raise transient
504        "
505
506        foreach canv {.diagram.network .diagram.traffic} {
507            $canv bind $fname-node <ButtonPress-1> \
508                [list worker_node_click %W $fname %x %y]
509            $canv bind $fname-node <B1-Motion> \
510                [list worker_node_drag %W $fname %x %y]
511            $canv bind $fname-node <ButtonRelease-1> \
512                [list worker_node_release %W $fname %x %y]
513        }
514
515        # any peer connections that we haven't drawn?  then do it now
516        foreach addr $peerlist(addrs) {
517            set from $nodes($fname)
518            set x0 $nodes($from-x)
519            set y0 $nodes($from-y)
520            set x1 $nodes($addr-x)
521            set y1 $nodes($addr-y)
522            set s [Shape ::#auto .diagram.network -command \
523                [list %c create line $x0 $y0 $x1 $y1 -width 3 -fill gray -tags [list $fname $fname-cnx]]]
524            $s addRange $peerlist(time) $tmax
525        }
526
527        .diagram.network bind $fname <Enter> "
528            %W itemconfigure $fname-node -outline red
529            %W itemconfigure $fname-cnx -fill red
530            %W raise $fname-cnx
531        "
532        .diagram.network bind $fname <Leave> "
533            %W itemconfigure $fname-node -outline black
534            %W itemconfigure $fname-cnx -fill gray
535            %W raise transient
536        "
537    }
538    .player.scale configure -to $tmax
539
540    after cancel test_visualize
541    after idle test_visualize
542}
543
544proc worker_node_click {canv fname x y} {
545    $canv itemconfigure $fname-node -stipple gray50
546}
547
548proc worker_node_drag {canv fname x y} {
549    global nodeRadius
550    $canv itemconfigure $fname-node -stipple ""
551    $canv coords $fname-node [expr {$x-$nodeRadius}] [expr {$y-$nodeRadius}] [expr {$x+$nodeRadius}] [expr {$y+$nodeRadius}]
552}
553
554proc worker_node_release {canv fname x y} {
555    global move nodes
556
557    worker_node_drag $canv $fname $x $y
558    $canv itemconfigure $fname-node -stipple ""
559
560    set addr $nodes($fname)
561    set nodes($addr-x) $x
562    set nodes($addr-y) $y
563    after idle test_reload
564}
565
566proc test_frame_go {dir position} {
567    global actions
568
569    set tmax [.player.scale cget -to]
570    if {"nudge" == $position} {
571        set nframe [.player.scale get]
572        incr nframe $dir
573    } else {
574        set nframe $position
575    }
576
577    while {![info exists actions($nframe)] && $nframe > 0 && $nframe < $tmax} {
578        incr nframe $dir
579    }
580
581    # set the scale to this new position
582    .player.scale configure -command ""
583    .player.scale set $nframe
584    .player.scale configure -command {test_frame_go 1}
585
586    after cancel test_visualize
587    after idle test_visualize
588}
589
590proc test_visualize {} {
591    .diagram.traffic delete all
592    Shape::draw .diagram.traffic [.player.scale get]
593    .diagram.traffic raise transient
594
595    .diagram.network delete all
596    Shape::draw .diagram.network [.player.scale get]
597    .diagram.network raise transient
598}
599
600proc test_view_change {} {
601    global view
602    foreach widget [pack slaves .diagram] {
603        catch {pack forget $widget}
604    }
605    pack .diagram.$view -expand yes -fill both
606}
607
608proc test_bids {} {
609    set info [Rappture::foreman::bids]
610    .client.bids.info delete 0 end
611    eval .client.bids.info insert end $info
612}
Note: See TracBrowser for help on using the repository browser.