#!/usr/bin/perl -wT
#
# Copyright (c) 2007-2015 University of Utah and the Flux Group.
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
package APT_Profile;

#
# Note about permissions bits.
#
# listed - The profile will be listed on the home page for anyone to see/use.
# public - Anyone can instantiate the profile, regardless of its listed bit
#          Say, if you send a URL to someone. 
# shared - Shared with logged in users. If not listed, then the default is
#          that only project members can see/use the profile, unless the public
#          is set (but they need a url). Shared says any logged in user can
#          see and use the profile.  

use strict;
use Carp;
use Exporter;
use vars qw(@ISA @EXPORT $AUTOLOAD);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use EmulabConstants;
use emutil;
use emdb;
use APT_Dataset;
use GeniXML;
use GeniHRN;
use libtestbed;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');

# Configure variables
my $TB		  = "@prefix@";
my $TBOPS         = "@TBOPSEMAIL@";

my $debug = 0;

# Concat id/vers.
sub versid($)
{
    my ($self) = @_;

    return $self->profileid() . ":" . $self->version();
}

# Concat name/vers.
sub versname($)
{
    my ($self) = @_;

    return $self->name() . ":" . $self->version();
}

sub BlessRow($$)
{
    my ($class, $row) = @_;
    
    my $self           = {};
    $self->{'DBROW'}   = $row;

    bless($self, $class);
    return $self;
}

