Commit 5ba4b9d3 authored by Cody Cutler's avatar Cody Cutler

Merge branch 'master' of...

Merge branch 'master' of ccutler@git-public.flux.utah.edu:/flux/git/users/mike/emulab-devel into tpm-tmcd
parents 6e14662f 1b7ca63a
......@@ -2717,7 +2717,7 @@ sub CleanLogFiles($)
if ($file =~ /^.*\.ns$/);
push(@delete, "${workdir}/$1")
if ($file =~ /^(.*\.(log|ptop|top|assign|soln|xml))$/);
if ($file =~ /^(.*\.(log|ptop|top|assign|soln|xml|limits))$/);
push(@delete, "${workdir}/$1")
if ($file =~ /^((swap|start|cancel|newrun).*\..*)$/);
......
......@@ -133,6 +133,16 @@ if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
" You do not have permission to allocate nodes in $pid/$eid\n");
}
#
# Need an RPC context for this to work.
#
my $certificate = GeniCertificate->LoadFromFile("$TB/etc/genisa.pem");
fatal("Could not load SA certificate")
if (!defined($certificate));
Genixmlrpc->SetContext(Genixmlrpc->Context($certificate));
$ENV{'MYUUID'} = $certificate->uuid();
$ENV{'MYURN'} = $certificate->urn();
my $foo = "urn:publicid:IDN+emulab.net+authority+cm";
my $fee = "urn:publicid:IDN+emulab.net+node+pc172";
......
......@@ -143,11 +143,13 @@ my @INCDIRS = ("-I${objdir}", "-I${objdir}/../tbsetup",
);
# Chicken or Egg.
DBQueryFatal("INSERT INTO sitevariables VALUES ".
# XXX only set specific fields as the ns_include field may not be there yet.
DBQueryFatal("INSERT INTO sitevariables (name,value,defaultvalue,description)".
" VALUES ".
" ('general/testbed_shutdown',NULL,'0', ".
" 'Non-zero value indicates that the testbed is shutdown ".
"and scripts should not do anything when they run. ".
"DO NOT SET THIS BY HAND!', 0)")
"DO NOT SET THIS BY HAND!')")
if (!SiteVarExists("general/testbed_shutdown"));
#
......
#
# Switch power to use syslog.
#
use strict;
use libinstall;
my $SYSLOG_CONF = "/etc/syslog.conf";
my $POWERLOG = "$TBROOT/log/power.log";
my $CHMOD = "/bin/chmod";
my $CHGRP = "/usr/bin/chgrp";
sub InstallUpdate($$)
{
my ($version, $phase) = @_;
#
# If something should run in the pre-install phase.
#
if ($phase eq "pre") {
Phase "power", "Updating power logging", sub {
Phase "syslog.conf", "Updating $SYSLOG_CONF", sub {
DoneIfEdited($SYSLOG_CONF);
BackUpFileFatal($SYSLOG_CONF);
AppendToFileFatal($SYSLOG_CONF,
"!power", "*.*\t\t\t\t\t\t$LOGDIR/power.log");
};
Phase "logfile", "Creating $POWERLOG", sub {
DoneIfExists($POWERLOG);
CreateFileFatal($POWERLOG);
ExecQuietFatal("$CHGRP tbadmin $POWERLOG");
ExecQuietFatal("$CHMOD 640 $POWERLOG");
};
Phase "syslogd", "Restarting syslogd", sub {
HUPDaemon("syslog");
};
};
}
#
# If something should run in the post-install phase.
#
if ($phase eq "post") {
}
return 0;
}
1;
......@@ -20,14 +20,14 @@ sub InstallUpdate($$)
Phase "p5-Crypt-X509", "Checking for port p5-Crypt-X509", sub {
DoneIfPackageInstalled("p5-Crypt-X509");
ExecQuietFatal("cd $PORTSDIR/security/p5-Crypt-X509; ".
"make -DBATCH install");
"make MASTER_SITE_FREEBSD=1 -DBATCH install");
};
Phase "p5-Crypt-OpenSSL-X509",
"Checking for port p5-Crypt-OpenSSL-X509", sub {
DoneIfPackageInstalled("p5-Crypt-OpenSSL-X509");
ExecQuietFatal("cd $PORTSDIR/security/p5-Crypt-OpenSSL-X509; ".
"make -DBATCH install");
"make MASTER_SITE_FREEBSD=1 -DBATCH install");
};
}
......
......@@ -20,7 +20,7 @@ sub InstallUpdate($$)
DoneIfPackageInstalled("xerces");
ExecQuietFatal("cd $PORTSDIR/textproc/xerces-c2; ".
"make clean; make rmconfig; ".
"make -DBATCH WITH_DEBUG=on install");
"make MASTER_SITE_FREEBSD=1 -DBATCH WITH_DEBUG=on install");
};
Phase "reconfig", "Checking to see if reconfigure needed", sub {
PhaseSkip("No reconfig needed")
......
......@@ -29,7 +29,6 @@ use GeniComponent;
use GeniHRN;
use GeniXML;
use emutil;
use Lan;
use Data::Dumper;
use English;
use overload ('""' => 'Stringify');
......@@ -730,6 +729,8 @@ sub ProcessManifest($$)
sub Start($$$)
{
my ($self, $version, $restart) = @_;
require Lan;
require OSinfo;
return -1
if (! ref($self));
......
......@@ -95,6 +95,8 @@ sub Lookup($$)
my $self = {};
$self->{'AUTHORITY'} = $query_result->fetchrow_hashref();
$self->{'version'} = undef;
$self->{'apilevel'} = undef;
$self->{'api'} = undef;
bless($self, $class);
#
......@@ -178,7 +180,9 @@ sub url($) { return field($_[0], "url"); }
sub hrn($) { return field($_[0], "hrn"); }
sub type($) { return field($_[0], "type"); }
sub disabled($) { return field($_[0], "disabled"); }
sub version($) { return field($_[0], "version"); }
sub version($) { return $_[0]->{"version"}; }
sub apilevel($) { return $_[0]->{"apilevel"}; }
sub api($) { return $_[0]->{"api"}; }
sub cert($) { return $_[0]->{'CERT'}->cert(); }
sub GetCertificate($) { return $_[0]->{'CERT'}; }
......@@ -329,13 +333,53 @@ sub Version($)
return undef;
}
if (ref($response->value())) {
$self->{'version'} = $response->value()->{'api'};
# Look for the AM interface.
if (exists($response->value()->{'geni_api'})) {
$self->{'version'} = $response->value()->{'geni_api'};
# This was wrong; it should be 2.0 not 1.0
$self->{'version'} = 2.0 if ($self->{'version'} == 1.0);
$self->{'apilevel'} = 0;
$self->{'api'} = "AM";
}
else {
$self->{'version'} = $response->value()->{'api'};
$self->{'apilevel'} = $response->value()->{'level'};
$self->{'apilevel'} = 0;
$self->{'api'} = "CM";
}
}
else {
$self->{'version'} = $response->value();
$self->{'version'} = $response->value();
$self->{'apilevel'} = 1;
$self->{'api'} = "CM";
}
return $self->{'version'};
}
# Ditto for the API level
sub ApiLevel($)
{
my ($self) = @_;
return $self->apilevel()
if (defined($self->apilevel()));
return undef
if (!defined($self->Version()));
return $self->apilevel();
}
sub Api($)
{
my ($self) = @_;
return $self->api()
if (defined($self->api()));
return undef
if (!defined($self->Version()));
return $self->api();
}
#
# Check that the authority is the issuer of the given certificate.
......
......@@ -37,23 +37,14 @@ use GeniXML;
use GeniUsage;
use libtestbed qw(SENDMAIL);
use emutil;
# Hate to import all this crap; need a utility library.
use libdb qw(TBGetSiteVar EXPTSTATE_SWAPPED EXPTSTATE_ACTIVE TBOPSPID
TBDB_NODESTATE_TBFAILED);
use Node;
use Lan;
use OSinfo;
use Image;
use Interface;
use EmulabConstants;
use libEmulab;
use English;
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime tmpnam);
use Time::Local;
use Experiment;
use VirtExperiment;
use Firewall;
use Compress::Zlib;
use File::Temp qw(tempfile);
use MIME::Base64;
......@@ -83,6 +74,7 @@ my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
my $MAPPER = "$TB/bin/mapper";
my $VTOPGEN = "$TB/bin/vtopgen";
my $SNMPIT = "$TB/bin/snmpit";
my $NEWGROUP = "$TB/bin/newgroup";
my $PRERENDER = "$TB/libexec/vis/prerender";
my $XMLLINT = "/usr/local/bin/xmllint";
my $ADDAUTHORITY = "$TB/sbin/protogeni/addauthority";
......@@ -144,6 +136,7 @@ sub Resolve($)
if (GeniResponse::IsResponse($credential));
if ($type eq "node") {
require Interface;
my $node;
if (defined($uuid)) {
......@@ -218,7 +211,7 @@ sub DiscoverResourcesAux($$$)
# A sitevar controls whether external users can get any nodes.
#
my $allow_externalusers = 0;
if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
# Cannot get the value, say no.
$allow_externalusers = 0;
}
......@@ -393,6 +386,8 @@ sub GetTicketAuxAux($$$$$$$$$)
my $response = undef;
my $restorevirt = 0; # Flag to restore virtual state
my $restorephys = 0; # Flag to restore physical state
require OSinfo;
require VirtExperiment;
#
# We need this below to sign the ticket.
......@@ -431,7 +426,7 @@ sub GetTicketAuxAux($$$$$$$$$)
# A sitevar controls whether external users can get any nodes.
#
my $allow_externalusers = 0;
if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
# Cannot get the value, say no.
$allow_externalusers = 0;
}
......@@ -478,7 +473,7 @@ sub GetTicketAuxAux($$$$$$$$$)
# A sitevar controls the sliver lifetime.
#
my $max_sliver_lifetime = 0;
if (!TBGetSiteVar('protogeni/max_sliver_lifetime', \$max_sliver_lifetime)){
if (!GetSiteVar('protogeni/max_sliver_lifetime', \$max_sliver_lifetime)){
# Cannot get the value, default it to 90 days.
$max_sliver_lifetime = 90;
}
......@@ -615,10 +610,6 @@ sub GetTicketAuxAux($$$$$$$$$)
$virtexperiment->allowfixnode(0);
$virtexperiment->multiplex_factor(3);
# This is where nodes are parked until a ticket is redeemed.
# This experiment no longer has to exist.
my $reserved_holding = Experiment->Lookup("GeniSlices", "reservations");
#
# An rspec is a structure that requests specific nodes. If those
# nodes are available, then reserve it. Otherwise the ticket
......@@ -686,22 +677,6 @@ sub GetTicketAuxAux($$$$$$$$$)
goto bad;
}
#
# Grab the reservation. For backwards compatibility, we want
# to find nodes in the reservations holding area, and move them
# into the slice experiment. The holding area is no longer going
# to be used, at least not until we have a reservations system.
#
my $reservation = $node->Reservation();
if (defined($reservation) &&
defined($reserved_holding) &&
$reservation->SameExperiment($reserved_holding)) {
if ($node->MoveReservation($slice_experiment)) {
print STDERR "Could not move $node to $slice_experiment\n";
goto bad;
}
$node->Refresh();
}
$namemap{$node_nickname} = $node;
$colomap{$colocate} = $node
if (defined($colocate));
......@@ -1207,15 +1182,29 @@ sub GetTicketAuxAux($$$$$$$$$)
"Could not verify topo");
goto bad;
}
system("$MAPPER -a -d -v -u -z -o $tmpfile $pid $eid");
$slice_experiment->CleanLogFiles();
my $output =
GeniUtil::ExecQuiet("$MAPPER -a -d -v -u -z -o $tmpfile $pid $eid");
if ($?) {
my $logstuff = undef;
my $logstuff = "";
unlink($tmpfile);
if ($isupdate) {
$slice_experiment->RemovePhysicalState();
$slice_experiment->RestorePhysicalState();
}
#
# Find the important lines and print them first.
#
while ($output =~ /^(.*)$/gm) {
my $line = $1;
if ($line =~ /^\*\*\* .*$/) {
$logstuff .= $line;
}
}
$logstuff .= "\n";
# Dump the vtop.
if (-e "$pid-$eid.vtop") {
print STDERR "----------------------------------------------\n";
......@@ -1231,17 +1220,27 @@ sub GetTicketAuxAux($$$$$$$$$)
if (-e "assign.log") {
print STDERR "----------------------------------------------\n";
print STDERR "------------- Assign Error Log ---------------\n";
$logstuff = `cat assign.log`;
print STDERR $logstuff . "\n";
my $log = `cat assign.log`;
print STDERR $log . "\n";
print STDERR "----------------------------------------------\n";
}
$logstuff .= $log;
}
# Dump the output to STDERR for debugging.
print STDERR "----------------------------------------------\n";
print STDERR "---------------- Mapper Log ------------------\n";
print STDERR $output;
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, $logstuff,
"Could not map to resources");
GeniResponse->Create(GENIRESPONSE_ERROR,
"Could not map to resources", $logstuff);
# So we can find things later.
$slice_experiment->SaveLogFiles();
goto bad;
}
# Dump the output to STDERR for debugging.
print STDERR $output;
# So we can find things later.
$slice_experiment->SaveLogFiles();
......@@ -1257,7 +1256,7 @@ sub GetTicketAuxAux($$$$$$$$$)
# be allocated to an experiment.
my $max_components = 0;
if (!TBGetSiteVar('protogeni/max_components', \$max_components)) {
if (!GetSiteVar('protogeni/max_components', \$max_components)) {
# Cannot get the value, default it to -1. Which means there is no limit.
$max_components = -1;
}
......@@ -1329,7 +1328,9 @@ sub GetTicketAuxAux($$$$$$$$$)
# Do not update subnodes; they are fixed to the parent,
# while the parent is fixed to an actual node.
if (!defined($subnode_of)) {
$virtnode->fixed($node->node_id());
# Remember, we fix to the physnode not the virtual.
$virtnode->fixed(($node->isvirtnode() ?
$node->phys_nodeid() : $node->node_id()));
}
# New node unless already mapped.
......@@ -1545,6 +1546,7 @@ sub SliverWorkAux($$$$$$$)
my $response;
my $ticket;
my $rspec;
require Interface;
# V2 API support.
if ($v2 && $level == 0) {
......@@ -1749,10 +1751,6 @@ sub SliverWorkAux($$$$$$$)
}
}
# Nodes are in this holding experiment.
# This experiment no longer has to exist!
my $reserved_holding = Experiment->Lookup("GeniSlices", "reservations");
#
# Make sure all nodes requested are allocated.
#
......@@ -1799,16 +1797,7 @@ sub SliverWorkAux($$$$$$$)
#
my $reservation = $node->Reservation();
if (defined($reservation)) {
if (defined($reserved_holding) &&
$reservation->SameExperiment($reserved_holding)) {
# This is for backwards compatibility.
if ($node->MoveReservation($experiment)) {
print STDERR "Could not move $node to $experiment\n";
goto bad;
}
$node->Refresh();
}
elsif (!$reservation->SameExperiment($experiment)) {
if (!$reservation->SameExperiment($experiment)) {
$message = "$resource_id ($node) is not available";
goto bad;
}
......@@ -1958,13 +1947,37 @@ sub SliverWorkAux($$$$$$$)
print STDERR "Could not chdir to workdir\n";
goto bad;
}
$experiment->CleanLogFiles();
# Add -u for update mode, but not -f (fixnode).
system("$MAPPER -d -v -z -u $pid $eid");
my $output = GeniUtil::ExecQuiet("$MAPPER -d -v -z -u $pid $eid");
if ($?) {
my $logstuff = undef;
my $logstuff = "";
$message = "Could not map to resources";
print STDERR "Mapper failed!\n";
#
# Find the important lines and print them first.
#
while ($output =~ /^(.*)$/gm) {
my $line = $1;
if ($line =~ /^\*\*\* .*$/) {
$logstuff .= $line;
}
}
$logstuff .= "\n";
#
# Lets dump the error log, so it ends up in the email.
#
if (-e "assign.log") {
print STDERR "----------------------------------------------\n";
print STDERR "------------- Assign Error Log ---------------\n";
my $log = `cat assign.log`;
print STDERR $log . "\n";
print STDERR "----------------------------------------------\n";
$logstuff .= $log;
}
# Dump the vtop.
if (-e "$pid-$eid.vtop") {
print STDERR "----------------------------------------------\n";
......@@ -1973,25 +1986,24 @@ sub SliverWorkAux($$$$$$$)
print STDERR $log . "\n";
print STDERR "----------------------------------------------\n";
}
#
# Lets dump the error log too, so it ends up in the email.
# Have to figure out a better approach for this.
#
if (-e "assign.log") {
print STDERR "----------------------------------------------\n";
print STDERR "------------- Assign Error Log ---------------\n";
$logstuff = `cat assign.log`;
print STDERR $logstuff . "\n";
print STDERR "----------------------------------------------\n";
}
# Dump the output to STDERR for debugging.
print STDERR "----------------------------------------------\n";
print STDERR "---------------- Mapper Log ------------------\n";
print STDERR $output;
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, $logstuff, $message);
GeniResponse->Create(GENIRESPONSE_ERROR, $message, $logstuff);
# So we can find things later.
$experiment->SaveLogFiles();
goto bad;
}
# Dump the output to STDERR for debugging.
print STDERR $output;
# So we can find things later.
$experiment->SaveLogFiles();
#
# Must do this after the mapper runs.
#
......@@ -2048,10 +2060,7 @@ sub SliverWorkAux($$$$$$$)
$message = "Unknown resource_id in ticket: $resource_id";
goto bad;
}
my $sliver = GeniSliver::Node->Create($slice,
$owner,
$node->node_id(),
$ref);
my $sliver = GeniSliver::Node->Create($slice, $owner, $node, $ref);
if (!defined($sliver)) {
$message = "Could not create GeniSliver object for $virtual_id";
goto bad;
......@@ -2362,9 +2371,12 @@ sub SliverWorkAux($$$$$$$)
# Do firewall stuff.
if ($slice->needsfirewall()) {
require Firewall;
my @nodeids = map { $_->node_id() } values(%newnodes);
if (@nodeids && doFWlans($experiment, FWADDNODES, \@nodeids) != 0) {
if (@nodeids && doFWlans($experiment,
Firewall::FWADDNODES(), \@nodeids) != 0) {
print STDERR "FireWall setup failed\n";
goto bad;
}
......@@ -2387,6 +2399,8 @@ sub SliverWorkAux($$$$$$$)
# Must have the topofile for node boot. Might need locking on this.
#
if (!$v2) {
require Lan;
if (system("$GENTOPOFILE $pid $eid")) {
print STDERR "$GENTOPOFILE failed\n";
goto bad;
......@@ -2523,7 +2537,7 @@ sub SliverWorkAux($$$$$$$)
my @oldnodeids = map { $_->node_id() } values(%newnodes);
if ($slice->needsfirewall() && $didfwsetup) {
if (@oldnodeids && doFWlans($experiment, FWDELNODES,
if (@oldnodeids && doFWlans($experiment, Firewall::FWDELNODES(),
\@oldnodeids)) {
print STDERR "FireWall cleanup failed\n";
}
......@@ -2645,7 +2659,7 @@ sub RenewSliverAux($$)
# A sitevar controls the sliver lifetime.
#
my $max_sliver_lifetime = 0;
if (!TBGetSiteVar('protogeni/max_sliver_lifetime',
if (!GetSiteVar('protogeni/max_sliver_lifetime',
\$max_sliver_lifetime)){
# Cannot get the value, default it to 90 days.
$max_sliver_lifetime = 90;
......@@ -2855,6 +2869,7 @@ sub DeleteSliverAux($$$)
{
my ($credential, $impotent, $v2) = @_;
my $response;
require Firewall;
$credential->HasPrivilege( "pi" ) or
$credential->HasPrivilege( "instantiate" ) or
......@@ -3912,6 +3927,7 @@ sub RegisterAux($$)
sub CleanupDeadSlice($;$)
{
my ($slice, $purge) = @_;
require Firewall;
# Default to full purge.
$purge = 1
......@@ -4083,43 +4099,108 @@ sub GeniExperiment($)
my $uuid = $slice->uuid();
my $needsfirewall = $slice->needsfirewall();
my $pid = "GeniSlices";
my $gid = $pid;
my $hrn = $slice->hrn();
my $urn = $slice->urn();
require Experiment;
my $experiment = Experiment->Lookup($uuid);
if (!defined($experiment)) {
#
# Form an eid for the experiment.
#
my $eid = "slice" . TBGetUniqueIndex('next_sliceid', 1);
my $nsfile = "";
return $experiment
if (defined($experiment));
#
# Use the first token of the manifest for the gid of the experiment.
# This effectively puts slivers from each SA in their own subgroup.
#
if (1) {
require Project;
require Group;
($gid) = ($hrn =~ /^([-\w]*).*$/);
#
# Need a way to can experiments.
# See if the group exists.
#
if ($needsfirewall) {
$nsfile = "/tmp/$$.ns";
open(NS, "> $nsfile")
or return undef;
print NS "source tb_compat.tcl\n";
print NS "set ns [new Simulator]\n";
print NS "tb-set-security-level Blue\n";
print NS "\$ns run\n";
close(NS);
}
# Note the -h option; allows experiment with no NS file.
system("$CREATEEXPT -N -q -i -k -w ".
"-S 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ".
"-E 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ".
"-L 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ".
"-h '$uuid' -p GeniSlices -e $eid $nsfile");
if ($?) {
my $group = Group->Lookup("$pid,$gid");
if (!defined($group)) {
my $project = Project->Lookup($pid);
if (!defined($project)) {
print STDERR "Could not get project for $pid\n";
return undef;
}
my $pid_idx = $project->pid_idx();
#
# Write out a little XML file describing the group, and
# let the existing backend script deal with it all.
#
my ($fh, $filename) = tempfile(UNLINK => 0);
if (!defined($fh)) {
print STDERR "Could not create temp file for group $gid\n";
return undef;
}
print $fh "<group>\n";
print $fh " <attribute name=\"project\">\n";
print $fh " <value>$pid_idx</value>\n";
print $fh " </attribute>\n";
print $fh " <attribute name=\"group_id\">\n";
print $fh " <value>$gid</value>\n";