# and Technology through the research contract #IP-2003-143.
#
-# $Id: cfgparse.tcl,v 1.39 2008/01/08 12:35:30 marko Exp $
+# $Id: cfgparse.tcl,v 1.40 2008/06/22 23:29:45 marko Exp $
#****h* imunes/cfgparse.tcl
}
}
dumpputs $method $dest " \}"
+ } elseif { "[lindex $element 0]" == "events" } {
+ dumpputs $method $dest " events \{"
+ foreach line [lindex $element 1] {
+ if { $line != {} } {
+ dumpputs $method $dest " $line"
+ }
+ }
+ dumpputs $method $dest " \}"
} else {
dumpputs $method $dest " $element"
}
upvar 0 ::cf::[set ::curcfg]::$elem lelem
dumpputs $method $dest "$obj $elem \{"
foreach element $lelem {
- dumpputs $method $dest " $element"
+ if { "[lindex $element 0]" == "events" } {
+ dumpputs $method $dest " events \{"
+ foreach line [lindex $element 1] {
+ if { $line != {} } {
+ dumpputs $method $dest " $line"
+ }
+ }
+ dumpputs $method $dest " \}"
+ } else {
+ dumpputs $method $dest " $element"
+ }
}
dumpputs $method $dest "\}"
dumpputs $method $dest ""
canvas {
lappend $object "canvas $value"
}
+ events {
+ set cfg ""
+ foreach zline [split $value {
+}] {
+ if { [string index "$zline" 0] == " " } {
+ set zline [string replace "$zline" 0 0]
+ }
+ set zline [string trim $zline]
+ lappend cfg $zline
+ }
+ set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
+ lappend $object "events {$cfg}"
+ }
}
} elseif {"$class" == "link"} {
switch -exact -- $field {
width {
lappend $object "width $value"
}
+ events {
+ set cfg ""
+ foreach zline [split $value {
+}] {
+ if { [string index "$zline" 0] == " " } {
+ set zline [string replace "$zline" 0 0]
+ }
+ set zline [string trim $zline]
+ lappend cfg $zline
+ }
+ set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
+ lappend $object "events {$cfg}"
+ }
}
} elseif {"$class" == "canvas"} {
switch -exact -- $field {
--- /dev/null
+#
+# Copyright 2008 University of Zagreb, Croatia.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+# $Id: eventsched.tcl,v 1.1 2008/06/22 23:29:45 marko Exp $
+
+
+set sched_init_done 0
+
+proc evsched {} {
+ global sched_init_done event_t0 eventqueue
+
+ # XXX temp hack, init should be done when experiment is started
+ if { $sched_init_done == 0 } {
+ sched_init
+ }
+
+ set curtime [expr [clock seconds] - $event_t0]
+ set changed 0
+ set need_sort 1
+
+ foreach event $eventqueue {
+ set deadline [lindex $event 0]
+ if { $deadline > $curtime } {
+ break
+ }
+
+ # Dequeue the current event
+ set eventqueue [lrange $eventqueue 1 end]
+
+ set class [lindex $event 1]
+ set object [lindex $event 2]
+ set target [lindex $event 3]
+ set params [lrange $event 4 end]
+
+ # XXX only constant values are supported
+
+ if { $class == "node" } {
+ # XXX nothing implemented yet
+ } elseif { $class == "link" } {
+ if { [lindex $params 0] == "rand" } {
+ set lo [lindex $params 1]
+ set hi [lindex $params 2]
+ set next [expr $deadline + [lindex $params 3]]
+ set value [expr round($lo + ($hi - $lo) * rand())]
+ if { $next > $deadline } {
+ set nextev \
+ [lsearch $eventqueue "* $class $object $target *"]
+ if { $nextev > -1 && \
+ [lindex [lindex $eventqueue $nextev] 0] > $next } {
+ lappend eventqueue "$next [lrange $event 1 end]"
+ set need_sort 1
+ }
+ }
+ } else {
+ set value [lindex $params 0]
+ }
+ switch -exact -- $target {
+ bandwidth {
+ setLinkBandwidth $object $value
+ }
+ delay {
+ setLinkDelay $object $value
+ }
+ ber {
+ setLinkBER $object $value
+ }
+ duplicate {
+ setLinkDup $object $value
+ }
+ color {
+ setLinkColor $object $value
+ }
+ }
+ #execSetLinkParams $eid $object
+ set changed 1
+ }
+ }
+
+ if { $changed == 1 } {
+ redrawAll
+ }
+
+ if { $need_sort == 1 } {
+ set eventqueue [lsort -index 0 -integer $eventqueue]
+ }
+
+ after 1000 evsched
+}
+
+
+proc sched_init {} {
+ upvar 0 ::cf::[set ::curcfg]::node_list node_list
+ upvar 0 ::cf::[set ::curcfg]::link_list link_list
+ global sched_init_done
+ global eventqueue event_t0
+
+ set eventqueue {}
+
+ foreach link $link_list {
+ set evlist [getLinkEvents $link]
+ foreach event $evlist {
+ lappend eventqueue \
+ "[lindex $event 0] link $link [lrange $event 1 end]"
+ }
+ }
+
+ foreach node $node_list {
+ set evlist [getLinkEvents $node]
+ foreach event $evlist {
+ lappend eventqueue \
+ "[lindex $event 0] node $node [lrange $event 1 end]"
+ }
+ }
+
+ set eventqueue [lsort -index 0 -integer $eventqueue]
+
+ set sched_init_done 1
+ set event_t0 [clock seconds]
+}
+
+
+proc getLinkEvents { link } {
+ upvar 0 ::cf::[set ::curcfg]::$link $link
+
+ set entry [lsearch -inline [set $link] "events *"]
+ return [lindex $entry 1]
+}
# and Technology through the research contract #IP-2003-143.
#
-# $Id: imunes.tcl,v 1.36 2008/01/08 14:21:00 marko Exp $
+# $Id: imunes.tcl,v 1.37 2008/06/22 23:29:45 marko Exp $
#****h* imunes/imunes.tcl
set BINDIR "bin"
}
+source "$ROOTDIR/$LIBDIR/canvas.tcl"
source "$ROOTDIR/$LIBDIR/linkcfg.tcl"
source "$ROOTDIR/$LIBDIR/nodecfg.tcl"
source "$ROOTDIR/$LIBDIR/ipv4.tcl"
source "$ROOTDIR/$LIBDIR/ipsec.tcl"
source "$ROOTDIR/$LIBDIR/cfgparse.tcl"
source "$ROOTDIR/$LIBDIR/exec.tcl"
-source "$ROOTDIR/$LIBDIR/canvas.tcl"
+source "$ROOTDIR/$LIBDIR/eventsched.tcl"
source "$ROOTDIR/$LIBDIR/quagga.tcl"
source "$ROOTDIR/$LIBDIR/xorp.tcl"
updateProjectMenu
# Fire up the animation loop
animate
+ # Event scheduler - should be started / stopped on per-experiment base?
+ evsched
} else {
if {$argv != ""} {
set fileId [open $argv r]
projects / imunes.git / commitdiff