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($) ...@@ -2733,6 +2733,7 @@ sub TBGetSiteVar($)
"virt_simnode_attributes", "virt_simnode_attributes",
"nseconfigs", "nseconfigs",
"eventlist", "eventlist",
"event_groups",
"ipsubnets", "ipsubnets",
"nsfiles"); "nsfiles");
......
...@@ -106,8 +106,11 @@ my %virtual_tables = ...@@ -106,8 +106,11 @@ my %virtual_tables =
"eventlist" => { rows => undef, "eventlist" => { rows => undef,
tag => "events", tag => "events",
row => "event", row => "event",
attrs => [ "vname" ]}); attrs => [ "vname" ]},
"event_groups" => { rows => undef,
tag => "event_groups",
row => "event_group",
attrs => [ "group_name", "agent-name" ]});
# XXX # XXX
# The experiment table is special. Only certain fields are allowed to # The experiment table is special. Only certain fields are allowed to
......
...@@ -108,6 +108,10 @@ int address_tuple_free(address_tuple_t); ...@@ -108,6 +108,10 @@ int address_tuple_free(address_tuple_t);
event_notification_remove(handle, note, "OBJTYPE") event_notification_remove(handle, note, "OBJTYPE")
#define event_notification_set_objtype(handle, note, buf) \ #define event_notification_set_objtype(handle, note, buf) \
event_notification_put_string(handle, note, "OBJTYPE", 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 * Event library sets this field. Holds the sender of the event, as
......
This diff is collapsed.
...@@ -157,6 +157,21 @@ CREATE TABLE event_objecttypes ( ...@@ -157,6 +157,21 @@ CREATE TABLE event_objecttypes (
PRIMARY KEY (idx) PRIMARY KEY (idx)
) TYPE=MyISAM; ) 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` -- Table structure for table `eventlist`
-- --
...@@ -170,6 +185,7 @@ CREATE TABLE eventlist ( ...@@ -170,6 +185,7 @@ CREATE TABLE eventlist (
vname varchar(64) NOT NULL default '', vname varchar(64) NOT NULL default '',
objecttype smallint(5) unsigned NOT NULL default '0', objecttype smallint(5) unsigned NOT NULL default '0',
eventtype smallint(5) unsigned NOT NULL default '0', eventtype smallint(5) unsigned NOT NULL default '0',
isgroup tinyint(1) unsigned default '0',
arguments text, arguments text,
atstring text, atstring text,
PRIMARY KEY (pid,eid,idx), PRIMARY KEY (pid,eid,idx),
...@@ -1710,6 +1726,7 @@ CREATE TABLE virt_lans ( ...@@ -1710,6 +1726,7 @@ CREATE TABLE virt_lans (
emulated tinyint(4) default '0', emulated tinyint(4) default '0',
uselinkdelay tinyint(4) default '0', uselinkdelay tinyint(4) default '0',
nobwshaping tinyint(4) default '0', nobwshaping tinyint(4) default '0',
mustdelay tinyint(1) default '0',
usevethiface tinyint(4) default '0', usevethiface tinyint(4) default '0',
trivial_ok tinyint(4) default '1', trivial_ok tinyint(4) default '1',
protocol varchar(30) NOT NULL default 'ethernet', protocol varchar(30) NOT NULL default 'ethernet',
......
...@@ -539,6 +539,7 @@ REPLACE INTO table_regex VALUES ('virt_lans','widearea','int','redirect','defaul ...@@ -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','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','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','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','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_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); 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 ...@@ -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_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','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 ('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` -- Dumping data for table `testsuite_preentables`
......
...@@ -1778,3 +1778,42 @@ last_net_act,last_cpu_act,last_ext_act); ...@@ -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 1.267: Remove table definition that snuck in while developing; skip to
next entry; 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() ...@@ -3469,11 +3469,12 @@ sub LoadVirtLans()
my $useveth = $rowref->{"usevethiface"}; my $useveth = $rowref->{"usevethiface"};
my $trivial_ok = $rowref->{"trivial_ok"}; my $trivial_ok = $rowref->{"trivial_ok"};
my $protocol = $rowref->{"protocol"}; my $protocol = $rowref->{"protocol"};
my $mustdelay = $rowref->{"mustdelay"};
# Extend the DB info with this stuff: # Extend the DB info with this stuff:
# #
# If RED, must insert traffic shapping. # 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. # User has requested the link/lan be emulated. Not typical.
$virt_lans{$vname}->{"EMULATED"} = $isemulated; $virt_lans{$vname}->{"EMULATED"} = $isemulated;
# User has requested "endnodeshaping" (dummynet on end nodes). # User has requested "endnodeshaping" (dummynet on end nodes).
...@@ -3592,21 +3593,6 @@ sub LoadVirtLans() ...@@ -3592,21 +3593,6 @@ sub LoadVirtLans()
"$rdelay $rbandwidth $rlossrate\n"; "$rdelay $rbandwidth $rlossrate\n";
printdb " $port:$vname is a lan of $node\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 virtlanexists($) { return exists($virt_lans{$_[0]}); }
sub virtlanname($) { return $virt_lans{$_[0]}->{"VNAME"}; } sub virtlanname($) { return $virt_lans{$_[0]}->{"VNAME"}; }
......
...@@ -16,7 +16,7 @@ include $(OBJDIR)/Makeconf ...@@ -16,7 +16,7 @@ include $(OBJDIR)/Makeconf
LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \ LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
nsobject.tcl traffic.tcl vtype.tcl parse.tcl program.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 BOSSLIBEXEC = parse-ns
USERLIBEXEC = parse.proxy 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} { ...@@ -32,7 +32,9 @@ SimplexLink instproc init {link dir} {
SimplexLink instproc queue {} { SimplexLink instproc queue {} {
$self instvar mylink $self instvar mylink
$self instvar mydir $self instvar mydir
return [$mylink set ${mydir}queue]
set myqueue [$mylink set ${mydir}queue]
return $myqueue
} }
LLink instproc init {lan node} { LLink instproc init {lan node} {
$self set mylan $lan $self set mylan $lan
...@@ -49,14 +51,10 @@ LLink instproc queue {} { ...@@ -49,14 +51,10 @@ LLink instproc queue {} {
# Don't need any rename procs since these never use their own name and # Don't need any rename procs since these never use their own name and
# can not be generated during Link creation. # 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 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 # These control whether the link was created RED or GRED. It
# filters through the DB. # filters through the DB.
$self set gentle_ 0 $self set gentle_ 0
...@@ -83,15 +81,23 @@ Queue instproc init {link type dir} { ...@@ -83,15 +81,23 @@ Queue instproc init {link type dir} {
if {$type == "RED"} { if {$type == "RED"} {
set red_ 1 set red_ 1
$link mustdelay
} elseif {$type == "GRED"} { } elseif {$type == "GRED"} {
set red_ 1 set red_ 1
set gentle_ 1 set gentle_ 1
$link mustdelay
} elseif {$type != "DropTail"} { } elseif {$type != "DropTail"} {
punsup "Link type $type, using 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} { Queue instproc rename_lanlink {old new} {
$self instvar mylink $self instvar mylink
...@@ -104,19 +110,20 @@ Queue instproc get_link {} { ...@@ -104,19 +110,20 @@ Queue instproc get_link {} {
return $mylink return $mylink
} }
# Hacky. Need to create an association bewteen the queue direction Queue instproc agent_name {} {
# and a dummynet pipe. This should happen later on, but I do not $self instvar mylink
# have time right now to make all the changes. Instead, convert $self instvar mynode
# "to" to "pipe0" and "from" to "pipe1".
Queue instproc get_pipe {} { return "$mylink-$mynode"
$self instvar direction }
if {$direction == "to"} { #
set pipe "pipe0" # A queue is associated with a node on a link. Return that node.
} else { #
set pipe "pipe1" Queue instproc get_node {} {
} $self instvar mynode
return $pipe
return $mynode
} }
Link instproc init {s nodes bw d type} { Link instproc init {s nodes bw d type} {
...@@ -134,8 +141,8 @@ 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 var_import GLOBALS::new_counter
set q1 q[incr new_counter] set q1 q[incr new_counter]
Queue to$q1 $self $type to Queue to$q1 $self $type $src
Queue from$q1 $self $type from Queue from$q1 $self $type $dst
$self set toqueue to$q1 $self set toqueue to$q1
$self set fromqueue from$q1 $self set fromqueue from$q1
...@@ -172,6 +179,13 @@ LanLink instproc init {s nodes bw d type} { ...@@ -172,6 +179,13 @@ LanLink instproc init {s nodes bw d type} {
# Allow user to turn off actual bw shaping on emulated links. # Allow user to turn off actual bw shaping on emulated links.
$self set nobwshaping 0 $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. # Allow user to turn on veth devices on emulated links.
$self set useveth 0 $self set useveth 0
...@@ -242,11 +256,19 @@ LanLink instproc init {s nodes bw d type} { ...@@ -242,11 +256,19 @@ LanLink instproc init {s nodes bw d type} {
lappend nodelist $nodepair lappend nodelist $nodepair
set lq q[incr new_counter] set lq q[incr new_counter]
Queue lq$lq $self $type to Queue lq$lq $self $type $node
set linkq($nodepair) lq$lq set linkq($nodepair) lq$lq
} }
} }
#
# Set the mustdelay flag.
#
LanLink instproc mustdelay {} {
$self instvar mustdelay
set mustdelay 1
}
# get_port <node> # get_port <node>
# This takes a node and returns the port that the node is connected # 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 # to the LAN with. If a node is in a LAN multiple times for some
...@@ -421,7 +443,6 @@ LanLink instproc cost {c} { ...@@ -421,7 +443,6 @@ LanLink instproc cost {c} {
} }
} }
Link instproc rename {old new} { Link instproc rename {old new} {
$self next $old $new $self next $old $new
...@@ -431,6 +452,19 @@ Link instproc rename {old new} { ...@@ -431,6 +452,19 @@ Link instproc rename {old new} {
$fromqueue rename_lanlink $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). # The following methods are for renaming objects (see README).
LanLink instproc rename {old new} { LanLink instproc rename {old new} {
$self instvar nodelist $self instvar nodelist
...@@ -449,6 +483,7 @@ LanLink instproc rename_node {old new} { ...@@ -449,6 +483,7 @@ LanLink instproc rename_node {old new} {
$self instvar rbandwidth $self instvar rbandwidth
$self instvar rdelay $self instvar rdelay
$self instvar rloss $self instvar rloss
$self instvar linkq
$self instvar accesspoint $self instvar accesspoint
# XXX Temporary # XXX Temporary
...@@ -472,16 +507,32 @@ LanLink instproc rename_node {old new} { ...@@ -472,16 +507,32 @@ LanLink instproc rename_node {old new} {
set rbandwidth($newnodeport) $rbandwidth($nodeport) set rbandwidth($newnodeport) $rbandwidth($nodeport)
set rdelay($newnodeport) $rdelay($nodeport) set rdelay($newnodeport) $rdelay($nodeport)
set rloss($newnodeport) $rloss($nodeport) set rloss($newnodeport) $rloss($nodeport)
set linkq($newnodepair) linkq($nodeport)
unset bandwidth($nodeport) unset bandwidth($nodeport)
unset delay($nodeport) unset delay($nodeport)
unset loss($nodeport) unset loss($nodeport)
unset rbandwidth($nodeport) unset rbandwidth($nodeport)
unset rdelay($nodeport) unset rdelay($nodeport)
unset rloss($nodeport) unset rloss($nodeport)
unset linkq($nodeport)
} }
set nodelist $newnodelist 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} { Link instproc updatedb {DB} {
$self instvar toqueue $self instvar toqueue
$self instvar fromqueue $self instvar fromqueue
...@@ -507,6 +558,7 @@ Link instproc updatedb {DB} { ...@@ -507,6 +558,7 @@ Link instproc updatedb {DB} {
$self instvar sim $self instvar sim
$self instvar netmask $self instvar netmask
$self instvar protocol $self instvar protocol
$self instvar mustdelay
if {$protocol != "ethernet"} { if {$protocol != "ethernet"} {
perror "Link must be an ethernet only, not a $protocol" perror "Link must be an ethernet only, not a $protocol"
...@@ -566,7 +618,7 @@ Link instproc updatedb {DB} { ...@@ -566,7 +618,7 @@ Link instproc updatedb {DB} {
set nodeportraw [join $nodeport ":"] 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 # Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not # unless the user gave a value - this way, they get the defaults if not
...@@ -579,7 +631,7 @@ Link instproc updatedb {DB} { ...@@ -579,7 +631,7 @@ Link instproc updatedb {DB} {
lappend fields "rest_bandwidth" 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)] } { if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport) lappend values $ebandwidth($nodeport)
...@@ -621,6 +673,7 @@ Lan instproc updatedb {DB} { ...@@ -621,6 +673,7 @@ Lan instproc updatedb {DB} {
$self instvar accesspoint $self instvar accesspoint
$self instvar settings $self instvar settings
$self instvar member_settings $self instvar member_settings
$self instvar mustdelay
if {$modelnet_cores > 0 || $modelnet_edges > 0} { if {$modelnet_cores > 0 || $modelnet_edges > 0} {
perror "Lans are not allowed when using modelnet; just duplex links." perror "Lans are not allowed when using modelnet; just duplex links."
...@@ -692,7 +745,7 @@ Lan instproc updatedb {DB} { ...@@ -692,7 +745,7 @@ Lan instproc updatedb {DB} {
set is_accesspoint 1 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 # Treat estimated bandwidths differently - leave them out of the lists
# unless the user gave a value - this way, they get the defaults if not # unless the user gave a value - this way, they get the defaults if not
...@@ -705,7 +758,7 @@ Lan instproc updatedb {DB} { ...@@ -705,7 +758,7 @@ Lan instproc updatedb {DB} {
lappend fields "rest_bandwidth" 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)] } { if { [info exists ebandwidth($nodeport)] } {
lappend values $ebandwidth($nodeport) lappend values $ebandwidth($nodeport)
......
...@@ -264,6 +264,7 @@ source ${GLOBALS::libdir}/null.tcl ...@@ -264,6 +264,7 @@ source ${GLOBALS::libdir}/null.tcl
source ${GLOBALS::libdir}/traffic.tcl source ${GLOBALS::libdir}/traffic.tcl
source ${GLOBALS::libdir}/vtype.tcl source ${GLOBALS::libdir}/vtype.tcl
source ${GLOBALS::libdir}/program.tcl source ${GLOBALS::libdir}/program.tcl
source ${GLOBALS::libdir}/event.tcl
################################################## ##################################################
# Redifing Assignment # Redifing Assignment
......
...@@ -23,6 +23,7 @@ ...@@ -23,6 +23,7 @@
Class Simulator Class Simulator
Class Program -superclass NSObject Class Program -superclass NSObject
Class EventGroup -superclass NSObject
Simulator instproc init {args} { Simulator instproc init {args} {
# A counter for internal ids # A counter for internal ids
...@@ -62,6 +63,10 @@ Simulator instproc init {args} { ...@@ -62,6 +63,10 @@ Simulator instproc init {args} {
$self instvar prog_list; $self instvar prog_list;
array set prog_list {} array set prog_list {}
# EventGroup list.
$self instvar eventgroup_list;
array set eventgroup_list {}
var_import ::GLOBALS::last_class var_import ::GLOBALS::last_class
set last_class $self set last_class $self
} }
...@@ -226,6 +231,7 @@ Simulator instproc run {} { ...@@ -226,6 +231,7 @@ Simulator instproc run {} {
$self instvar node_list