#
# Lookup. 
#
sub Lookup($$;$$)
{
    my ($class, $arg1, $arg2, $arg3) = @_;

    #
    # A single arg is either an index or "pid,profile[:version]" or
    # "pid/profile[:version]" string.
    #
    if (!defined($arg2)) {
	if ($arg1 =~ /^(\d*)$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    " from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid and ".
			    "     v.version=i.version ".
			    "where i.profileid='$arg1'");
	    return undef
		if (! $result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
	elsif ($arg1 =~ /^([-\w]*),([-\w\.\+]*)$/ ||
		$arg1 =~ /^([-\w]*)\/([-\w\.\+]*)$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    " from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid and ".
			    "     v.version=i.version ".
			    "where i.pid='$1' and i.name='$2'");
	    return undef
		if (! $result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
	elsif ($arg1 =~ /^([-\w]*),([-\w\.\+]*):(\d*)$/ ||
		$arg1 =~ /^([-\w]*)\/([-\w\.\+]*):(\d*)$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    " from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid ".
			    "where i.pid='$1' and i.name='$2' and ".
			    "      v.version='$3' and v.deleted is null");
	    return undef
		if (!$result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref())
	}
	elsif ($arg1 =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
	    #
	    # First look to see if the uuid is for the profile itself,
	    # which means current version. Otherwise look for a
	    # version with the uuid.
	    #
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    "  from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid and ".
			    "     v.version=i.version ".
			    "where i.uuid='$arg1'");
	    return undef
		if (! $result);
	    return BlessRow($class, $result->fetchrow_hashref())
		if ($result->numrows);

	    $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    "  from apt_profile_versions as v ".
			    "left join apt_profiles as i on ".
			    "     v.profileid=i.profileid ".
			    "where v.uuid='$arg1' and ".
			    "      v.deleted is null");
	    return undef
		if (! $result || !$result->numrows);
	    return BlessRow($class, $result->fetchrow_hashref());
	}
	return undef;
    }
    elsif (!defined($arg3)) {
	if ($arg1 =~ /^\d+$/ && $arg2 =~ /^\d+$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    "  from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid ".
			    "where i.profileid='$arg1' and v.version='$arg2' ".
			    " and  v.deleted is null");
	    return undef
		if (! $result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
	elsif ($arg1 =~ /^[-\w]*$/ && $arg2 =~ /^([-\w\.\+]*):(\d+)$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    " from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid ".
			    "where i.pid='$arg1' and i.name='$1' and ".
			    "      v.version='$2'");
	    return undef
		if (! $result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
	elsif ($arg1 =~ /^[-\w]*$/ && $arg2 =~ /^[-\w\.\+]*$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    "  from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid and ".
			    "     v.version=i.version ".
			    "where i.pid='$arg1' and i.name='$arg2'");
	    return undef
		if (! $result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
	return undef;
    }
    else {
	if ($arg1 =~ /^[-\w]*$/ &&
	    $arg2 =~ /^[-\w\.\+]*$/ && $arg3 =~ /^\d+$/) {
	    my $result =
		DBQueryWarn("select i.*,v.*,i.uuid as profile_uuid ".
			    "  from apt_profiles as i ".
			    "left join apt_profile_versions as v on ".
			    "     v.profileid=i.profileid ".
			    "where i.pid='$arg1' and i.name='$arg2' and ".
			    "      v.version='$arg3' and v.deleted is null");
	    return undef
		if (!$result || !$result->numrows);

	    return BlessRow($class, $result->fetchrow_hashref());
	}
    }
    return undef;
}

AUTOLOAD {
    my $self  = $_[0];
    my $type  = ref($self) or croak "$self is not an object";
    my $name  = $AUTOLOAD;
    $name =~ s/.*://;   # strip fully-qualified portion

    # A DB row proxy method call.
    if (exists($self->{'DBROW'}->{$name})) {
	return $self->{'DBROW'}->{$name};
    }
    carp("No such slot '$name' field in class $type");
    return undef;
}

# Break circular reference someplace to avoid exit errors.
sub DESTROY {
    my $self = shift;

    $self->{'DBROW'} = undef;
}

#
# Refresh a class instance by reloading from the DB.
#
sub Refresh($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $profileid = $self->profileid();
    my $version   = $self->version();
    
    my $query_result =
	DBQueryWarn("select * from apt_profile_versions ".
		    "where profileid='$profileid' and version='$version'");

    return -1
	if (!$query_result || !$query_result->numrows);

    $self->{'DBROW'} = $query_result->fetchrow_hashref();

    return 0;
}

#
# Create a profile
#
sub Create($$$$$$)
{
    my ($class, $parent, $project, $creator, $argref, $usrerr_ref) = @_;

    my $name    = DBQuoteSpecial($argref->{'name'});
    my $pid     = $project->pid();
    my $pid_idx = $project->pid_idx();
    my $uid     = $creator->uid();
    my $uid_idx = $creator->uid_idx();

    #
    # The pid/imageid has to be unique, so lock the table for the check/insert.
    #
    DBQueryWarn("lock tables apt_profiles write, apt_profile_versions write, ".
		"            emulab_indicies write")
	or return undef;

    my $query_result =
	DBQueryWarn("select name from apt_profiles ".
		    "where pid_idx='$pid_idx' and name=$name");

    if ($query_result->numrows) {
	DBQueryWarn("unlock tables");
	$$usrerr_ref = "Profile already exists in project!";
	return undef;
    }
    
    my $profileid = TBGetUniqueIndex("next_profile", undef, 1);
    my $puuid     = NewUUID();
    my $vuuid     = NewUUID();
    my $rspec     = DBQuoteSpecial($argref->{'rspec'});
    my $cquery    = "";
    my $vquery    = "";

    #
    # This part is common between the two tables.
    #
    $cquery .= "name=$name,profileid='$profileid'";
    $cquery .= ",pid='$pid',pid_idx='$pid_idx'";

    # And the versions table.
    $vquery  = $cquery;
    $vquery .= ",uuid='$vuuid',created=now()";
    $vquery .= ",creator='$uid',creator_idx='$uid_idx'";
    $vquery .= ",rspec=$rspec";

    # Set derived from pointer.
    if (defined($parent)) {
	$vquery .= ",parent_profileid=" . $parent->profileid();
	$vquery .= ",parent_version=" . $parent->version();
    }
    if (exists($argref->{'script'}) && $argref->{'script'} ne "") {
	$vquery .= ",script=" . DBQuoteSpecial($argref->{'script'});
	if (exists($argref->{'paramdefs'}) && $argref->{'paramdefs'} ne "") {
	    $vquery .= ",paramdefs=" . DBQuoteSpecial($argref->{'paramdefs'});
	}
    }

    # Back to the main table.
    $cquery .= ",uuid='$puuid'";
    $cquery .= ",public=1"
	if (exists($argref->{'public'}) && $argref->{'public'});
    $cquery .= ",listed=1"
	if (exists($argref->{'listed'}) && $argref->{'listed'});
    $cquery .= ",shared=1"
	if (exists($argref->{'shared'}) && $argref->{'shared'});
    $cquery .= ",topdog=1"
	if (exists($argref->{'topdog'}) && $argref->{'topdog'});

    # Create the main entry:
    if (! DBQueryWarn("insert into apt_profiles set $cquery")) {
	DBQueryWarn("unlock tables");
	tberror("Error inserting new apt_profiles record!");
	return undef;
    }
    # And the versions entry.
    if (! DBQueryWarn("insert into apt_profile_versions set $vquery")) {
	DBQueryWarn("delete from apt_profiles where profileid='$profileid'");
	DBQueryWarn("unlock tables");
	tberror("Error inserting new apt_profile_versions record!");
	return undef;
    }
    DBQueryWarn("unlock tables");
    return Lookup($class, $pid, $argref->{'name'});
}

#
# Create a new version of a profile.
#
sub NewVersion($$)
{
    my ($self, $creator) = @_;
    my $profileid   = $self->profileid();
    my $version     = $self->version();
    my $uid         = $creator->uid();
    my $uid_idx     = $creator->uid_idx();

    DBQueryWarn("lock tables apt_profiles write, ".
		"            apt_profile_versions write, ".
		"            apt_profile_versions as v write")
	or return undef;

    #
    # This might not be the head version, so have to find the
    # current max.
    #
    my $query_result =
	DBQueryWarn("select max(version) from apt_profile_versions ".
		    "where profileid='$profileid'");
    goto bad
	if (!$query_result || !$query_result->numrows);

    my ($newvers) = $query_result->fetchrow_array() + 1;

    #
    # Insert new version. The "current" version becomes this one.
    #
    goto bad
	if (! DBQueryWarn("insert into apt_profile_versions ".
			  "  (name,profileid,version,pid,pid_idx, ".
			  "   creator,creator_idx,created,uuid, ".
			  "   parent_profileid,parent_version,rspec, ".
			  "   script,paramdefs) ".
			  "select name,profileid,'$newvers',pid,pid_idx, ".
			  "  '$uid','$uid_idx',now(),uuid(),parent_profileid, ".
			  "  '$version',rspec,script,paramdefs ".
			  "from apt_profile_versions as v ".
			  "where v.profileid='$profileid' and ".
			  "      v.version='$version'"));
    if (! DBQueryWarn("update apt_profiles set version=$newvers ".
		      "where profileid='$profileid'")) {
	DBQueryWarn("delete from apt_profile_versions ".
		    "where profileid='$profileid' and version='$version'");
	goto bad;
    }
    DBQueryWarn("unlock tables");
    return APT_Profile->Lookup($profileid, $newvers);
  bad:
    DBQueryWarn("unlock tables");
    return undef;
}

#
# Stringify for output.
#
sub Stringify($)
{
    my ($self) = @_;
    
    my $pid       = $self->pid();
    my $name      = $self->name();
    my $version   = $self->version();

    return "[Profile: $pid,$name:$version]";
}

#
# Perform some updates ...
#
sub UpdateVersion($$)
{
    my ($self, $argref) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $profileid = $self->profileid();
    my $version   = $self->version();

    my $query = "update apt_profile_versions set ".
	join(",", map("$_=" . DBQuoteSpecial($argref->{$_}), keys(%{$argref})));

    $query .= " where profileid='$profileid' and version='$version'";

    return -1
	if (! DBQueryWarn($query));

    return Refresh($self);
}

#
# Perform some updates ...
#
sub UpdateMetaData($$)
{
    my ($self, $argref) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $profileid = $self->profileid();

    #
    # This is the only metadata we can update.
    #
    my %mods = ();
    foreach my $key ("listed", "shared", "public", "topdog") {
	if (exists($argref->{$key})) {
	    $mods{$key} = $argref->{$key};
	}
    }
    my $query = "update apt_profiles set ".
	join(",", map("$_=" . DBQuoteSpecial($mods{$_}), keys(%mods)));

    $query .= " where profileid='$profileid'";

    return -1
	if (! DBQueryWarn($query));

    return Refresh($self);
}

sub Delete($$)
{
    my ($self, $purge) = @_;
    my $profileid = $self->profileid();

    $purge = 0
	if (!defined($purge));
    
    DBQueryWarn("lock tables apt_profiles write, apt_profile_versions write")
	or return -1;

    DBQueryWarn("delete from apt_profiles where profileid='$profileid'")
	or goto bad;
    
    if ($purge) {
	goto bad
	    if (! DBQueryWarn("delete from apt_profile_versions ".
			      "where profileid='$profileid'"));
    }
    else {
	# Set deleted on all of the versions.
	DBQueryWarn("update apt_profile_versions set ".
		    "    deleted=now(),locked=null,locker_pid=0 ".
		    "where profileid='$profileid'")
	    or goto bad;
    }
    DBQueryWarn("unlock tables");
    return 0;

  bad:
    DBQueryWarn("unlock tables");
    return -1;
}

#
# Delete a profile version, only allow it if it is the highest
# numbered version.
#
sub DeleteVersion($)
{
    my ($self) = @_;

    DBQueryWarn("lock tables apt_profile_versions write, apt_profiles write")
	or return -1;

    my $profileid = $self->profileid();
    my $version   = $self->version();

    #
    # Only the "head" version can be deleted
    #
    my $query_result =
	DBQueryWarn("select max(version) from apt_profile_versions ".
		    "where profileid='$profileid'");
    goto bad
	if (!$query_result || !$query_result->numrows);

    my ($head) = $query_result->fetchrow_array();
    if ($head != $version) {
	print STDERR "Profile::DeleteVersion: not the head version of $self\n";
	goto bad;
    }
    goto bad
	if (!DBQueryWarn("delete from apt_profile_versions ".
			 "where profileid='$profileid' and ".
			 "      version='$version'"));
    goto bad
	if (!DBQueryWarn("update apt_profiles set version=version-1 ".
			 "where profileid='$profileid' and ".
			 "      version='$version'"));
    DBQueryWarn("unlock tables");
    return 0;
  bad:
    DBQueryWarn("unlock tables");
    return -1;
}

#
# Condomize a profile rspec by inserting the necessary firewall section
# to each of the nodes.
#
sub CheckFirewall($$)
{
    my ($self, $condomize) = @_;

    # Must be a real reference. 
    return -1
	if (! ref($self));

    my $rspec = GeniXML::Parse($self->rspec());
    if (! defined($rspec)) {
	print STDERR "Could not parse rspec\n";
	return undef;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	my @routable_control_ip =
	    GeniXML::FindNodesNS("n:routable_control_ip",
				 $ref,
				 $GeniXML::EMULAB_NS)->get_nodelist();
	my $virtualization_type = GeniXML::GetVirtualizationSubtype($ref);
	#
	# If a XEN container but not a routable IP, then use the basic
	# rules instead of closed, so that ssh is allowed in on the
	# alternate port. That is the only real difference between basic
	# and closed.
	#
	my $style = "closed";
	if (defined($virtualization_type) &&
	    $virtualization_type eq "emulab-xen" && !@routable_control_ip) {
	    $style = "basic";
	}
	
	if ($condomize) {
	    #
	    # No settings is easy; wrap it tight.
	    #
	    if (!GeniXML::HasFirewallSettings($ref)) {
		my $firewall = GeniXML::AddElement("firewall", $ref,
						   $GeniXML::EMULAB_NS);
		GeniXML::SetText("style", $firewall, $style);
		next;
	    }
	    #
	    # Make sure the existing section has a reasonable setting.
	    #
	    my $settings = GeniXML::FindNodesNS("n:firewall", $ref,
						$GeniXML::EMULAB_NS)->pop();
	    my $style = GeniXML::GetText("style", $settings);
	    if (!defined($style) || $style ne "basic" || $style ne "closed") {
		GeniXML::SetText("style", $settings, $style);
	    }
	}
	#
	# Quick pass over the exceptions to see if we need to substitute
	# the callers IP address.
	#
	foreach my $exception (GeniXML::FindNodesNS("n:firewall/n:exception",
				$ref, $GeniXML::EMULAB_NS)->get_nodelist()) {
	    my $ip = GeniXML::GetText("ip", $exception);
	    if (defined($ip) && $ip eq "myip" && exists($ENV{'REMOTE_ADDR'})) {
		GeniXML::SetText("ip", $exception, $ENV{'REMOTE_ADDR'});
	    }
	}
    }
    return GeniXML::Serialize($rspec);
}

#
# Lock and Unlock
#
sub Lock($)
{
    my ($self) = @_;
    my $profileid = $self->profileid();

    return -1
	if (!DBQueryWarn("lock tables apt_profiles write"));

    my $query_result =
	DBQueryWarn("update apt_profiles set locked=now(),locker_pid='$PID' " .
		    "where profileid='$profileid' and locked is null");

    if (! $query_result ||
	$query_result->numrows == 0) {
	DBQueryWarn("unlock tables");
	return -1;
    }
    DBQueryWarn("unlock tables");
    $self->{'DBROW'}->{'locked'} = time();
    return 0;
}

sub Unlock($)
{
    my ($self) = @_;
    my $profileid = $self->profileid();

    return -1
	if (! DBQueryWarn("update apt_profiles set ".
			  "   locked=null,locker_pid=0 ".
			  "where profileid='$profileid'"));
    
    $self->{'DBROW'}->{'locked'} = 0;
    return 0;
}

#
# Update the disk image inside a profile. We update the URL for the
# specified node, and if $all is set, we change all nodes with the
# same original disk image as the specified node.
#
sub UpdateDiskImage($$@)
{
    my ($self, $node_id, $image_url, $all) = @_;
    my $rspec = GeniXML::Parse($self->rspec());
    if (! defined($rspec)) {
	print STDERR "UpdateDiskImage: Could not parse rspec\n";
	return -1;
    }
    #
    # Find all the nodes we want to update, might be just the one or
    # all with the same image.
    #
    my @nodes = ();
    my $node;

    # First find the specified node.
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	if (GeniXML::GetVirtualId($ref) eq $node_id) {
	    $node = $ref;
	    last;
	}
    }
    if (!defined($node)) {
	print STDERR "$node_id not in rspec\n";
	return -1;
    }
    if ($all) {
	#
	# Pull out the disk url/urn of the specified node.
	#
	my $Odiskref = GeniXML::GetDiskImage($node);
	my $image_urn;
	my $image_url;
	if (defined($Odiskref)) {
	    $image_url = GeniXML::GetText("url", $Odiskref);
	    $image_urn = GeniXML::GetText("name", $Odiskref);
	    if (defined($image_url) || defined($image_urn)) {
		# Watch for url in the name, flipflop. 
		if (defined($image_urn) && $image_urn =~ /^http/) {
		    $image_url = $image_urn;
		    $image_urn = undef;
		}
	    }
	}
	#
	# Now find all nodes using the same disk urn/url and change.
	#
	foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	    my $diskref   = GeniXML::GetDiskImage($ref);
	    #
	    # If the both this node and the original node did not
	    # specify a disk image, then we update it. 
	    #
	    if (!defined($diskref)) {
		push(@nodes, $ref)
		    if (!defined($Odiskref));
		next;
	    }
	    my $this_url = GeniXML::GetText("url", $diskref);
	    my $this_urn = GeniXML::GetText("name", $diskref);
	    next
		if (!(defined($image_url) || defined($image_urn)));

	    # Watch for url in the name, flipflop. 
	    if (defined($this_urn) && $this_urn =~ /^http/) {
		$this_url = $this_urn;
		$this_urn = undef;
	    }
	    if (defined($image_url)) {
		push(@nodes, $ref)
		    if (defined($this_url) && $this_url eq $image_url);
	    }
	    else {
		push(@nodes, $ref)
 		    if (defined($this_urn) && $this_urn eq $image_urn);
	    }
	}
    }
    else {
	@nodes = ($node);
    }
    if (!@nodes) {
	print STDERR "Could not find any nodes to update disk image\n";
	return -1;
    }
    foreach my $node (@nodes) {
	GeniXML::SetDiskImage($node, $image_url);
    }
    if ($self->UpdateVersion({"rspec" => GeniXML::Serialize($rspec)})) {
	print STDERR "UpdateDiskImage: Could not update rspec\n";
	return -1;
    }
    return 0;
}

