Commit ed964507 authored by Leigh Stoller's avatar Leigh Stoller

Overview: Add Event Groups:

	set g1 [new EventGroup $ns]
	$g1 add  $link0 $link1
	$ns at 60.0 "$g1 down"

See the new advanced tutorial section on event groups for a better
example.

Changed tbreport to dump the event groups table when in summary mode.
At the same time, I changed tbreport to use the recently added
virt_lans:vnode and ip slots, decprecating virt_nodes:ips in one more
place. I also changed the web interface to always dump the event and
event group summaries.

The parser gets a new file (event.tcl), and the "at" method deals with
event group events by expanding them inline into individual events
sent to each member. For some agents, this is unavoidable; traffic
generators get the initial params in the event, so it is not possible
to send a single event to all members of the group. Same goes for
program objects, although program objects do default to the initial
command now, at least on new images.

Changed the event scheduler to load the event groups table. The
current operation is that the scheduler expands events sent to a
group, into a set of distinct events sent to each member of the
group. At some point we proably want to optimize this by telling the
agents (running on the nodes) what groups they are members of.

Other News: Added a "mustdelay" slot to the virt_lans table so the
parser can tell assign_wrapper that a link needs to be delayed, say if
there are events or if the link is red/gred. Previously,
assign_wrapper tried to figure this out by looking at the event list,
etc. I have removed that code; see database-migrate for instructions
on how to initialize this slot in existing experiments. assign_wrapper
is free to ignore or insert delays anyway, but having the parser do
this makes more sense.

