Commit 29e2ab09 authored by Leigh Stoller's avatar Leigh Stoller

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

parents 84eb77fd 437cc337
......@@ -1588,6 +1588,7 @@ STANDALONE_CLEARINGHOUSE=0
NODE_USAGE_SUPPORT=0
EXP_VIS_SUPPORT=0
NOSTACKMIB=0
SELFLOADER_DATA="__DATA__"
#
# XXX You really don't want to change these!
......@@ -1952,6 +1953,16 @@ cat >> confdefs.h <<EOF
EOF
#
# Perl SelfLoader
# XXX this is a hack which enables us to disable it on versions of perl
# where there are problems with taint checking in the SelfLoader module.
#
cat >> confdefs.h <<EOF
#define SELFLOADER_DATA "$SELFLOADER_DATA"
EOF
#
# LEDA library path
#
......@@ -2135,7 +2146,6 @@ else
event/linktest/GNUmakefile \
event/linktest/iperf/GNUmakefile \
event/linktest/rude/GNUmakefile \
event/linktest/linktest.pl \
event/linktest/weblinktest event/linktest/linktest.proxy \
event/linktest/linktest_control \
event/linktest/run_linktest.pl";
......@@ -3094,6 +3104,7 @@ s%@GMAP_API_KEY@%$GMAP_API_KEY%g
s%@NODE_USAGE_SUPPORT@%$NODE_USAGE_SUPPORT%g
s%@NOSTACKMIB@%$NOSTACKMIB%g
s%@EXP_VIS_SUPPORT@%$EXP_VIS_SUPPORT%g
s%@SELFLOADER_DATA@%$SELFLOADER_DATA%g
s%@TBOPSEMAIL@%$TBOPSEMAIL%g
s%@TBOPSEMAIL_NOSLASH@%$TBOPSEMAIL_NOSLASH%g
s%@TBROBOCOPSEMAIL@%$TBROBOCOPSEMAIL%g
......
......@@ -219,6 +219,7 @@ AC_SUBST(GMAP_API_KEY)
AC_SUBST(NODE_USAGE_SUPPORT)
AC_SUBST(NOSTACKMIB)
AC_SUBST(EXP_VIS_SUPPORT)
AC_SUBST(SELFLOADER_DATA)
#
# Offer both versions of the email addresses that have the @ escaped
......@@ -307,6 +308,7 @@ STANDALONE_CLEARINGHOUSE=0
NODE_USAGE_SUPPORT=0
EXP_VIS_SUPPORT=0
NOSTACKMIB=0
SELFLOADER_DATA="__DATA__"
#
# XXX You really don't want to change these!
......@@ -546,6 +548,13 @@ if test -z "$EVENTSERVER"; then
fi
AC_DEFINE_UNQUOTED(EVENTSERVER, "$EVENTSERVER")
#
# Perl SelfLoader
# XXX this is a hack which enables us to disable it on versions of perl
# where there are problems with taint checking in the SelfLoader module.
#
AC_DEFINE_UNQUOTED(SELFLOADER_DATA, "$SELFLOADER_DATA")
#
# LEDA library path
#
......@@ -692,7 +701,6 @@ else
event/linktest/GNUmakefile \
event/linktest/iperf/GNUmakefile \
event/linktest/rude/GNUmakefile \
event/linktest/linktest.pl \
event/linktest/weblinktest event/linktest/linktest.proxy \
event/linktest/linktest_control \
event/linktest/run_linktest.pl";
......
......@@ -172,9 +172,8 @@ $TBOPSPID = "emulab-ops";
$EXPTLOGNAME = "activity.log";
$PROJROOT = "@PROJROOT_DIR@";
# _Always_ make sure that this 1 is at the end of the file...
1;
__DATA__
@SELFLOADER_DATA@
#
# Needs to be configured.
......@@ -649,4 +648,5 @@ sub TBMinTrust($$)
return $trust_value >= $minimum;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -336,13 +336,15 @@ sub Stringify($)
return "[Experiment: $pid/$eid]";
}
# Keep this above @SELFLOADER_DATA@ ... elabinelab is a slot in
# the stats stats record, but was not being updated
sub elabinelab($) { return $_[0]->elab_in_elab(); }
1;
__DATA__
@SELFLOADER_DATA@
sub dbrow($$) { return $_[0]->{'EXPT'}; }
sub locked($) { return $_[0]->expt_locked(); }
sub elabinelab($) { return $_[0]->elab_in_elab(); }
sub description($){ return $_[0]->expt_name(); }
sub creator($) { return $_[0]->expt_head_uid(); }
sub created($) { return $_[0]->expt_created(); }
......@@ -4507,5 +4509,3 @@ sub ReserveSharedBandwidth($;$$)
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -1036,6 +1036,7 @@ sub IsProjectGroup($)
sub GetProject($)
{
my ($self) = @_;
require Project;
# Must be a real reference.
return undef
......
......@@ -175,9 +175,8 @@ sub LocalExpLookup(@)
return Experiment->Lookup(@_);
}
# _Always_ make sure that this 1 is at the end of the file...
1;
__DATA__
@SELFLOADER_DATA@
#
# Create a fake object, as for the mapper (assign_wrapper) during debugging.
......@@ -1675,9 +1674,9 @@ sub SetEventState($$)
# be used when creating the new node(s). A list of the node names is
# returned.
#
sub CreateVnodes($$)
sub CreateVnodes($$$)
{
my ($rptr, $options) = @_;
my ($class, $rptr, $options) = @_;
my @created = ();
my @tocreate = ();
require Interface;
......@@ -2640,5 +2639,6 @@ sub IsOSLoaded($$)
return $query_result->numrows;
}
1;
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -58,9 +58,8 @@ sub _checklossrate($)
return 1;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
__DATA__
@SELFLOADER_DATA@
# Constants for checkslot code.
sub TBDB_CHECKDBSLOT_NOFLAGS() { 0x0; }
......@@ -462,4 +461,5 @@ sub ParRun($$$@)
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -101,9 +101,8 @@ sub TBdbfork()
sub hash_recurse2($%);
sub array_recurse2($%);
# _Always_ make sure that this 1 is at the end of the file...
1;
__DATA__
@SELFLOADER_DATA@
# Local lookup for a Node, to avoid dragging in the module.
sub LocalNodeLookup($)
......@@ -2632,5 +2631,6 @@ sub TBSetNodeHistory($$$$$)
}
return $node->SetNodeHistory($op, $this_user, $experiment);
}
1;
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -52,6 +52,8 @@ ELVIN_COMPAT=changeme
# The name of the outer boss for inner boss to request services from.
OUTERBOSS_NODENAME=changeme
TBCOOKIESUFFIX=changeme
# XXX hack to work around perl bug
SELFLOADER_DATA=changeme
#
# SSL Certificate stuff. Used to customize config files in ssl directory.
# Note that OrganizationalUnit is set in the cnf file.
......
#!/usr/bin/perl -w -T
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
# Copyright (c) 2010 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
my $PROJROOT = "@PROJROOT_DIR@";
my $CLIENT_VARDIR = "@CLIENT_VARDIR@";
my $CLIENT_BINDIR = "@CLIENT_BINDIR@";
my $EVENTSERVER = "@EVENTSERVER@";
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
my $argString = join(" ", @ARGV);
my $argString .= " LOGDIR=$PROJROOT VARDIR=$CLIENT_VARDIR BINDIR=$CLIENT_BINDIR EVENTSERVER=$EVENTSERVER";
my $linktest = "@CLIENT_BINDIR@/linktest.pl";
system("$CLIENT_BINDIR/linktest.pl $argString");
my @emulab_defaults = (
"PROJDIR=@PROJROOT_DIR@",
"VARDIR=@CLIENT_VARDIR@",
"BINDIR=@CLIENT_BINDIR@",
"EVENTSERVER=@EVENTSERVER@"
);
my $argString = join(" ", @emulab_defaults);
# add these after the defaults so we can override the defaults
$argString .= " " . join(" ", @ARGV);
exec("$linktest $argString") or
die("could not exec linktest.pl");
......@@ -15,11 +15,6 @@ use Socket;
my $LINKTEST_VERSION = "1.2";
#
# XXX config stuff that does not belong on the client-side
#
#my $PROJROOT = "@PROJROOT_DIR@";
#
# Linktest test script. This script is set up to run as root on
# experiment nodes. It is invoked by the Linktest daemon after the
......@@ -182,7 +177,6 @@ my $rtproto; # routing protocol
my $hostname; # this hosts name
my $exp_id; # experiment id
my $proj_id; # project id
my $gid; # group id
my $platform; # name of platform
my $startat=1; # which test to start at
my $stopat=99; # which test to stop at
......@@ -207,7 +201,6 @@ my %linkmembers;
my @links; # links: list of edge structs.
# sorted alphabetically by src . dst
my $expt_path; # experiment path (ie, tbdata) set by init.
my $linktest_path; # log path (ie tbdata/linktest) set by init.
my $simname = "ns";
my $swapper = "";
......@@ -237,11 +230,15 @@ $| = 1; #Turn off line buffering on output
# Make sure that files written into the experiment subdir are group writable.
umask(0002);
# Traditional Emulab defaults that can be overridden but must be set
our $VARDIR = "/var/emulab";
our $BINDIR = "/usr/local/etc/emulab";
our $PROJDIR = "/proj";
our $LOGRUN = "";
our $PROJROOT = "";
our $VARDIR = "";
our $BINDIR = "";
our $LOGDIR = "";
our $EVENTSERVER = "";
our $EVENTID = "";
#
# Parse command arguments. Since Linktest is run via the event system,
......@@ -280,11 +277,14 @@ foreach my $arg (@ARGV) {
$LOGRUN = $1;
}
if($arg =~ /LOGDIR=(.+)/) {
$PROJROOT = $1;
$LOGDIR = $1;
}
if($arg =~ /VARDIR=(.+)/) {
$VARDIR = $1;
}
if($arg =~ /PROJDIR=(.+)/) {
$PROJDIR = $1;
}
if($arg =~ /BINDIR=(.+)/) {
$BINDIR = $1;
}
......@@ -330,28 +330,32 @@ if ($printsched) {
# experiment ID and the project ID.
#
my $fname = $PATH_NICKNAME;
die("Could not locate $fname\n") unless -e $fname;
my @results = &read_file($fname);
($hostname, $exp_id, $proj_id) = split /\./, $results[0];
chomp $hostname;
chomp $exp_id;
chomp $proj_id;
# taint check pid/eid
if ($proj_id =~ /([-\w]*)/) {
$proj_id = $1;
}
if ($exp_id =~ /([-\w]*)/) {
$exp_id = $1;
if (-r $fname) {
my $name = `cat $fname`;
if ($name =~ /([-\@\w]*)\.([-\@\w]*)\.([-\@\w]*)/) {
$hostname = $1;
$exp_id = $2;
$proj_id = $3;
} else {
die("Could not parse $fname info\n");
}
} else {
die("Could not locate $fname\n");
}
$gid = $proj_id;
#
# Now that we know the pid/eid, defaults some values (unless otherwise set).
#
$LOGDIR = "$PROJDIR/$proj_id/exp/$exp_id/tbdata"
if ($LOGDIR eq "");
$EVENTID = "$proj_id/$exp_id"
if ($EVENTID eq "");
#
# Set path variables storing the experiment logging path,
# the current ns file and the output file for topology info.
#
$expt_path = "$PROJROOT/$proj_id/exp/$exp_id/tbdata";
$linktest_path = "$expt_path/linktest";
$linktest_path = "$LOGDIR/linktest";
$topology_file = $PATH_TOPOFILE;
$ptopology_file = $PATH_PTOPOFILE;
......@@ -380,7 +384,7 @@ sleep(int(rand(5)));
$synserv = "";
my $ssname = $PATH_SYNCSERVER;
if ($ssname) {
@results = &read_file($ssname);
my @results = &read_file($ssname);
($synserv) = split/\./, $results[0];
chomp $synserv;
}
......@@ -2439,7 +2443,7 @@ sub post_event {
"-s",
$EVENTSERVER,
"-e",
"$proj_id/$exp_id",
$EVENTID,
"-k",
$PATH_KEYFILE,
"-x",
......@@ -2466,7 +2470,7 @@ sub post_event2 {
"-s",
$EVENTSERVER,
"-e",
"$proj_id/$exp_id",
$EVENTID,
"-k",
$PATH_KEYFILE,
"-x",
......@@ -2492,7 +2496,7 @@ sub sim_event {
}
system($PATH_TEVC,
"-e", "$proj_id/$exp_id",
"-e", $EVENTID,
"-k", $PATH_KEYFILE,
"now",
$simname,
......@@ -2511,7 +2515,7 @@ sub sim_event2 {
}
system($PATH_TEVC,
"-e", "$proj_id/$exp_id",
"-e", $EVENTID,
"-k", $PATH_KEYFILE,
"now",
$simname,
......
perl -w -T linktest.pl.in STARTAT=1 STOPAT=4 DOARP=0 NODES=node1,node2 LOGDIR=/proj BINDIR=/usr/testbed/lib VARDIR=/var/emulab/
perl -w -T linktest.pl.in STARTAT=1 STOPAT=4 DOARP=0 NODES=node1,node2 PROJDIR=/proj BINDIR=/usr/testbed/lib VARDIR=/var/emulab
......@@ -25,6 +25,7 @@ use GeniCredential;
use Compress::Zlib;
use MIME::Base64;
use XML::LibXML;
# Disable UUID checks in GeniCredential.
$GeniCredential::CHECK_UUID = 0;
......@@ -237,6 +238,34 @@ sub DeleteSliver()
}
}
# No prototype because it is recursive and as such, the prototype
# causes a warning.
#
# Return a hash containing a JSONish representation of the given node.
sub XmlToJson
{
my ($node) = @_;
my $attrs = {};
foreach my $attr ($node->attributes) {
$attrs->{$attr->nodeName()} = $attr->nodeValue();
}
my $children = [];
foreach my $child ($node->childNodes) {
if ($child->nodeType() == XML_ELEMENT_NODE) {
push(@$children, XmlToJson($child));
}
}
my $result = {
"name" => $node->nodeName(),
"attributes" => $attrs,
"children" => $children
};
return $result;
}
# Get the status of the sliver associated with the given slice. This
# just passes on to the CM SliverStatus operation.
sub SliverStatus()
......@@ -255,9 +284,7 @@ sub SliverStatus()
my $pgstatus = GeniResponse::value($response);
my $status = {};
# How do we determine the sliver URN? Is there one for the whole
# sliver, or just for each individual sliver?
$status->{'geni_urn'} = 'Unknown';
$status->{'geni_urn'} = $slice_urn;
# Determine geni_status. XXX how to determine 'configuring'?
if ($pgstatus->{'status'} eq 'ready') {
......@@ -268,15 +295,44 @@ sub SliverStatus()
$status->{'geni_status'} = 'unknown';
}
# include the pg status
$status->{'pg_status'} = $pgstatus->{'status'};
# include the expiration
my $slice = GeniSlice->Lookup($slice_urn);
$status->{'pg_expires'} = $slice->expires();
my $details = $pgstatus->{'details'};
my @children = ();
while ( my ($pgurn, $pgrstat) = each(%$details) ) {
# Look up the sliver so we can extract info from the manifest.
my $sliver = GeniSliver->Lookup($pgurn);
my $child = {
'geni_urn' => $pgurn,
# XXX Need to massage status to one of the AM status values
'geni_status' => $pgrstat->{'status'},
'geni_error' => $pgrstat->{'error'},
'pg_status' => $pgrstat->{'status'},
};
# Put manifest info in...
my $manifest = $sliver->GetManifest(0);
if (0) {
# An example of how to include a single element from the
# manifest. Abondoned this approach and went to XmlToJson
# instead. Finds the "login", then the "hostname" inside
# the rspec
my $login = GeniXML::FindNodes(".//n:services//n:login", $manifest);
if (defined($login)) {
my $login = @$login[0];
my $host = GeniXML::GetText("hostname", $login);
if (defined($host)) {
$child->{'pg_hostname'} = $host;
}
}
}
$child->{'pg_manifest'} = XmlToJson($manifest);
#$child->{'pg_xml_manifest'} = GeniXML::Serialize($manifest);
push @children, $child;
}
$status->{'geni_resources'} = \@children;
......
......@@ -678,7 +678,11 @@ sub GetManifest($$)
#
my $valid_date = POSIX::strftime("20%y-%m-%dT%H:%M:%S",
gmtime(str2time($slice->expires())));
GeniXML::SetText("valid_until", $manifest, $valid_date);
if (GeniXML::IsVersion0($manifest)) {
GeniXML::SetText("valid_until", $manifest, $valid_date);
} else {
GeniXML::SetText("expires", $manifest, $valid_date);
}
return $manifest
if (!$asxml);
......
This diff is collapsed.
......@@ -356,6 +356,7 @@ sub CreateSliver($)
Node->FlushAll();
if ($aggregate->Start($API_VERSION, 0) != 0) {
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not start sliver");
}
......
......@@ -606,7 +606,7 @@ sub Create($$$$$$)
{
# $rspec is a LibXML element representing a single node.
my ($class, $slice, $user, $resource_uuid, $rspec) = @_;
my $virtualization_type = GeniXML::GetText("virtualization_type", $rspec);
my $virtualization_type = GeniXML::GetVirtualizationType($rspec);
if (!defined($virtualization_type)) {
print STDERR "Node does not contain a virtualization_type\n";
return undef;
......@@ -682,22 +682,28 @@ sub Create($$$$$$)
#
# Add this stuff to the rspec (which becomes the manifest).
#
GeniXML::SetText("hostname", $rspec, $hostname);
GeniXML::SetText("sshdport", $rspec, $sshdport) if (defined($sshdport));
# This is a version 2.0 thing.
my $services = GeniXML::AddElement("services", $rspec);
my $login = GeniXML::AddElement("login", $services);
GeniXML::SetText("authentication", $login, "ssh-keys");
GeniXML::SetText("hostname", $login, $phostname);
GeniXML::SetText("port", $login, $sshdport);
if (GeniXML::IsVersion0($rspec)) {
GeniXML::SetText("hostname", $rspec, $hostname);
GeniXML::SetText("sshdport", $rspec, $sshdport)
if (defined($sshdport));
} else {
my $services = GeniXML::AddElement("services", $rspec);
my $login = GeniXML::AddElement("login", $services);
GeniXML::SetText("authentication", $login, "ssh-keys");
GeniXML::SetText("hostname", $login, $phostname);
GeniXML::SetText("port", $login, $sshdport);
}
my $sliver = GeniSliver->Create($slice, $user, $resource_uuid, "Node",
$resource_id, $hrn, $nickname, $rspec);
return undef
if (!defined($sliver));
GeniXML::SetText("sliver_uuid", $rspec, $sliver->uuid());
if (GeniXML::IsVersion0($rspec)) {
GeniXML::SetText("sliver_uuid", $rspec, $sliver->uuid());
} else {
GeniXML::SetText("sliver_id", $rspec, $sliver->sliver_urn());
}
return $sliver;
}
......@@ -743,7 +749,7 @@ sub Provision($;$)
my $pid = $experiment->pid();
my $eid = $experiment->eid();
my $virt_type = GeniXML::GetText("virtualization_type", $self->rspec());
my $virt_type = GeniXML::GetVirtualizationType($self->rspec());
if (!$node->isremotenode() &&
defined($virt_type) &&
$virt_type eq "emulab-vnode") {
......@@ -756,8 +762,7 @@ sub Provision($;$)
# Mark
$node->ModifyReservation({"genisliver_idx" => $self->idx()});
my $subtype = GeniXML::GetText("virtualization_subtype",
$self->rspec());
my $subtype = GeniXML::GetVirtualizationSubtype($self->rspec());
if (defined($subtype)) {
if (!$pnode->sharing_mode()) {
$pnode->ModifyReservation({"genisliver_idx" => $self->idx()});
......@@ -827,8 +832,7 @@ sub UnProvision($;$)
}
}
my $virt_type = GeniXML::GetText("virtualization_type",
$self->rspec());
my $virt_type = GeniXML::GetVirtualizationType($self->rspec());
if (!$node->isremotenode() &&
defined($virt_type) &&
$virt_type eq "emulab-vnode") {
......@@ -934,7 +938,7 @@ sub ProcessManifest($$)
#
foreach my $ref (GeniXML::FindNodes("n:node",
$manifest)->get_nodelist()) {
my $sliver_urn = GeniXML::GetText("sliver_urn", $ref);
my $sliver_urn = GeniXML::GetSliverId($ref);
if (defined($sliver_urn) && $sliver_urn eq $self->sliver_urn()) {
# startup command.
my $startupcmd = GeniXML::GetText("startup_command", $ref);
......@@ -1169,15 +1173,21 @@ sub Create()
#
# Add this stuff to the rspec (which becomes the manifest).
#
GeniXML::SetText("component_urn", $rspec, $component_urn);
if (GeniXML::IsVersion0($rspec)) {
GeniXML::SetText("component_urn", $rspec, $component_urn);
} else {
GeniXML::SetText("component_id", $rspec, $component_urn);
}
my $sliver = GeniSliver->Create($slice, $user, $interface_uuid,
"Interface", $resource_id,
$hrn, $nickname, $rspec);
return undef
if (!defined($sliver));
GeniXML::SetText("sliver_uuid", $rspec, $sliver->uuid());
if (GeniXML::IsVersion0($rspec)) {
GeniXML::SetText("sliver_uuid", $rspec, $sliver->uuid());
} else {
GeniXML::SetText("sliver_id", $rspec, $sliver->sliver_urn());
}
return $sliver;
}
......
......@@ -11,7 +11,12 @@ use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw(Parse ParseFile FindNodes FindNodesNS FindFirst FindElement FindAttr IsLanNode IsLocalNode GetNodeId GetVirtualId GetManagerId SetText GetText CreateDocument AddElement PolicyExists);
@EXPORT = qw(Parse ParseFile IsVersion0 FindNodes FindNodesNS
FindFirst FindElement FindAttr IsLanNode IsLocalNode IsTunnel GetExpires
GetNodeId GetVirtualId GetSliverId GetManagerId GetColocate GetSubnodeOf
GetVirtualizationType SetVirtualizationType GetVirtualizationSubtype
GetExclusive SetExclusive GetLinkManager SetText GetText Serialize
CreateDocument AddElement RemoveChild PolicyExists);
use English;
use XML::LibXML;
......@@ -21,8 +26,9 @@ use GeniHRN;
use GeniUtil;
use Carp qw(cluck carp);
use vars qw($RSPEC_0_1 $RSPEC_2);
use vars qw($RSPEC_0_1 $RSPEC_0_2 $RSPEC_2);
$RSPEC_0_1 = "0.1";
$RSPEC_0_2 = "0.2";
$RSPEC_2 = "2";
# Configure variables
......@@ -70,9 +76,11 @@ sub GetVersion($)
my $result = $RSPEC_0_1;
my $ns = $node->namespaceURI();
if (defined($ns)) {
if ($ns eq "http://protogeni.net/resources/rspec/0.1") {
if ($ns =~ /protogeni.net\/resources\/rspec\/0.1$/) {
$result = $RSPEC_0_1;
} elsif ($ns eq "http://protogeni.net/resources/rspec/2") {
} elsif ($ns =~ /protogeni.net\/resources\/rspec\/0.2$/) {
$result = $RSPEC_0_2;
} elsif ($ns =~ /protogeni.net\/resources\/rspec\/2$/) {
$result = $RSPEC_2;
} else {
carp("Unknown rspec namespace: " . $ns);
......@@ -82,6 +90,12 @@ sub GetVersion($)
return $result;
}
sub IsVersion0($)
{
my $version = GetVersion($_[0]);
return $version eq $RSPEC_0_1 || $version eq $RSPEC_0_2;
}
# Returns a NodeList for a given XPath using a given node as
# context. 'n' is defined to be the prefix for the namespace of the
# node.
......@@ -212,6 +226,43 @@ sub IsLocalNode($)
return $result;
}
sub IsTunnel($)
{
my ($link) = @_;
my $result = 0;
if (IsVersion0($link)) {
my $link_type = GetText("link_type", $link);
$result = (defined($link_type) && $link_type eq "tunnel");
} else {
my @types = FindNodes("n:link_type", $link);
foreach my $current (@types) {
my $name = GetText("name", $current);
if ($name eq "gre-tunnel") {
$result = 1;
last;
}
}
}
return $result;
}
sub GetExpires($)
{
my ($node) = @_;
return GetText("valid_until", $node) ||
GetText("expires", $node);
}
sub SetExpires($$)
{
my ($node, $arg) = @_;
if (IsVersion0($node)) {
SetText("valid_until", $node, $arg);
} else {
SetText("expires", $node, $arg);
}
}
# Returns the uuid or urn of an RSpec node or undef if it is not a node.
sub GetNodeId($)
{
......@@ -233,7 +284,8 @@ sub GetVirtualId($)
sub GetSliverId($)
{
my ($node) = @_;
return GetText("sliver_urn", $node);
return GetText("sliver_urn", $node)
|| GetText("sliver_id", $node);
}
sub GetManagerId($)
......@@ -244,6 +296,104 @@ sub GetManagerId($)
GetText("component_manager_id", $node);
}
sub GetColocate($)
{
my ($node) = @_;