# Total nonsense, to be thrown away.
sub CheckNodeConstraints($$$)
{
    my ($self, $default_aggregate_urn, $pmsg) = @_;
    my $cloudwww = "www.utah.cloudlab.us";
    my $cloudurn = "urn:publicid:IDN+utah.cloudlab.us+authority+cm";
    require URI;

    my $rspec = GeniXML::Parse($self->rspec());
    if (! defined($rspec)) {
	print STDERR "Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	my $client_id = GetVirtualId($ref);
	my $virtualization_type = GeniXML::GetVirtualizationSubtype($ref);
	my $manager_urn = GetManagerId($ref);
	if (! defined($manager_urn)) {
	    $manager_urn = $default_aggregate_urn;
	}
	my $iscloudlab = ($manager_urn eq $cloudurn ? 1 : 0);

	if (defined($virtualization_type) && $iscloudlab &&
	    $virtualization_type eq "emulab-xen") {
	    $$pmsg = "Node '$client_id' is a XEN VM, which is ".
		"not supported on the Cloudlab cluster";
	    return -1;
	}
	my $diskref   = GeniXML::GetDiskImage($ref);
	next
	    if (!defined($diskref));
	my $image_url = GeniXML::GetText("url", $diskref);
	my $image_urn = GeniXML::GetText("name", $diskref);
	next
	    if (!(defined($image_url) || defined($image_urn)));

	# Watch for url in the name, flipflop. 
	if (defined($image_urn) && $image_urn =~ /^http/) {
	    $image_url = $image_urn;
	    $image_urn = undef;
	}

	if (defined($image_urn)) {
	    if ($image_urn =~ /UBUNTU14\-10\-64\-OS/) {
		return 0;
	    }
	    elsif ($iscloudlab &&
		   !($image_urn =~ /ARM/ || $image_urn =~ /HPC/)) {
		$$pmsg = "The disk image specified for node '$client_id' ".
		    "will not run on the Cloudlab cluster";
		return -1;
	    }
	    elsif (!$iscloudlab && $image_urn =~ /ARM/) {
		$$pmsg = "The disk image specified for node '$client_id' ".
		    "will only run on the Cloudlab cluster";
		return -1;
	    }
	}
	next if
	    (!defined($image_url));

	# Get the hostname for the image URL.
	my $uri = URI->new($image_url);
	if (!defined($uri)) {
	    print STDERR "Could not parse $image_url\n";
	    return -1;
	}
	my $image_host = $uri->host();

	if ($iscloudlab) {
	    if ($image_host ne $cloudwww) {
		$$pmsg = "The disk image specified for node '$client_id' ".
		    "will not run on the Cloudlab cluster";
		return -1;
	    }
	}
	else {
	    if ($image_host eq $cloudwww) {
		$$pmsg = "The disk image specified for node '$client_id' ".
		    "will not run on cluster you selected";
		return -1;
	    }
	}
    }
    return 0;
}