I also made some "rename" changes to the parser wrt queues and lans
and links. Not really necessary, but I got sidetracked (for several
hours!) trying to understand that rename stuff a little better, and
now I do.
parent c6c4a847
......@@ -2733,6 +2733,7 @@ sub TBGetSiteVar($)
"virt_simnode_attributes",
"nseconfigs",
"eventlist",
"event_groups",
"ipsubnets",
"nsfiles");
......
......@@ -106,8 +106,11 @@ my %virtual_tables =
"eventlist" => { rows => undef,
tag => "events",
row => "event",
attrs => [ "vname" ]});
attrs => [ "vname" ]},
"event_groups" => { rows => undef,
tag => "event_groups",
row => "event_group",
attrs => [ "group_name", "agent-name" ]});
# XXX
# The experiment table is special. Only certain fields are allowed to
......
......@@ -108,6 +108,10 @@ int address_tuple_free(address_tuple_t);
event_notification_remove(handle, note, "OBJTYPE")
#define event_notification_set_objtype(handle, note, buf) \
event_notification_put_string(handle, note, "OBJTYPE", buf)
#define event_notification_clear_objname(handle, note) \
event_notification_remove(handle, note, "OBJNAME")
#define event_notification_set_objname(handle, note, buf) \
event_notification_put_string(handle, note, "OBJNAME", buf)
/*
* Event library sets this field. Holds the sender of the event, as
......
This diff is collapsed.
......@@ -157,6 +157,21 @@ CREATE TABLE event_objecttypes (
PRIMARY KEY (idx)
) TYPE=MyISAM;
--
-- Table structure for table `event_groups`
--
CREATE TABLE event_groups (
pid varchar(12) NOT NULL default '',
eid varchar(32) NOT NULL default '',
idx int(10) unsigned NOT NULL auto_increment,
group_name varchar(64) NOT NULL default '',
agent_name varchar(64) NOT NULL default '',
PRIMARY KEY (pid,eid,idx),
KEY group_name (group_name),
KEY agent_name (agent_name)
) TYPE=MyISAM;
--
-- Table structure for table `eventlist`
--
......@@ -170,6 +185,7 @@ CREATE TABLE eventlist (
vname varchar(64) NOT NULL default '',
objecttype smallint(5) unsigned NOT NULL default '0',
eventtype smallint(5) unsigned NOT NULL default '0',
isgroup tinyint(1) unsigned default '0',
arguments text,
atstring text,
PRIMARY KEY (pid,eid,idx),
......@@ -1710,6 +1726,7 @@ CREATE TABLE virt_lans (
emulated tinyint(4) default '0',
uselinkdelay tinyint(4) default '0',
nobwshaping tinyint(4) default '0',
mustdelay tinyint(1) default '0',
usevethiface tinyint(4) default '0',
trivial_ok tinyint(4) default '1',
protocol varchar(30) NOT NULL default 'ethernet',
......
......@@ -539,6 +539,7 @@ REPLACE INTO table_regex VALUES ('virt_lans','widearea','int','redirect','defaul
REPLACE INTO table_regex VALUES ('virt_lans','emulated','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','uselinkdelay','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','nobwshaping','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','mustdelay','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','usevethiface','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','trivial_ok','int','redirect','default:boolean',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_node_desires','pid','text','redirect','projects:pid',0,0,NULL);
......@@ -634,6 +635,10 @@ REPLACE INTO table_regex VALUES ('virt_lan_member_settings','capkey','text','red
REPLACE INTO table_regex VALUES ('virt_lan_member_settings','capval','text','redirect','virt_lan_settings:capval',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','est_bandwidth','int','redirect','default:int',0,2147483647,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','rest_bandwidth','int','redirect','default:int',0,2147483647,NULL);
REPLACE INTO table_regex VALUES ('event_groups','pid','text','redirect','projects:pid',0,0,NULL);
REPLACE INTO table_regex VALUES ('event_groups','eid','text','redirect','experiments:eid',0,0,NULL);
REPLACE INTO table_regex VALUES ('event_groups','group_name','text','redirect','eventlist:vname',0,0,NULL);
REPLACE INTO table_regex VALUES ('event_groups','agent_name','text','redirect','eventlist:vname',0,0,NULL);
--
-- Dumping data for table `testsuite_preentables`
......
......@@ -1778,3 +1778,42 @@ last_net_act,last_cpu_act,last_ext_act);
1.267: Remove table definition that snuck in while developing; skip to
next entry;
1.268: Add event_groups table to allow users to define groups of
targets for events. The agent_name refers to an entry in the
virt_agents table. All members of an eventgroup must of course
be of the same type. I am not currently enforcing this. (note
that the vnode slot of the eventlist table was effectively
deprecated quite some time ago; the event scheduler uses the
vnode slot of the virt_agents entry instead).
CREATE TABLE event_groups (
pid varchar(12) NOT NULL default '',
eid varchar(32) NOT NULL default '',
idx int(10) unsigned NOT NULL auto_increment,
group_name varchar(64) NOT NULL default '',
agent_name varchar(64) NOT NULL default '',
PRIMARY KEY (pid,eid,idx),
KEY group_name (group_name),
KEY agent_name (agent_name)
) TYPE=MyISAM;
Also add a boolean to the eventlist table to mark an event as a
group event.
alter table eventlist add isgroup tinyint(1) unsigned \
NOT NULL default '0' after eventtype;
Add mustdelay boolean to virt_lans to relieve assign_wrapper
from the chore of guessing when a delay node needs to be
inserted; assign_wrapper can still override of course, but this
should make it less error prone.
alter table virt_lans add mustdelay tinyint(1) unsigned \
default '0' after nobwshaping;
update virt_lans set mustdelay=q_red;
Then run:
./mustdelay.pl
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2004 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use lib "/usr/testbed/lib";
use libdb;
use libtestbed;
#
# Untaint the path
#
$ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
$query_result =
DBQueryFatal("select distinct ex.pid,ex.eid,vname from eventlist as ex ".
"left join event_eventtypes as et on ex.eventtype=et.idx ".
"left join event_objecttypes as ot on ex.objecttype=ot.idx ".
"where ot.type='LINK'");
while (($pid,$eid,$lan) = $query_result->fetchrow_array()) {
DBQueryFatal("update virt_lans set mustdelay=1 ".
"where pid='$pid' and eid='$eid' and vname='$lan'");
}
......@@ -3469,11 +3469,12 @@ sub LoadVirtLans()
my $useveth = $rowref->{"usevethiface"};
my $trivial_ok = $rowref->{"trivial_ok"};
my $protocol = $rowref->{"protocol"};
my $mustdelay = $rowref->{"mustdelay"};
# Extend the DB info with this stuff:
#
# If RED, must insert traffic shapping.
$virt_lans{$vname}->{"MUSTDELAY"} = $rowref->{"q_red"};
$virt_lans{$vname}->{"MUSTDELAY"} = $mustdelay;
# User has requested the link/lan be emulated. Not typical.
$virt_lans{$vname}->{"EMULATED"} = $isemulated;
# User has requested "endnodeshaping" (dummynet on end nodes).
......@@ -3592,21 +3593,6 @@ sub LoadVirtLans()
"$rdelay $rbandwidth $rlossrate\n";
printdb " $port:$vname is a lan of $node\n";
}
#
# Check event list. Anytime we find an event to control a link, we need
# to drop a delay node in. start/stop especially, since thats the easiest
# way to do that, even if the link has no other traffic shaping in it.
#
printdb "Checking events for LINK commands.\n";
$result =
DBQueryFatal("select distinct vname from eventlist as ex ".
"left join event_eventtypes as et on ex.eventtype=et.idx ".
"left join event_objecttypes as ot on ex.objecttype=ot.idx ".
"where ot.type='LINK' and ex.pid='$pid' and ex.eid='$eid'");
while (($vname) = $result->fetchrow_array) {
$virt_lans{$vname}->{"MUSTDELAY"} = 1;
}
}
sub virtlanexists($) { return exists($virt_lans{$_[0]}); }
sub virtlanname($) { return $virt_lans{$_[0]}->{"VNAME"}; }
......
......@@ -16,7 +16,7 @@ include $(OBJDIR)/Makeconf
LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
nsobject.tcl traffic.tcl vtype.tcl parse.tcl program.tcl \
nsenode.tcl nstb_compat.tcl
nsenode.tcl nstb_compat.tcl event.tcl
BOSSLIBEXEC = parse-ns
USERLIBEXEC = parse.proxy
......
# -*- tcl -*-
#
# EMULAB-COPYRIGHT
# Copyright (c) 2004 University of Utah and the Flux Group.
# All rights reserved.
#
######################################################################
#
# Event group support.
#
######################################################################
Class EventGroup -superclass NSObject
namespace eval GLOBALS {
set new_classes(EventGroup) {}
}
EventGroup instproc init {s} {
global ::GLOBALS::last_class
$self set sim $s
$self set mytype {}
$self instvar members
array set members {}
# Link simulator to this new object.
$s add_eventgroup $self
set ::GLOBALS::last_class $self
}
EventGroup instproc rename {old new} {
$self instvar sim
$sim rename_eventgroup $old $new
}
#
# Add members to the event group.
#
EventGroup instproc add {args} {
$self instvar members
$self instvar mytype
foreach obj $args {
if {[$obj info class] == "Lan" || [$obj info class] == "Link"} {
set thisclass "LanLink"
} else {
set thisclass [$obj info class]
}
if {$mytype == {}} {
set mytype $thisclass
}
if {$thisclass != $mytype} {
perror "\[$self add $obj] All members must be of the same type!"
return
}
set members($obj) {}
}
}
#
# Return list of member objects
#
EventGroup instproc members {} {
$self instvar members
return [array names members]
}
# updatedb DB
EventGroup instproc updatedb {DB} {
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
$self instvar members
$self instvar sim
if {[array size members] == 0} {
perror "\[updatedb] $self has no member list."
return
}
foreach member [array names members] {
if {[$member info class] == "Queue"} {
set agent_name [$member agent_name]
} else {
set agent_name $member
}
set names [list "group_name" "agent_name"]
set vals [list $self $agent_name]
$sim spitxml_data "event_groups" $names $vals
}
}
......@@ -32,7 +32,9 @@ SimplexLink instproc init {link dir} {
SimplexLink instproc queue {} {
$self instvar mylink
$self instvar mydir
return [$mylink set ${mydir}queue]
set myqueue [$mylink set ${mydir}queue]
return $myqueue
}
LLink instproc init {lan node} {
$self set mylan $lan
......@@ -49,14 +51,10 @@ LLink instproc queue {} {
# Don't need any rename procs since these never use their own name and
# can not be generated during Link creation.
Queue instproc init {link type dir} {
Queue instproc init {link type node} {
$self set mylink $link
$self set mynode $node
# direction is either "to" indicating src to dst or "from" indicating
# the dst to src. I.e. to dst or from dst.
$self set direction $dir
# These control whether the link was created RED or GRED. It
# filters through the DB.
$self set gentle_ 0
......@@ -83,15 +81,23 @@ Queue instproc init {link type dir} {
if {$type == "RED"} {
set red_ 1
$link mustdelay
} elseif {$type == "GRED"} {
set red_ 1
set gentle_ 1
$link mustdelay
} elseif {$type != "DropTail"} {
punsup "Link type $type, using DropTail!"
}
}
}
Queue instproc rename {old new} {
$self instvar mylink
$mylink rename_queue $old $new
}
Queue instproc rename_lanlink {old new} {
$self instvar mylink
......@@ -104,19 +110,20 @@ Queue instproc get_link {} {
return $mylink
}
# Hacky. Need to create an association bewteen the queue direction
# and a dummynet pipe. This should happen later on, but I do not
# have time right now to make all the changes. Instead, convert
# "to" to "pipe0" and "from" to "pipe1".
Queue instproc get_pipe {} {
$self instvar direction
if {$direction == "to"} {
set pipe "pipe0"
} else {
set pipe "pipe1"
}
return $pipe
Queue instproc agent_name {} {
$self instvar mylink
$self instvar mynode
return "$mylink-$mynode"
}
#
# A queue is associated with a node on a link. Return that node.
#
Queue instproc get_node {} {
$self instvar mynode
return $mynode
}
Link instproc init {s nodes bw d type} {
......@@ -134,8 +141,8 @@ Link instproc init {s nodes bw d type} {
var_import GLOBALS::new_counter
set q1 q[incr new_counter]
Queue to$q1 $self $type to
Queue from$q1 $self $type from
Queue to$q1 $self $type $src
Queue from$q1 $self $type $dst
$self set toqueue to$q1
$self set fromqueue from$q1
......@@ -172,6 +179,13 @@ LanLink instproc init {s nodes bw d type} {
# Allow user to turn off actual bw shaping on emulated links.
$self set nobwshaping 0
# mustdelay; force a delay (or linkdelay) to be inserted. assign_wrapper
# is free to override this, but not sure why it want to! When used in
# conjunction with nobwshaping, you get a delay node, but with no ipfw
# limits on the bw part, and assign_wrapper ignores the bw when doing
# assignment.
$self set mustdelay 0
# Allow user to turn on veth devices on emulated links.
$self set useveth 0
......@@ -242,11 +256,19 @@ LanLink instproc init {s nodes bw d type} {
lappend nodelist $nodepair
set lq q[incr new_counter]
Queue lq$lq $self $type to
Queue lq$lq $self $type $node
set linkq($nodepair) lq$lq
}
}
#
# Set the mustdelay flag.
#
LanLink instproc mustdelay {} {
$self instvar mustdelay
set mustdelay 1
}
# get_port <node>
# This takes a node and returns the port that the node is connected
# to the LAN with. If a node is in a LAN multiple times for some
......@@ -421,7 +443,6 @@ LanLink instproc cost {c} {
}
}
Link instproc rename {old new} {
$self next $old $new
......@@ -431,6 +452,19 @@ Link instproc rename {old new} {
$fromqueue rename_lanlink $old $new
}
Link instproc rename_queue {old new} {
$self next $old $new
$self instvar toqueue
$self instvar fromqueue
if {$old == $toqueue} {
set toqueue $new
} elseif {$old == $fromqueue} {
set fromqueue $new
}
}
# The following methods are for renaming objects (see README).
LanLink instproc rename {old new} {
$self instvar nodelist
......@@ -449,6 +483,7 @@ LanLink instproc rename_node {old new} {
$self instvar rbandwidth
$self instvar rdelay
$self instvar rloss
$self instvar linkq
$self instvar accesspoint
# XXX Temporary
......@@ -472,16 +507,32 @@ LanLink instproc rename_node {old new} {
set rbandwidth($newnodeport) $rbandwidth($nodeport)
set rdelay($newnodeport) $rdelay($nodeport)
set rloss($newnodeport) $rloss($nodeport)
set linkq($newnodepair) linkq($nodeport)
unset bandwidth($nodeport)
unset delay($nodeport)
unset loss($nodeport)
unset rbandwidth($nodeport)
unset rdelay($nodeport)
unset rloss($nodeport)
unset linkq($nodeport)
}
set nodelist $newnodelist
}
LanLink instproc rename_queue {old new} {
$self instvar nodelist
$self instvar linkq
foreach nodeport $nodelist {
set foo linkq($nodeport)
if {$foo == $old} {
set linkq($nodeport) $new
}
}
}
Link instproc updatedb {DB} {
$self instvar toqueue
$self instvar fromqueue
......@@ -507,6 +558,7 @@ Link instproc updatedb {DB} {
$self instvar sim
$self instvar netmask
$self instvar protocol
$self instvar mustdelay
if {$protocol != "ethernet"} {
perror "Link must be an ethernet only, not a $protocol"
......@@ -566,7 +618,7 @@ Link instproc updatedb {DB} {
set nodeportraw [join $nodeport ":"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "vnode" "vport" "ip"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "vnode" "vport" "ip" "mustdelay"]
# Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not
......@@ -579,7 +631,7 @@ Link instproc updatedb {DB} {
lappend fields "rest_bandwidth"
}
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $node $port $ip]
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $node $port $ip $mustdelay]
if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport)
......@@ -621,6 +673,7 @@ Lan instproc updatedb {DB} {
$self instvar accesspoint
$self instvar settings
$self instvar member_settings
$self instvar mustdelay
if {$modelnet_cores > 0 || $modelnet_edges > 0} {
perror "Lans are not allowed when using modelnet; just duplex links."
......@@ -692,7 +745,7 @@ Lan instproc updatedb {DB} {
set is_accesspoint 1
}
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "is_accesspoint" "vnode" "vport" "ip"]
set fields [list "vname" "member" "mask" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok" "protocol" "is_accesspoint" "vnode" "vport" "ip" "mustdelay"]
# Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not
......@@ -705,7 +758,7 @@ Lan instproc updatedb {DB} {
lappend fields "rest_bandwidth"
}
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $is_accesspoint $node $port $ip]
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $is_accesspoint $node $port $ip $mustdelay]
if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport)
......
......@@ -264,6 +264,7 @@ source ${GLOBALS::libdir}/null.tcl
source ${GLOBALS::libdir}/traffic.tcl
source ${GLOBALS::libdir}/vtype.tcl
source ${GLOBALS::libdir}/program.tcl
source ${GLOBALS::libdir}/event.tcl
##################################################
# Redifing Assignment
......
......@@ -23,6 +23,7 @@
Class Simulator
Class Program -superclass NSObject
Class EventGroup -superclass NSObject
Simulator instproc init {args} {
# A counter for internal ids
......@@ -62,6 +63,10 @@ Simulator instproc init {args} {
$self instvar prog_list;
array set prog_list {}
# EventGroup list.
$self instvar eventgroup_list;
array set eventgroup_list {}
var_import ::GLOBALS::last_class
set last_class $self
}
......@@ -226,6 +231,7 @@ Simulator instproc run {} {
$self instvar node_list
$self instvar event_list
$self instvar prog_list
$self instvar eventgroup_list
$self instvar simulated
$self instvar nseconfig
var_import ::GLOBALS::pid
......@@ -362,6 +368,9 @@ Simulator instproc run {} {
foreach prog [array names prog_list] {
$prog updatedb "sql"
}
foreach egroup [array names eventgroup_list] {
$egroup updatedb "sql"
}
set fields [list "mem_usage" "cpu_usage" "forcelinkdelays" "uselinkdelays" "usewatunnels" "uselatestwadata" "wa_delay_solverweight" "wa_bw_solverweight" "wa_plr_solverweight" "veth_encapsulate" "allowfixnode"]
set values [list $mem_usage $cpu_usage $forcelinkdelays $uselinkdelays $usewatunnels $uselatestwadata $wa_delay_solverweight $wa_bw_solverweight $wa_plr_solverweight $veth_encapsulate $fix_current_resources]
......@@ -501,6 +510,23 @@ Simulator instproc at {time eventstring} {
set atstring "$event"
set args {}
set okargs 0
#
# Groups are special. It would be nice to optimize the event groups
# so that a single event could be stored in the DB, but some events
# take arguments based on the actual object being controlled. For now
# I will not try to optimize for when they can be lumped, but rather
# will just turn all group events into a list of individual events.
#
if {[$obj info class] == "EventGroup"} {
set cmd [lrange $event 1 end]
foreach member [$obj members] {
$self at $time "$member $cmd"
}
return
}
switch -- [$obj info class] {
"Application/Traffic/CBR" {
set otype TRAFGEN
......@@ -571,7 +597,8 @@ Simulator instproc at {time eventstring} {
set vnode [$obj get_node]
set vname $obj
}
"Link" {
"Link" -
"Lan" {
set otype LINK
switch -- $cmd {
"up" {set etype UP}
......@@ -615,11 +642,13 @@ Simulator instproc at {time eventstring} {
}
set vnode {}
set vname $obj
$obj mustdelay
}
"Queue" {
set otype LINK
set pipe [$obj get_pipe]
set obj [$obj get_link]
set node [$obj get_node]
set lanlink [$obj get_link]
$lanlink mustdelay
switch -- $cmd {
"set" {
if {[llength $event] < 4} {
......@@ -662,9 +691,8 @@ Simulator instproc at {time eventstring} {
return
}
}
set args "PIPE=$pipe $args"
set vnode {}
set vname $obj
set vname "$lanlink-$node"
}
"Program" {
set otype PROGRAM
......@@ -817,6 +845,12 @@ Simulator instproc rename_program {old new} {
set prog_list($new) {}
}
Simulator instproc rename_eventgroup {old new} {
$self instvar eventgroup_list
unset eventgroup_list($old)
set eventgroup_list($new) {}
}
# find_link <node1> <node2>
# This is just an accesor to the link_map datastructure. If no
# link is known between <node1> and <node2> the empty list is returned.
......@@ -972,6 +1006,13 @@ Simulator instproc add_program {prog} {
set prog_list($prog) {}
}
# add_eventgroup
# Link to a EventGroup object.
Simulator instproc add_eventgroup {group} {
$self instvar eventgroup_list
set eventgroup_list($group) {}
}
# cost
# Set the cost for a link
Simulator instproc cost {src dst c} {
......
......@@ -190,7 +190,7 @@ if ($state eq EXPTSTATE_ACTIVE) {
# this.
#
my $virtnodes_result =
DBQueryFatal("SELECT vname,ips,osname,cmd_line,rpms," .
DBQueryFatal("SELECT vname,osname,cmd_line,rpms," .
"startupcmd,tarfiles,type,fixed from virt_nodes ".
"where pid='$pid' and eid='$eid' order by vname");
......@@ -200,7 +200,7 @@ if ($shownodes) {
print "--------------- ------------ --------------- ".
"--------------------\n";
while (($vname,$ips,$osname,$cmd_line,$rpms,$startupcmd,
while (($vname,$osname,$cmd_line,$rpms,$startupcmd,
$tarfiles,$type,$fixed) = $virtnodes_result->fetchrow_array()) {
my $qualname = "$vname.$eid.$pid.$DOMAIN";
......@@ -313,23 +313,27 @@ if ($showmap && $state eq EXPTSTATE_ACTIVE) {
# Links and Lans
#
if ($showlinks) {
$virtnodes_result->dataseek(0);
$result =
DBQueryFatal("select vname,vnode,vport,ip,member,mask,delay, ".
" bandwidth,lossrate, ".
" rdelay,rbandwidth,rlossrate,protocol ".
" from virt_lans as v ".
"where pid='$pid' and eid='$eid' ".
"order by vname,member");
while (($vname,$ips) = $virtnodes_result->fetchrow_array()) {
foreach $ipinfo (split(" ",$ips)) {
($port,$ip) = split(":",$ipinfo);
$ipmap{"$vname:$port"} = $ip;
$macmap{$ip}->{"MEMBER"} = "$vname:$port";
}
while (my ($vname,$vnode,$vport,$ip) = $result->fetchrow_array()) {
$ipmap{"$vnode:$vport"} = $ip;
$macmap{$ip}->{"MEMBER"} = "$vnode:$vport";
}
$result->dataseek(0);
my $result =
my $iface_result =
DBQueryFatal("select i.ip,i.mac,i.iface from reserved as r ".
"left join interfaces as i on r.node_id=i.node_id ".
"where r.pid='$pid' and r.eid='$eid' and ".
" i.ip is not NULL and i.ip!=''");
while (($ip,$mac,$iface) = $result->fetchrow_array()) {
while (($ip,$mac,$iface) = $iface_result->fetchrow_array()) {
if ($mac =~ /^(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})$/) {
$mac = "$1:$2:$3:$4:$5:$6";
}
......@@ -337,13 +341,6 @@ if ($showlinks) {
$macmap{$ip}->{"IFACE"} = $iface;
}
$result =
DBQueryFatal("select vname,member,mask,delay,bandwidth,lossrate, ".
" rdelay,rbandwidth,rlossrate,protocol ".
" from virt_lans as v ".
"where pid='$pid' and eid='$eid' ".
"order by vname,member");
if ($result->numrows) {
print "Virtual Lan/Link Info:\n";
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n",
......@@ -351,8 +348,8 @@ if ($showlinks) {
print "--------------- --------------- --------------- --------- ".