Commit 9d051c7c authored by Leigh B Stoller's avatar Leigh B Stoller

Merge branch 'master' of git-public.flux.utah.edu:/flux/git/emulab-devel

parents 5e8d175c 3534c16d
......@@ -177,7 +177,7 @@ my ($dev,$ino,$mode,$nlink,undef,undef,$rdev,$size,
my $if_mod_since = 0;
$if_mod_since = str2time($ENV{HTTP_IF_MODIFIED_SINCE})
if defined $ENV{HTTP_IF_MODIFIED_SINCE};
if ($if_mod_since > 0 && $if_mod_since <= $mtime) {
if ($mtime <= $if_mod_since) {
print "Status: 304 Not Modified\n\n";
} else {
print "Content-Type: $mime_type\n" if defined $mime_type;
......
......@@ -99,6 +99,7 @@ my $EXPT_RESOURCESHOSED = 0;
"virt_simnode_attributes",
"virt_user_environment",
"virt_parameters",
"virt_paths",
# vis_nodes is locked during update in prerender, so we
# will get a consistent dataset when we backup.
"vis_nodes",
......
......@@ -72,6 +72,7 @@ my $debug = 0;
"elabinelab_attributes" => [ "role", "attrkey", "ordering" ],
"virt_tiptunnels" => [ "host", "vnode" ],
"virt_parameters" => [ "name", "value" ],
"virt_paths" => [ "pathname", "segmentname"],
);
#
......@@ -1184,5 +1185,10 @@ use vars qw(@ISA);
@ISA = "VirtExperiment::VirtTableRow";
use VirtExperiment;
package VirtExperiment::VirtTableRow::virt_paths;
use vars qw(@ISA);
@ISA = "VirtExperiment::VirtTableRow";
use VirtExperiment;
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -116,9 +116,12 @@ my %virtual_tables =
"virt_tiptunnels" => { rows => undef,
tag => "tiptunnels",
row => "tiptunnel"},
"virt_parameters" => { rows => undef,
tag => "parameters",
row => "parameter"},
"virt_parameters" => { rows => undef,
tag => "parameters",
row => "parameter"},
"virt_paths" => { rows => undef,
tag => "path_members",
row => "path_member"},
# This is a fake table. See below. If we add more, lets generalize.
"external_sourcefiles" => { rows => undef,
tag => "nsfiles",
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# Copyright (c) 2000-2010 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -9,11 +9,22 @@
#include <event.h>
event_handle_t event_register(char *name, int threaded);
event_handle_t event_register_withkeyfile(char *name, int threaded, char *keyfile);
event_handle_t event_register_withkeydata(char *name, int threaded, unsigned char *keydata, int len);
event_handle_t event_register_withkeyfile_withretry(char *name, int threaded, char *keyfile, int retrycount);
event_handle_t event_register_withkeydata_withretry(char *name, int threaded, unsigned char *keydata, int len, int retrycount);
Register with the testbed event system. NAME specifies the name of
the event server. Returns a pointer to a handle that may be passed
to other event system routines if the operation is successful, NULL
otherwise.
Register with the testbed event system with an optional HMAC key.
In all forms, NAME specifies the name of the event server and THREADED is
an indication as to whether the calling application is multi-threaded.
Returns a pointer to a handle that may be passed to other event system
routines if the operation is successful, NULL otherwise.
The syntax of the NAME parameter is inherited from elvin, and is a subset
of their URI syntax. It is of the form elvin://<server>:<port> where
<server> is the IP or DNS name of the server, and PORT is the TCP port
number to use.
The THREADED parameter should be set to 1 if the registering
client is multi-threaded. If THREADED is 1, the event
......@@ -24,16 +35,16 @@
event loop, and the client must call event_main after connecting in
order to receive notifications.
Elvin note: NAME is a URL of the form "elvin:/[protocol
stack]/[endpoint]", where a protocol stack names a transport
module, a security module, and a marshaling module as a comma
separated list (e.g., "http,none,xml"), and the endpoint format
is dependent on the transport module used. If no protocol
stack is given, the default stack (tcp, none, xdr) is used. For the
testbed's purposes, "elvin://HOSTNAME" should suffice. If NAME
is NULL, then Elvin's server discovery protocol will be used to find
the Elvin server.
In the _withretry forms, RETRYCOUNT is the number of attempt to try
making a connection to the server before failing. Retries happen
at a transport-specific interval, in the case of pubsub (the current
and only supported transport) it is 5 seconds.
In the _withkey* forms, the given KEYDATA and LEN or the contents of
KEYFILE are used as a key for the keyed-hash MAC computation to
authenticate all events sent or received via the returned handle.
The HMAC is a SHA1 hash computed using the OpenSSL HMAC_* routines.
Event HMACs appear as opaque attributes in events.
* event_unregister: Unregister with the testbed event system
......@@ -52,9 +63,20 @@
int event_main(event_handle_t handle);
Enter the main loop of the event system, waiting to receive event
notifications. Returns non-zero if the operation is successful, 0
otherwise.
notifications. Remains in the main loop until an error occurs or
event_stop_main is called. Returns non-zero if the operation is
successful, 0 otherwise. Should only be called by single-threaded
programs.
* event_stop_main: Force event_main to return
#include <event.h>
event_stop_main(event_handle_t handle)
Can be called from an event handler or signal handler to force the
main loop to return, either to check for a completion condition or
to handle other, non event related processing.
* event_notify: Send an event notification
......@@ -67,6 +89,8 @@
allocated by event_notification_alloc, and may optionally
have attributes added to it by event_notification_put_*.
Returns non-zero if the operation is successful, 0 otherwise.
If HANDLE has an associated hash key, an HMAC is computed and
added as an attribute before sending.
Note that NOTIFICATION is not deallocated by event_notify. The
caller is responsible for deallocating the notification when it
......@@ -81,15 +105,23 @@
event_notification_t notification,
struct timeval *time);
Schedule the event notification NOTIFICATION to be sent at time
TIME. NOTIFICATION is allocated by event_notification_alloc,
Send the indicated notification as a "scheduled" event.
NOTIFICATION is allocated by event_notification_alloc,
and may optionally have attributes added to it by
event_notification_put_*. Returns non-zero if the operation
is successful, 0 otherwise.
This function essentially operates as a deferred event_notify.
event_notify sends notifications immediately,
whereas event_schedule sends notifications at some later time.
event_notify sends notifications immediately to recipients,
whereas event_schedule causes notifications to be sent at
some later time.
IMPORTANT NOTE: scheduled events are NOT held in the calling process
for later delivery. Instead, event_schedule adds a SCHEDULER=1 attribute
to the notification along with attributes for the delivery time, and
then uses event_notify to immediately send the event. There must be
an event agent subscribed to SCHEDULER events that implements the
queuing and later sending of the unadorned notification.
Note that NOTIFICATION is not deallocated by event_schedule.
The caller is responsible for deallocating the notification
......
......@@ -21,8 +21,6 @@
#
my $PREFIX = '@prefix@';
my $SRCDIR = '@srcdir@';
my $TOP_SRCDIR = '@top_srcdir@';
my $DBNAME = "@TBDBNAME@";
my $ERRORLOG_DBNAME = "@TBERRORLOGDBNAME@";
my $ELABINELAB = @ELABINELAB@;
my $WINSUPPORT = @WINSUPPORT@;
......@@ -79,7 +77,6 @@ my $MOUNT = "/sbin/mount";
my $SUDO = "/usr/local/bin/sudo";
my $SUIDPERL = "/usr/bin/suidperl";
my $MYSQL = "/usr/local/bin/mysql";
my $MYSQLADMIN = "/usr/local/bin/mysqladmin";
my $MYSQLSHOW = "/usr/local/bin/mysqlshow";
my $MYSQLDUMP = "/usr/local/bin/mysqldump";
......@@ -807,7 +804,7 @@ Phase "syslog", "Setting up syslog", sub {
"$LOGDIR/stated.log 640 9 1000 * Z ".
"/var/run/stated.pid 31",
"$LOGDIR/checknodes.log 640 14 300 * Z ".
"/var/run/checknodes.pid",
"/var/run/checknodes_daemon.pid",
"$LOGDIR/osselect.log 640 9 300 * Z",
"$LOGDIR/power.log 640 7 300 * Z",
"$LOGDIR/frisbeed.log 640 7 300 * Z",
......@@ -824,7 +821,17 @@ Phase "syslog", "Setting up syslog", sub {
"$LOGDIR/plablinkdata.log 640 7 1000 * Z",
"$LOGDIR/xmlrpcbag.log 640 7 300 * Z",
"$LOGDIR/sshxmlrpc.log 640 7 300 * Z",
"$LOGDIR/sslxmlrpc.log 640 7 300 * Z");
"$LOGDIR/sslxmlrpc.log 640 7 300 * Z",
"$LOGDIR/reloadlog 640 9 1000 * Z ".
"/var/run/reload_daemon.pid",
"$LOGDIR/checkuplog 640 9 1000 * Z ".
"/var/run/checkup_daemon.pid",
"$LOGDIR/poollog 640 9 1000 * Z ".
"/var/run/pool_daemon.pid",
"$LOGDIR/expire_daemon.log 640 9 1000 * Z ".
"/var/run/expire_daemon.pid",
"$LOGDIR/sa_daemon.log 640 9 1000 * Z ".
"/var/run/sa_daemon.pid");
};
};
......@@ -936,6 +943,46 @@ Phase "database", "Setting up database", sub {
}
ExecQuietFatal("$MYSQL $ERRORLOG_DBNAME < $TOP_SRCDIR/sql/database-create-errorlog.sql");
};
Phase "version_info", "Initializing version_info table", sub {
my $SQLUPDATES =
"$TOP_SRCDIR/sql/updates/$SQL_UPDATE_MAJOR_REVISION";
my $INUPDATES =
"$TOP_SRCDIR/install/updates/$INSTALL_UPDATE_MAJOR_REVISION";
my ($exitval, @results) =
ExecQuiet("echo 'select * from version_info' | $MYSQL -s $DBNAME");
if ($exitval) {
PhaseFail("Error running query");
}
if (scalar(@results)) {
PhaseSkip("Already done");
}
($exitval, @results) =
ExecQuiet("cd $SQLUPDATES ; ls | sort -n -r | head -1");
if ($exitval) {
PhaseFail("Error getting sql update list");
}
my $sqlfile = $results[0];
chomp($sqlfile);
($exitval, @results) =
ExecQuiet("cd $INUPDATES ; ls | sort -n -r | head -1");
if ($exitval) {
PhaseFail("Error getting install update list");
}
my $updatefile = $results[0];
chomp($updatefile);
my $sqlval = $SQL_UPDATE_MAJOR_REVISION . "." . $sqlfile;
my $upval = $INSTALL_UPDATE_MAJOR_REVISION . "." . $updatefile;
ExecQuietFatal("echo 'insert into version_info set ".
" name=\"dbrev\", value=\"$sqlval\"' ".
"| $MYSQL -s $DBNAME");
ExecQuietFatal("echo 'insert into version_info set ".
" name=\"install\", value=\"$upval\"' ".
"| $MYSQL -s $DBNAME");
};
};
Phase "rc.conf", "Adding testbed content to $RCCONF", sub {
......
......@@ -18,7 +18,6 @@
# Configure variables
#
my $PREFIX = '@prefix@';
my $TOP_SRCDIR = '@top_srcdir@';
my $OURDOMAIN = '@OURDOMAIN@';
my $USERNODE = '@USERNODE@';
......
......@@ -10,17 +10,20 @@
#
use POSIX qw(strftime);
use Exporter;
use vars qw(@EXPORT $TOP_OBJDIR
use vars qw(@EXPORT $TOP_OBJDIR $TOP_SRCDIR
$TBROOT $LOGDIR $MAINSITE $PGENISUPPORT $GMAKE $PKG_INFO
$PORTSDIR $VARRUN $RCDIR);
$PORTSDIR $VARRUN $RCDIR $MYSQL $DBNAME
$SQL_UPDATE_MAJOR_REVISION $INSTALL_UPDATE_MAJOR_REVISION);
@EXPORT = qw($TOP_OBJDIR
@EXPORT = qw($TOP_OBJDIR $TOP_SRCDIR
$TBROOT $LOGDIR $MAINSITE $PGENISUPPORT $GMAKE $PKG_INFO
$PORTSDIR $VARRUN $RCDIR);
$PORTSDIR $VARRUN $RCDIR $MYSQL $DBNAME
$SQL_UPDATE_MAJOR_REVISION $INSTALL_UPDATE_MAJOR_REVISION);
# Configure variables
$TBROOT = "@prefix@";
$TOP_SRCDIR = "@top_srcdir@";
$LOGDIR = "$TBROOT/log";
$MAINSITE = @TBMAINSITE@;
$PGENISUPPORT = @PROTOGENI_SUPPORT@;
......@@ -30,6 +33,14 @@ $PORTSDIR = "/usr/ports";
$VARRUN = "/var/run";
$RCDIR = "/usr/local/etc/rc.d";
$DBNAME = "@TBDBNAME@";
$MYSQL = "/usr/local/bin/mysql";
# Change these if the major numbers in sql/updates or install/updates
# are changed.
$SQL_UPDATE_MAJOR_REVISION = 4;
$INSTALL_UPDATE_MAJOR_REVISION = 5;
#
# Make sure that output gets printed right away
#
......@@ -38,7 +49,7 @@ $| = 1;
#
# Magic string that shows up in files already edited
#
my $MAGIC_TESTBED_VERSION = "5.0";
my $MAGIC_TESTBED_VERSION = $INSTALL_UPDATE_MAJOR_REVISION + ".0";
my $MAGIC_TESTBED_START = "Added by Emulab - Version: ";
my $MAGIC_TESTBED_END = "End of Emulab added section";
......
......@@ -218,7 +218,6 @@ my $HTTPD_CONF = "$APACHE_ETCDIR/httpd.conf";
my $WWWDIR = "/usr/local/www/data";
# For installing mysqld
my $MYSQL = "/usr/local/bin/mysql";
my $MYSQLADMIN = "/usr/local/bin/mysqladmin";
my $MYSQLSHOW = "/usr/local/bin/mysqlshow";
my $MYSQLDUMP = "/usr/local/bin/mysqldump";
......@@ -233,7 +232,6 @@ my $LIST_DIR = "/etc/mail/lists";
my $TIPLOG_DIR = "/var/log/tiplogs";
my $PORTSMISCDIR = "$PORTSDIR/misc";
my $SRCDIR = '@srcdir@';
my $TOP_SRCDIR = "@top_srcdir@";
#
# And some lists that we use
......
......@@ -64,12 +64,18 @@ $| = 1;
BEGIN
{
if (-e "../Makeconf") {
my $srcdir = "@top_srcdir@";
my $objdir = `/bin/pwd`;
chomp($objdir);
# Prior to first install or running from object dir.
unshift(@INC, "$objdir/../db");
unshift(@INC, "$objdir/@top_srcdir@/install");
unshift(@INC, "$objdir/@top_srcdir@/tbsetup");
if ($srcdir =~ /^\//) {
unshift(@INC, "$srcdir/install");
unshift(@INC, "$srcdir/tbsetup");
} else {
unshift(@INC, "$objdir/$srcdir/install");
unshift(@INC, "$objdir/$srcdir/tbsetup");
}
unshift(@INC, "$objdir/../tbsetup");
}
}
......@@ -117,10 +123,17 @@ if (! (-e "../db/dbupdate" && -e "./update-install")) {
my $objdir = `/bin/pwd`;
chomp($objdir);
my $abssrcdir;
if ($SRCDIR =~ /^\//) {
$abssrcdir = "$SRCDIR";
} else {
$abssrcdir = "$objdir/$SRCDIR";
}
my @INCDIRS = ("-I${objdir}", "-I${objdir}/../tbsetup",
"-I${objdir}/../db",
"-I${objdir}/${SRCDIR}/tbsetup",
"-I${objdir}/${SRCDIR}/install",
"-I${abssrcdir}/tbsetup",
"-I${abssrcdir}/install",
# To catch a few extra things that do not normally change.
"-I@prefix@/lib"
);
......
......@@ -3829,6 +3829,8 @@ CREATE TABLE `virt_lans` (
`trace_db` tinyint(1) NOT NULL default '0',
`fixed_iface` varchar(128) default '',
`layer` tinyint(4) NOT NULL default '2',
`implemented_by_path` tinytext,
`implemented_by_link` tinytext,
PRIMARY KEY (`exptidx`,`vname`,`vnode`,`vport`),
UNIQUE KEY `vport` (`pid`,`eid`,`vname`,`vnode`,`vport`),
KEY `pid` (`pid`,`eid`,`vname`),
......@@ -3932,6 +3934,25 @@ CREATE TABLE `virt_parameters` (
UNIQUE KEY `pideid` (`pid`,`eid`,`name`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `virt_paths`
--
DROP TABLE IF EXISTS `virt_paths`;
CREATE TABLE `virt_paths` (
`pid` varchar(12) NOT NULL default '',
`eid` varchar(32) NOT NULL default '',
`exptidx` int(11) NOT NULL default '0',
`pathname` varchar(32) NOT NULL default '',
`segmentname` varchar(32) NOT NULL default '',
`segmentindex` tinyint(4) unsigned NOT NULL default '0',
`layer` tinyint(4) NOT NULL default '0',
PRIMARY KEY (`exptidx`,`pathname`,`segmentname`),
UNIQUE KEY `segidx` (`exptidx`,`pathname`,`segmentindex`),
KEY `pid` (`pid`,`eid`,`pathname`),
KEY `pideid` (`pid`,`eid`,`pathname`,`segmentname`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `virt_programs`
--
......
......@@ -691,7 +691,7 @@ REPLACE INTO table_regex VALUES ('virt_node_desires','desire','text','regex','^[
REPLACE INTO table_regex VALUES ('virt_node_desires','weight','int','redirect','default:float',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','pid','text','redirect','projects:pid',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','eid','text','redirect','experiments:eid',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','ips','text','regex','^(\\d{1,2}:\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3} {0,1})*$',0,1024,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','ips','text','regex','^(\\d{1,2}:\\d{1,3}\\.\\d{1,3}\\.\\d{1,3}\\.\\d{1,3} {0,1})*$',0,2048,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','osname','text','redirect','os_info:osname',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','cmd_line','text','redirect','default:tinytext',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_nodes','rpms','text','regex','^([-\\w\\.\\/\\+:~]+;{0,1})*$',0,4096,NULL);
......@@ -970,6 +970,14 @@ REPLACE INTO table_regex VALUES ('user_pubkeys','verify','text','redirect','defa
REPLACE INTO table_regex VALUES ('user_pubkeys','user','text','redirect','users:uid',0,0,NULL);
REPLACE INTO table_regex VALUES ('user_pubkeys','keyfile','text','regex','^[-_\\w\\.\\/:+]*$',1,256,NULL);
REPLACE INTO table_regex VALUES ('virt_paths','pathname','text','redirect','virt_nodes:vname',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_paths','segmentname','text','redirect','virt_nodes:vname',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_paths','segmentindex','int','redirect','default:tinyuint',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_paths','layer','int','redirect','default:tinyint',0,0,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','implemented_by_path','text','redirect','virt_paths:pathname',1,128,NULL);
REPLACE INTO table_regex VALUES ('virt_lans','implemented_by_link','text','redirect','default:tinytext',0,0,NULL);
REPLACE INTO table_regex VALUES ('elabinelab_attributes','role','text','regex','^(boss|router|ops|fs|node)$',0,0,NULL);
REPLACE INTO table_regex VALUES ('elabinelab_attributes','attrkey','text','regex','^[-\\w\\.]+$',1,32,NULL);
REPLACE INTO table_regex VALUES ('elabinelab_attributes','attrvalue','text','regex','^[-\\w\\.\\+,\\s\\/]+$',0,255,NULL);
......
#
# Add virt_paths
#
use strict;
use libdb;
sub DoUpdate($$$)
{
my ($dbhandle, $dbname, $version) = @_;
if (!DBTableExists("virt_paths")) {
DBQueryFatal("CREATE TABLE `virt_paths` ( ".
" `pid` varchar(12) NOT NULL default '', ".
" `eid` varchar(32) NOT NULL default '', ".
" `exptidx` int(11) NOT NULL default '0', ".
" `pathname` varchar(32) NOT NULL default '', ".
" `segmentname` varchar(32) NOT NULL default '', ".
" `segmentindex` tinyint(4) unsigned NOT NULL default '0', ".
" `layer` tinyint(4) NOT NULL default '0', ".
" PRIMARY KEY (`exptidx`,`pathname`,`segmentname`), ".
" UNIQUE KEY `segidx` (`exptidx`,`pathname`,`segmentindex`), ".
" KEY `pid` (`pid`,`eid`,`pathname`), ".
" KEY `pideid` (`pid`,`eid`,`pathname`,`segmentname`) ".
") ENGINE=MyISAM DEFAULT CHARSET=latin1");
}
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_paths', 'pathname', 'text', 'redirect', ".
" 'virt_nodes:vname', 0,0,NULL)");
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_paths', 'segmentname', 'text', 'redirect', ".
" 'virt_nodes:vname', 0,0,NULL)");
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_paths', 'segmentindex', 'int', 'redirect', ".
" 'default:tinyuint', 0,0,NULL)");
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_paths', 'layer', 'int', 'redirect', ".
" 'default:tinyint', 0,0,NULL)");
if (!DBSlotExists("virt_lans", "implemented_by_path")) {
DBQueryFatal("ALTER TABLE virt_lans ADD ".
" `implemented_by_path` tinytext");
}
if (!DBSlotExists("virt_lans", "implemented_by_link")) {
DBQueryFatal("ALTER TABLE virt_lans ADD ".
" `implemented_by_link` tinytext");
}
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_lans', 'implemented_by_path', 'text', 'redirect', ".
" 'virt_paths:pathname', 1,128,NULL)");
DBQueryFatal("REPLACE INTO table_regex VALUES" .
" ('virt_lans', 'implemented_by_link', 'text', 'redirect', ".
" 'default:tinytext', 0,0,NULL)");
# Unrelated bug fix.
DBQueryFatal("REPLACE INTO table_regex VALUES ".
" ('virt_nodes','ips','text','regex', ".
" '^(\\\\d{1,2}:\\\\d{1,3}\\\\.\\\\d{1,3}\\\\.\\\\d{1,3}\\\\.\\\\d{1,3} {0,1})*\$',".
" 0,2048,NULL)");
return 0;
}
1;
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2006 University of Utah and the Flux Group.
# Copyright (c) 2000-2010 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -19,7 +19,7 @@ LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
nsenode.tcl nstb_compat.tcl event.tcl firewall.tcl \
elabinelab.ns elabinelab-withfsnode.ns \
fw.ns timeline.tcl sequence.tcl \
topography.tcl console.tcl
topography.tcl console.tcl path.tcl
BOSSLIBEXEC = parse-ns
USERLIBEXEC = parse.proxy
......
......@@ -214,8 +214,9 @@ LanLink instproc init {s nodes bw d type} {
# XXX Allow user to set the accesspoint.
$self set accesspoint {}
# Optional layer
# Optional layer and implemented-by relationship
$self set layer {}
$self set implemented_by {}
# A simulated lanlink unless we find otherwise
$self set simulated 1
......@@ -324,6 +325,37 @@ Link instproc trace {{ttype "header"} {texpr ""}} {
$fromqueue trace $ttype $texpr
}
#
# A link can be implemented in terms of a path or
# a link at a lower level of the stack.
#
Link instproc implemented_by {impl} {
$self instvar implemented_by
$self instvar layer
if {[$impl info class] == "Path"} {
set implemented_by $impl
} elseif {[$impl info class] == "Link"} {
if {$layer == {}} {
perror "\[$self implemented_by] no layer set!"
return
}
set impl_layer [$impl set layer]
if {$impl_layer == {}} {
perror "\[$self implemented_by] no layer set in $impl!"
return
}
if {$impl_layer >= $layer} {
perror "\[$self implemented_by] $impl is not at a lower layer!"
return
}
set implemented_by $impl
} else {
perror "\[$self implemented_by] must be a link or a path!"
return
}
}
Lan instproc trace_snaplen {len} {
$self instvar nodelist
$self instvar linkq
......@@ -720,6 +752,7 @@ Link instproc updatedb {DB} {
$self instvar mustdelay
$self instvar fixed_iface
$self instvar layer
$self instvar implemented_by
$sim spitxml_data "virt_lan_lans" [list "vname"] [list $self]
......@@ -810,6 +843,13 @@ Link instproc updatedb {DB} {
if { $layer != {} } {
lappend fields "layer"
}
if { $implemented_by != {} } {
if {[$implemented_by info class] == "Path"} {
lappend fields "implemented_by_path"
} else {
lappend fields "implemented_by_link"
}
}
set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $backfill($nodeport) $rbackfill($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $node $port $ip $mustdelay]
......@@ -839,6 +879,9 @@ Link instproc updatedb {DB} {
if { $layer != {} } {
lappend values $layer
}
if { $implemented_by != {} } {
lappend values $implemented_by
}
$sim spitxml_data "virt_lans" $fields $values
}
......
......@@ -261,6 +261,9 @@ Simulator instproc make-cloud {nodes bw delay args} {
return [$self make-lan $nodes $bw $delay]
}
Simulator instproc make-path {linklist} {
}
Node instproc program-agent {args} {
}
......@@ -289,5 +292,8 @@ LanNode instproc trace {args} {
LanNode instproc trace_endnode {args} {
}
LanNode instproc implemented_by {args} {
}
LanNode instproc unknown {m args} {
}
......@@ -364,6 +364,7 @@ namespace eval GLOBALS {
source ${GLOBALS::libdir}/nsobject.tcl
source ${GLOBALS::libdir}/sim.tcl
source ${GLOBALS::libdir}/lanlink.tcl
source ${GLOBALS::libdir}/path.tcl
source ${GLOBALS::libdir}/node.tcl
source ${GLOBALS::libdir}/null.tcl
source ${GLOBALS::libdir}/traffic.tcl
......
# -*- tcl -*-
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2010 University of Utah and the Flux Group.
# All rights reserved.
#
######################################################################
# path.tcl
#
# A path is comprised of a set of links.
######################################################################
Class Path -superclass NSObject
namespace eval GLOBALS {
set new_classes(Path) {}
}
Path instproc init {s links} {
# This is a list of the links
$self set mylinklist $links
# The simulator
$self set sim $s
}
Path instproc rename {old new} {
$self instvar sim
$self instvar mylinklist
$sim rename_path $old $new
}
Path instproc updatedb {DB} {
$self instvar mylinklist
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
$self instvar sim
set idx 0
foreach link $mylinklist {
set fields [list "pathname" "segmentname" "segmentindex"]
set values [list $self $link $idx]
$sim spitxml_data "virt_paths" $fields $values
incr idx
}
}
......@@ -47,6 +47,8 @@ Simulator instproc init {args} {
array set lanlink_list {}
$self instvar subnets; # Indexed by IP subnet
array set subnets {}
$self instvar path_list; # Indexed by path id
array set path_list {}
# link_map is indexed by <node1>:<node2> and contains the
# id of the lanlink connecting them. In the case of
......@@ -271,6 +273,21 @@ Simulator instproc make-lan {nodelist bw delay args} {
return $curlan
}
# make-path <linklist>
Simulator instproc make-path {linklist args} {
var_import ::GLOBALS::last_class
$self instvar id_counter
$self instvar path_list
set curpath tbpath-path[incr id_counter]
Path $curpath $self $linklist
set path_list($curpath) {}
set last_class $curpath
return $curpath
}
Simulator instproc make-cloud {nodelist bw delay args} {
$self instvar event_list
$self instvar event_count
......@@ -349,6 +366,7 @@ Simulator instproc event-group {{list {}}} {
# method casues the 'ran' variable to be set to 1.
Simulator instproc run {} {
$self instvar lanlink_list
$self instvar path_list
$self instvar node_list
$self instvar event_list
$self instvar prog_list
......@@ -580,6 +598,9 @@ Simulator instproc run {} {
foreach tg [array names topography_list] {
$tg updatedb "sql"
}
foreach path [array names path_list] {
$path updatedb "sql"
}
set fields [list "mem_usage" "cpu_usage" "forcelinkdelays" "uselinkdelays" "usewatunnels" "uselatestwadata" "wa_delay_solverweight" "wa_bw_solverweight" "wa_plr_solverweight" "encap_style" "allowfixnode"]
set values [list $mem_usage $cpu_usage $forcelinkdelays $uselinkdelays $usewatunnels $uselatestwadata $wa_delay_solverweight $wa_bw_solverweight $wa_plr_solverweight $vlink_encapsulate $fix_current_resources]
......@@ -954,6 +975,12 @@ Simulator instproc rename_topography {old new} {
set topography_list($new) {}
}
Simulator instproc rename_path {old new} {
$self instvar path_list
unset path_list($old)
set path_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.
......
......@@ -1191,13 +1191,14 @@ if ($widearea && ! defined($component_name)) {
if ($genimode ne $NO_GENI) {
foreach $key (keys %interfaceroles) {
if (is_public_interface($key)) {
$key =~ /^([^:]+):([^:]+)$/;
my $node = $1;
my $iface = $2;
if (defined($nodes{$node})) {
print_simple_link($node, $iface,
$fake_inet_switch, $fake_inet_iface,
100000, 0, 0, @inet_protos);
if ($key =~ /^([^:]+):([^:]+)$/) {
my $node = $1;