#
# Check blockstores. 
#
sub CheckDatasets($$$)
{
    my ($xml, $ppid, $pmsg) = @_;
    my $pid = $ppid;
    
    my $rspec = GeniXML::Parse($xml);
    if (! defined($rspec)) {
	print STDERR "CheckDatasets: Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	my $manager_urn = GetManagerId($ref);	
	
	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore",
						   $ref,
				   $GeniXML::EMULAB_NS)->get_nodelist()) {
	    my $dataset_id  = GeniXML::GetText("dataset", $blockref);
	    my $class       = GeniXML::GetText("class", $blockref);

	    #
	    # We only care about datasets here, we let the backend
	    # do the error checking on ephemeral blockstores.
	    #
	    next
		if (!defined($dataset_id));

	    if (!defined($class)) {
		$class = "remote";
	    }
	    elsif ($class ne "local" && $class ne "remote") {
		$$pmsg = "class must be local or remote";
		return 1;
	    }

	    #
	    # If the dataset is local and its a URL, then make sure its
	    # a valid URL.
	    #
	    if ($class eq "local" && $dataset_id =~ /^(http|https):/) {
		if (!TBcheck_dbslot($dataset_id, "virt_nodes", "osname",
				TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)){
		    $$pmsg = "Invalid url for dataset";
		    return 1;
		}
		next;
	    }
	    if (!GeniHRN::IsValid($dataset_id)) {
		$$pmsg = "Persistent dataset is not a valid URN";
		return 1;
	    }
	    my $dataset_urn = $dataset_id;
	    my ($dataset_authority, $type, $id) = GeniHRN::Parse($dataset_urn);
	    my ($dataset_domain) = split(":", $dataset_authority);
	    
	    #
	    # Separate project from name; this is how the rspec specifies
	    # the dataset they want, since it might be in another project
	    #
	    if ($id =~ /^([-\w]+)\/\/(.+)$/) {
		$pid = $1;
		$id  = $2;
	    }

	    #
	    # The domain of the dataset has to match the domain of aggregate.
	    # We also use this when creating a profile, so rspec might not
	    # be bound.
	    #
	    if (defined($manager_urn)) {
		my ($manager_authority) = GeniHRN::Parse($manager_urn);
		my ($manager_domain) = split(":", $manager_authority);
		
		if ($manager_domain ne $dataset_domain) {
		    $$pmsg = "Dataset $id is not located on $manager_authority";
		    return 1;
		}
	    }
	    next
		if ($class eq "local");
	    
	    #
	    # Not all backends have blockstore support.
	    #
	    if (!APT_Dataset::ValidBlockstoreBackend($dataset_authority)) {
		$$pmsg = "Dataset $id is not on a valid aggregate";
		return 1;
	    }

	    my $dataset = APT_Dataset->Lookup("$pid/$id");
	    if (!defined($dataset)) {
		$dataset = APT_Dataset->LookupByRemoteURN($dataset_urn);
		if (!defined($dataset)) {
		    $$pmsg = "Persistent dataset '$pid/$id' does not exist";
		    return 1;
		}
	    }
	    #
	    # XXX Need basic frontend permission checks?
	    #
	}
    }
    return 0;
}

