portal_xmlrpc.in 3.71 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2008-2016, 2018 University of Utah and the Flux Group.
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 36 37 38
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;
use Data::Dumper;
use Time::HiRes qw( gettimeofday tv_interval );
use JSON;

sub usage()
{
39
    print "Usage: portal_xmlrpc [-d] [-a urn] method [PARAM=VALUE ...]\n";
40 41 42 43
    exit(1);
}
my $optlist   = "da:";
my $debug     = 0;
44
my $errmsg;
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
my $aggurn;

#
# Configure variables
#
my $TB		  = "@prefix@";
my $EMCERT	  = "$TB/etc/emulab.pem";
my $EMKEY	  = "$TB/etc/emulab.key";
my $OURDOMAIN	  = "@OURDOMAIN@";
my $MYURN	  = "urn:publicid:IDN+${OURDOMAIN}+authority+cm";

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/site/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Protos
sub fatal($);

# We always use the CM db.
use vars qw($GENI_DBNAME);
$GENI_DBNAME = "geni-cm";

#
# Turn off line buffering on output
#
$| = 1; 

# Now we can load the libraries after setting the proper DB.
use lib '@prefix@/lib';
use GeniHRN;
use Genixmlrpc;
76
use GeniResponse;
77
use GeniAuthority;
78 79
use APT_Aggregate;
use APT_Geni;
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94

my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"a"})) {
    $aggurn = $options{"a"};
}
else {
    $aggurn = $MYURN;
}
usage()
95
    if (!@ARGV);
96 97 98 99 100 101 102 103 104 105
my $method = shift(@ARGV);

my $context = Genixmlrpc->Context($EMCERT, $EMKEY);
if (!defined($context)) {
    fatal("Could not create context to talk to image server");
}
Genixmlrpc->SetContext($context);
# Shorten default timeout.
Genixmlrpc->SetTimeout(15);

106 107 108 109
my $aggregate = APT_Aggregate->Lookup($aggurn);
if (!defined($aggregate)) {
    fatal("No such aggregate: $aggurn");
}
110 111
my $authority = GeniAuthority->Lookup($aggurn);
if (!defined($authority)) {
112
    fatal("No such aggregate authority: $aggurn");
113
}
114 115 116 117
# Check online and reachable. Additional arg says to test Portal RPC.
if ($aggregate->CheckStatus(\$errmsg, 1)) {
    print STDERR $errmsg . "\n";
    exit(1);
118
}
119

120 121 122 123 124 125 126
my @args = ();
if (@ARGV) {
    my $args = {};

    while (@ARGV) {
	my $opt = shift(@ARGV);
	if ($opt =~ /^(.*)=(.*)$/) {
Leigh B Stoller's avatar
Leigh B Stoller committed
127 128 129 130 131 132
	    if ($2 eq "[]") {
		$args->{$1} = [];
	    }
	    else {
		$args->{$1} = $2;
	    }
133 134 135 136 137 138 139
	}
	else {
	    fatal("Bad option: $opt");
	}
    }
    @args = ($args);
}
140
my $starttime = [gettimeofday()];
141
my $response  = APT_Geni::PortalRPC($authority, undef, $method, @args);
142 143
my $elapsed   = tv_interval($starttime);

144
if ($response->code() != GENIRESPONSE_SUCCESS) {
145
    print STDERR $response->error() . "\n";
146 147
    exit($response->code());
}
148
print encode_json($response->value());
149
exit(0);
150 151 152 153 154 155 156 157 158 159

sub fatal($)
{
    my ($msg) = @_;

    print STDERR "*** $0:\n".
	         "    $msg\n";
    # exit value important.
    exit(-1);
}