GeniEmulab.pm.in

#!/usr/bin/perl -w
#
# GENIPUBLIC-COPYRIGHT
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniEmulab;

#
# Stuff to interface between Emulab core and Geni nodes.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
use GeniComponent;
use GeniAuthority;
use GeniRegistry;
use GeniSlice;
use GeniSliver;
use GeniUser;
use GeniHRN;
use GeniXML;
use libtestbed;
use User;
use Node;
use Interface;
use Lan;
use English;
use XML::Simple;
use Data::Dumper;
use Experiment;
use libdb qw(TBDB_IFACEROLE_CONTROL TBDB_IFACEROLE_EXPERIMENT);

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $SACERT         = "$TB/etc/genisa.pem";

#
# Initialize for using geni resources.
#
sub RegisterExperiment($$)
{
    my ($experiment, $user) = @_;

    my $slice = GeniSlice->LookupByExperiment($experiment);
    return 0
	if (defined($slice));

    #
    # Load the SA cert to act as caller context.
    #
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return -1;
    }
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
    }
    #
    # Set the default RPC context. 
    #
    Genixmlrpc->SetContext($context);

    #
    # Create a Geni user from the supplied Emulab user.
    #
    my $geniuser = GeniUser->CreateFromLocal($user);
    if (!defined($geniuser)) {
	print STDERR "Could not create a geni user from current user $user\n";
	return -1;
    }
    # Register user at the ClearingHouse.
    print STDERR "Registering $geniuser at the ClearingHouse.\n";
    if ($geniuser->Register() != 0) {
	print STDERR "Could not register $geniuser at the ClearingHouse.\n";
	return -1;
    }

    #
    # Create and register the slice.
    #
    print STDERR "Creating new slice for $experiment\n";
    $slice = GeniSlice->CreateFromLocal($experiment, $user);
    if (!defined($slice)) {
	print STDERR "Could not create local slice from $experiment\n";
	return -1;
    }
    print STDERR "Registering $slice at the ClearingHouse.\n";
    if ($slice->Register() != 0) {
	$slice->Delete();
	print STDERR "Could not register slice for $experiment\n";
	return -1;
    }
    return 0;
}

#
# Delete the slice record from the ClearingHouse and then locally.
#
sub UnRegisterExperiment($)
{
    my ($experiment) = @_;

    my $slice = GeniSlice->LookupByExperiment($experiment);
    return 0
	if (!defined($slice));

    #
    # Load the SA cert to act as caller context.
    #
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return -1;
    }
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
    }
    #
    # Set the default RPC context. 
    #
    Genixmlrpc->SetContext($context);

    print STDERR "Unregistering $slice at the ClearingHouse.\n";
    if ($slice->UnRegister() != 0) {
	print STDERR "Could not unregister $slice for $experiment\n";
	return -1;
    }
    if ($slice->Delete()) {
	print STDERR "Could not delete $slice for $experiment\n";
	return -1;
    }
    return 0;
}

#
# Create a physical node on the fly. 
#
sub CreatePhysNode($)
{
    my ($node_urn) = @_;
    my $blob;
    my @ifaces;
    my $ctrliface;

    my ($auth,$type,$node_id) = GeniHRN::Parse($node_urn);
    my $manager_urn = GeniHRN::Generate($auth, "authority", "cm");

#    print STDERR "$node_urn\n";

    #
    # Load the SA cert to act as caller context.
    #
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return undef;
    }
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
	return undef;
    }
    #
    # Set the default RPC context. 
    #
    Genixmlrpc->SetContext($context);

    my $authority = GeniAuthority->Lookup($manager_urn);
    if (!defined($authority)) {
	$authority = GeniAuthority->CreateFromRegistry("cm", $manager_urn);
	if (!defined($authority)) {
	    print STDERR "Could not lookup $manager_urn at ClearingHouse\n";
	    return undef;
	}
    }

    #
    # Until this urn stuff is done.
    #
    my ($translated)  = $authority->hrn() =~ /^([-\w]+)\..*/;
    my $node_hrn      = $translated . "." . $node_id;