#
# Set the component_manager_urn for the sites.
#
sub SetSites($$$$)
{
    my ($prspecstr, $sitemap, $pneedstitcher, $perrmsg) = @_;
    my %interface_map = ();

    my $rspec = GeniXML::Parse($$prspecstr);
    if (! defined($rspec)) {
	$$perrmsg = "Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	my $client_id   = GetVirtualId($ref);
	my $site_id     = GeniXML::GetJacksSiteId($ref);

	if (!defined($site_id)) {
	    $$perrmsg = "No site ID for node $client_id";
	    return -1;
	}
	my $site_mid = "site:" . $site_id;
	if (!exists($sitemap->{$site_mid})) {
	    $$perrmsg = "No site mapping for node $client_id ($site_id)";
	    return -1;
	}
	GeniXML::SetManagerId($ref, $sitemap->{$site_mid});
	GeniXML::SetJacksSiteManagerId($ref, $sitemap->{$site_mid});

	#
	# Get all of the interfaces, we need those for the links, so
	# we can add the managers to them, according to site id.
	#
	foreach my $iref (GeniXML::FindNodes("n:interface",
					     $ref)->get_nodelist()) {
	    my $client_id = GeniXML::GetInterfaceId($iref);
	    $interface_map{$client_id} = $site_mid;
	}
    }
    foreach my $ref (GeniXML::FindNodes("n:link", $rspec)->get_nodelist()) {
	my %linksites = ();
	my $client_id = GetVirtualId($ref);

	foreach my $iref (GeniXML::FindNodes("n:interface_ref",
					     $ref)->get_nodelist()) {
	    my $client_id = GeniXML::GetInterfaceId($iref);
	    next
		if (!exists($interface_map{$client_id}));

	    my $site_mid = $interface_map{$client_id};
	    GeniXML::AddManagerToLink($ref, $sitemap->{$site_mid});
	    $linksites{$sitemap->{$site_mid}} = 1;
	}
	# if more then one site for a link, must use the stitcher.
	$$pneedstitcher = 1
	    if (keys(%linksites) > 1);
    }
    $$prspecstr = GeniXML::Serialize($rspec);
    return 0;
}

