GeniSES.pm.in 5.01 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
#!/usr/bin/perl -wT
#
# GENIPUBLIC-COPYRIGHT
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniSES;

#
# The server side of the SES interface. The SES is currently just an
# XMLRPC wrapper around "assign" (from Emulab).
#
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 User;
use Genixmlrpc;
use GeniResponse;
use GeniUser;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAuthority;
use GeniHRN;
use English;
use XML::Simple;
use Data::Dumper;
use File::Temp qw/tempfile/;
36 37 38
use Scalar::Util;
use MIME::Base64;
use Compress::Zlib;
39 40 41 42 43 44 45

# Configure variables
my $TB		   = "@prefix@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
my $HAVE_XERCES    = "@HAVE_XERCES@";
my $ASSIGN	   = "$TB/libexec/assign";
46
my $ADVT_MERGE = "$TB/protogeni/scripts/advt-merge.py";
47

48 49 50 51 52 53 54 55 56 57 58 59
my $API_VERSION = 1;

#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $API_VERSION );
}

60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
#
# Map a virtual topology onto (a subset of) an advertised physical
# topology.
#
sub Map($)
{
    my ($argref) = @_;
    my $credential = $argref->{'credential'};
    my $ad = $argref->{'advertisement'};
    my $req = $argref->{'request'};

    return GeniResponse->MalformedArgsResponse() unless
	defined( $credential ) && defined( $ad ) && defined( $req );

    my $user_uuid  = $ENV{'GENIUSER'};

    $credential = GeniCredential->CreateFromSigned($credential);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }
    # The credential owner/slice has to match what was provided.
    if ($user_uuid ne $credential->owner_uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Invalid credentials for operation");
    }

    # This is a nasty way to check, but we can't do anything useful
    # if assign wasn't compiled with XML (i.e. rspec) support.
    return GeniResponse->Create( GENIRESPONSE_UNSUPPORTED )
	unless $HAVE_XERCES eq "yes";

92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
	my $multipleads = 0;
	my @adfiles;
	my @adfilenames;
	my ( $merged_adfile, $merged_adfilename ) = tempfile();
	my $mergeCmdString = "$ADVT_MERGE $merged_adfilename";
	# If the input is an array reference, multiple advertisements have 
	# been passed and they need to be merged
	if (ref($ad) eq "ARRAY") {
		$multipleads = 1;
		for(my $i = 0; $i < (@{$ad}); $i++) {
			my $advt = $ad[$i];
			# If the ad is Binary typed (and therefore base64 encoded), 
			# assume it is compressed.
			if( Scalar::Util::blessed( $advt ) 
					&& $advt->isa( "Frontier::RPC2::Base64" ) ) {
				$advt = uncompress( decode_base64( $advt->value ) );
			}
			
			( $adfiles[$i], $adfilenames[$i] ) = tempfile();
			
			return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
113
				 "Could not store advertisement" )
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
			unless defined $adfiles[$i];
			print $adfiles[$i] $advt;
			close $adfiles[$i];
			
			$mergeCmdString .= " $adfilenames[$i]";
		}
		
		my $result = system($mergeCmdString);
		return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
				 "Could not merge advertisements" )
		unless $result == 0;
	}
	# It is not a reference and it must be a single file that was passed
	elsif (!ref($ad)) {
		# If the ad is Binary typed (and therefore base64 encoded), assume
		# it is compressed.
		if( Scalar::Util::blessed( $ad ) 
					&& $ad->isa( "Frontier::RPC2::Base64" ) ) {
			$ad = uncompress( decode_base64( $ad->value ) );
		}
	
		return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
					"Could not store advertisement" )
		unless defined $merged_adfile;
		print $merged_adfile $ad;
		close $merged_adfile;
	}

	#
	# Use assign in xml mode to spit back an xml file. 
	#
	my ( $reqfile, $reqfilename ) = tempfile();
	return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
					"Could not store request" )
148
	unless defined $reqfile;
149 150
	print $reqfile $req;
	close $reqfile;
151

152
    open( ASSIGN, "$ASSIGN -P -q $merged_adfilename -w $reqfilename 2>&1 |" )
153 154 155 156 157 158 159 160
	or return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
					"Assign process failed" );

    my $assignverbosity = "";
    while( <ASSIGN> ) {
	$assignverbosity .= $_;
    }
    close ASSIGN;
161

162 163 164 165 166 167
	if ($multipleads == 1) {
		foreach $adfilename (@adfilenames) {
			unlink $adfilename;
		}
	}
    unlink $merged_adfilename;
168 169 170 171 172 173 174
    unlink $reqfilename;

    $reqfilename =~ m{(.*/)([^/]+)};
    my $annfilename = $1 . "annotated-" . $2;

    open( ANNOTATED, "<$annfilename" ) or
	return GeniResponse->Create( GENIRESPONSE_ERROR, undef,
175 176 177
				     "Failed to map topolgy:\n" .
				     $assignverbosity );

178 179 180 181 182 183 184 185 186 187 188 189
    my $xml = "";
    while ( <ANNOTATED> ) {
	$xml .= $_;
    }
    close ANNOTATED;
    unlink $annfilename;

    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $xml );
}

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