#    print STDERR "$node_hrn\n";

    my $component = GeniComponent->Lookup($node_hrn);
    if (defined($component)) {
	my $node = Node->Lookup($component->uuid());
	return $node
	    if (defined($node));
    }
    else {
	$component = GeniComponent->CreateFromRegistry($node_urn);
	if (!defined($component)) {
	    print STDERR "Could not lookup $node_urn at ClearingHouse\n";
	    return undef;
	}
    }

    print STDERR "Creating local node for $node_urn\n";

    my $credential = GeniRegistry::Client->CreateCredential($component);
    if (!defined($credential)) {
	print STDERR "Could not create a credential for $component\n";
	return undef;
    }
    my $registry = GeniRegistry::Client->Create($component,undef,$credential);
    if (!defined($registry)) {
	print STDERR "Could not create a registry client for $component\n";
	return undef;
    }
    if ($registry->Resolve($component->uuid(), "Node", \$blob)) {
	print STDERR "Could not resolve $component at $registry\n";
	return undef;
    }

    my $hrn      = $blob->{'hrn'};
    my $IP       = $blob->{'physctrl'};
    my $hostname = $blob->{'hostname'};
    my $uuid     = $blob->{'uuid'};
    if (! (defined($hrn) && defined($IP) && defined($hostname) &&
	   defined($uuid))) {
	print STDERR "Missing stuff in blob from CM for $node_urn\n";
	goto bad;
    }
    if (! ($hrn =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid hrn '$hrn' in blob from CM for $node_urn\n";
	goto bad;
    }
    if (! ($IP =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid IP '$IP' in blob from CM for $node_urn\n";
	goto bad;
    }
    if (! ($uuid =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid uuid '$uuid' in blob from CM for $node_urn\n";
	goto bad;
    }
    if (! ($hostname =~ /^[-\w\.]*$/)) {
	print STDERR
	    "Invalid hostname '$hostname' in blob from CM for $node_urn\n";
	goto bad;
    }
    $node_id = $hrn;
    $node_id =~ s/\./\-/g;
    
    if (length($node_id) > 32) {
	print STDERR "Nodeid '$node_id' too long for $node_urn\n";
	goto bad;
    }

    #
    # Find control network.
    #
    if (exists($blob->{'interfaces'})) {
	foreach my $ref (@{ $blob->{'interfaces'} }) {
	    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL() ||
		$ref->{'role'} eq TBDB_IFACEROLE_EXPERIMENT()) {
		my $MAC = $ref->{'MAC'};
		if (!defined($MAC) || !($MAC =~ /^[:\w]*$/)) {
		    print STDERR "Bad mac in blob for $node_urn:\n";
		    goto bad;
		}
		my $IIP = $ref->{'IP'};
		if (!defined($IIP) || !($IIP =~ /^[-\w\.]*$/)) {
		    print STDERR "Bad IP in blob for $node_urn:\n";
		    goto bad;
		}
		my ($card) = ($ref->{'iface'} =~ /^\D*(\d*)$/);
		if (!defined($card)) {
		    print STDERR "Bad iface in blob for $node_urn:\n";
		    goto bad;
		}
		
		my $ifaceargs = {
		    "card"      => $card,
		    "role"      => $ref->{'role'},
		    "MAC"       => $MAC,
		    "IP"        => $IIP,
		    "type"      => "fxp",
		};
		push(@ifaces, $ifaceargs);

		$ctrliface = $ifaceargs
		    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL());
	    }
	}
    }
    elsif (exists($blob->{'rspec'})) {
	my $rspec = GeniXML::Parse($blob->{'rspec'});
	if (!defined($rspec)) {
	    goto bad;
	}
	foreach my $noderef (GeniXML::FindNodes("n:node",
						$rspec)->get_nodelist()) {
	    next
		if (GeniXML::GetNodeId($noderef) ne $node_urn);
	    next
		if (! defined(GeniXML::FindFirst("n:interface", $noderef)));

	    my $count = 0;
	    
	    foreach my $ref (GeniXML::FindNodes("n:interface",
						$noderef)->get_nodelist()) {
		my $component_id = GeniXML::GetText("component_id", $ref);
		my $role = GeniXML::GetText("role", $ref);
		if (! defined($role)) {
		    $role = "expt";
		}
		my $MAC  = "00000000000" . $count;

		my ($auth,$id,$iface) = GeniHRN::ParseInterface($component_id);

		my $ifaceargs = {
		    "card"      => $count,
		    "iface"     => $iface,
		    "role"      => $role,
		    "MAC"       => $MAC,
		    "IP"        => '',
		    "type"      => "fxp",
		};
		push(@ifaces, $ifaceargs);

		if ($role eq "control") {
		    $ctrliface = $ifaceargs;
		    $ifaceargs->{'IP'}   = $ref->{'public_ipv4'};
		    $ifaceargs->{'role'} = TBDB_IFACEROLE_CONTROL();
		}
		$count++;
		#print Dumper($ifaceargs);
	    }
	}
    }
    if (! @ifaces) {
	print STDERR "No interfaces in blob for $node_urn!\n";
	goto bad;
    }
    if (!defined($ctrliface)) {
	print STDERR "No control interface in blob for $node_urn!\n";
	goto bad;
    }		   
    my $newnode = Node->Create($node_id, undef,
			       {"role"      => "testnode",
				"type"      => "pcfedphys",
				"uuid"      => $uuid,
				"hostname"  => $hostname,
				"external_node_id" => $node_urn,
				"IP"        => $IP});
    if (!defined($newnode)) {
	print STDERR "Could not create new node from blob for $node_urn\n";
	goto bad;
    }
    foreach my $ifaceargs (@ifaces) {
	my $interface = Interface->Create($newnode, $ifaceargs);
	if (!defined($interface)) {
	    $newnode->Delete();
	    print STDERR
		"Could not create interface from blob for $node_urn\n";
	    print STDERR Dumper($ifaceargs);
	    goto bad;
	}
    }
    return $newnode;
  bad:
    print STDERR Dumper($blob);
    return undef;
}

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