#
# Set the component_manager_urn for the rspec
#
sub BindRspec($$$)
{
    my ($prspecstr, $aggregate_urn, $perrmsg) = @_;

    my $rspec = GeniXML::Parse($$prspecstr);
    if (! defined($rspec)) {
	$$perrmsg = "Could not parse rspec\n";
	return -1;
    }
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
	GeniXML::SetManagerId($ref, $aggregate_urn);
    }
    $$prspecstr = GeniXML::Serialize($rspec);
    return 0;
}

sub IsHead($)
{
    my ($self) = @_;

    my $profileid = $self->profileid();

    my $query_result =
	DBQueryWarn("select max(version) from apt_profile_versions ".
		    "where profileid='$profileid'");
    return -1
	if (!$query_result || !$query_result->numrows);

    my ($head) = $query_result->fetchrow_array();
    return ($head == $self->version() ? 1 : 0);
}

#
# Publish a profile. Not sure what this really means yet.
#
sub Publish($)
{
    my ($self) = @_;
    my $profileid = $self->profileid();
    my $version   = $self->version();

    return -1
	if (! DBQueryWarn("update apt_profile_versions set published=now() ".
			  "where profileid='$profileid' and ".
			  "      version='$version'"));
    
    $self->{'DBROW'}->{'published'} = time();
    return 0;

}

#
# Manage URL
#
sub AdminURL($)
{
    my ($self) = @_;
    my $uuid   = $self->uuid();
    
    require Project;
    
    my $project = Project->Lookup($self->pid_idx());
    return undef
	if (!defined($project));
    
    my $wwwbase = $project->wwwBase();
    $wwwbase .= "/apt"
	if ($project->Brand()->isEmulab());

    return $wwwbase . "/manage_profile.php?uuid=$uuid";
}

# _Always_ make sure that this 1 is at the end of the file...
1;