Create a new XMLRPC endpoint for the GENI AM.

Enabling and disabling the GENI AM API is a matter of adjusting the
Apache configuration to grant access to the /protogeni/xmlrpc/am
directory. This leaves the existing XMLRPC interfaces intact and
undisturbed.

apache/httpd.conf.in

@@ -1340,6 +1340,9 @@ ScriptAlias /protogeni/xmlrpc/ch @prefix@/protogeni/xmlrpc/protogeni-ch.pl
 ScriptAlias /protogeni/xmlrpc/cm @prefix@/protogeni/xmlrpc/protogeni-cm.pl
 ScriptAlias /protogeni/xmlrpc/sa @prefix@/protogeni/xmlrpc/protogeni-sa.pl
 ScriptAlias /protogeni/xmlrpc/ses @prefix@/protogeni/xmlrpc/protogeni-ses.pl
+<IfDefine GENI_AM>
+ScriptAlias /protogeni/xmlrpc/am @prefix@/protogeni/xmlrpc/geni-am.pl
+</IfDefine>
 <Directory "@prefix@/www/protogeni">
 	SSLRequireSSL
 	Order deny,allow

protogeni/xmlrpc/GNUmakefile.in

@@ -21,7 +21,7 @@ SETUID_LIBX_SCRIPTS  =
 # configure if the .in file is changed.
 # 
 all:	protogeni-cm.pl protogeni-ch.pl protogeni-sa.pl protogeni-ses.pl \
-	Genixmlrpc.pm GeniResponse.pm 
+	Genixmlrpc.pm GeniResponse.pm geni-am.pl
 
 include $(TESTBED_SRCDIR)/GNUmakerules
 
@@ -33,7 +33,8 @@ install-libs: $(INSTALL_LIBDIR)/Genixmlrpc.pm \
 install-scripts: $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-sa.pl \
 		$(INSTALL_DIR)/protogeni/xmlrpc/protogeni-cm.pl \
 		$(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ch.pl \
-		$(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ses.pl
+		$(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ses.pl \
+		$(INSTALL_DIR)/protogeni/xmlrpc/geni-am.pl
 	$(SUDO) chown root $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-sa.pl
 	$(SUDO) chmod u+s  $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-sa.pl
 	$(SUDO) chown root $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ch.pl
@@ -42,6 +43,8 @@ install-scripts: $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-sa.pl \
 	$(SUDO) chmod u+s  $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-cm.pl
 	$(SUDO) chown root $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ses.pl
 	$(SUDO) chmod u+s  $(INSTALL_DIR)/protogeni/xmlrpc/protogeni-ses.pl
+	$(SUDO) chown root $(INSTALL_DIR)/protogeni/xmlrpc/geni-am.pl
+	$(SUDO) chmod u+s  $(INSTALL_DIR)/protogeni/xmlrpc/geni-am.pl
 
 install: install-libs install-scripts
 

protogeni/xmlrpc/geni-am.pl.in

+#!/usr/bin/perl -w
+#
+# GENIPUBLIC-COPYRIGHT
+# Copyright (c) 2008-2010 University of Utah and the Flux Group.
+# All rights reserved.
+#
+
+#
+# Simple CGI interface to the GENI xmlrpc interface. This script is invoked
+# from the web server. The certificate information is in the environment
+# set up by apache.
+#
+use strict;
+use English;
+use Frontier::Responder;
+use Frontier::RPC2;
+use Data::Dumper;
+use POSIX;
+
+# Yack. apache does not close fds before the exec, and if this dies
+# we are left with a giant mess.
+BEGIN {
+    no warnings;
+    for (my $i = 3; $i < 2048; $i++) {
+      POSIX:close($i);
+    }
+}
+
+# Do this early so that we talk to the right DB.
+use vars qw($GENI_DBNAME);
+BEGIN { $GENI_DBNAME = "geni-cm"; }
+
+# Configure variables
+my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
+my $MAINSITE 	   = @TBMAINSITE@;
+my $VERSION	   = "1.0";
+
+# Testbed libraries.
+use lib '@prefix@/lib';
+use GeniAM;
+use Genixmlrpc;
+use GeniResponse;
+use libaudit;
+
+# Geniuser.
+my $user  = "geniuser";
+my $group = "GeniSlices";
+
+# Need a command line option.
+my $debug = 0;
+
+# Determined by version.
+my $responder;
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Untaint the path
+#
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+#
+# So we know who/what we are acting as.
+#
+my $certificate = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
+if (!defined($certificate)) {
+    die("*** $0:\n".
+	"    Could not get uuid from $EMULAB_PEMFILE\n");
+}
+$ENV{'MYUUID'} = $certificate->uuid();
+# The URN could also come from the certificate, and that might be preferable
+# in some ways (if anybody is doing something silly like authenticating
+# with somebody else's certificate).  But that would require everybody to
+# upgrade to URNs in their certificates, so we can't assume it yet.
+$ENV{'MYURN'} = "urn:publicid:IDN+@OURDOMAIN@+authority+cm";
+
+#
+# In the prototype, we accept certificate signed by trusted roots
+# (CA certs we have locally cached). This script runs as "geniuser"
+# so that there is an emulab user context, or many of the scripts we
+# invoke will complain and croak. 
+#
+my $unix_uid = getpwnam("$user") or
+    die("*** $0:\n".
+	"    No such user $user\n");
+my $unix_gid = getgrnam("$group") or
+    die("*** $0:\n".
+	"    No such group $group\n");
+
+# Flip to user and never go back
+$GID            = $unix_gid;
+$EGID           = "$unix_gid $unix_gid";
+$EUID = $UID    = $unix_uid;
+$ENV{'USER'}    = $user;
+$ENV{'LOGNAME'} = $user;
+
+#
+# The UUID of the client certificate is in the env var SSL_CLIENT_S_DN_CN.
+# If it actually looks like a UUID, then this correponds to an actual user,
+# and the supplied credentials/tickets must match. At present, if there is
+# no UUID, it is another emulab making a request directly, with no user
+# context, and we just let that pass for now.
+#
+if (exists($ENV{'SSL_CLIENT_S_DN_CN'}) &&
+    $ENV{'SSL_CLIENT_S_DN_CN'} =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
+    $ENV{'GENIUSER'} = $ENV{'SSL_CLIENT_S_DN_CN'};
+    $ENV{'GENIUUID'} = $ENV{'SSL_CLIENT_S_DN_CN'};
+}
+else {
+    my $decoder = Frontier::RPC2->new();
+    print "Content-Type: text/xml \n\n";
+    print $decoder->encode_fault(-1, "Invalid certificate; no UUID");
+    exit(0);
+}
+#
+# Reaching into the Frontier code so I can debug this crap.
+#
+my $request = Frontier::Responder::get_cgi_request();
+if (!defined($request)) {
+    print "Content-Type: text/txt\n\n";
+    exit(0);
+}
+
+if (exists($ENV{'PATH_INFO'}) && $ENV{'PATH_INFO'} ne "") {
+    my $pathinfo = $ENV{'PATH_INFO'};
+    $pathinfo =~ s/^\///;
+    my @parts = split(/\//, $pathinfo);
+    if (@parts) {
+	my $v = $parts[0];
+	if ($v =~ /^[\d\.]+$/) {
+	    $VERSION = "$v";
+	}
+    }
+}
+
+#
+# Create and set our RPC context for any calls we end up making.
+#
+Genixmlrpc->SetContext(Genixmlrpc->Context($certificate));
+
+if ($VERSION eq "1.0") {
+    $responder = Frontier::Responder->new( "methods" => {
+	"GetVersion"    => \&GeniAM::GetVersion,
+	"ListResources" => \&GeniAM::ListResources,
+	"CreateSliver"  => \&GeniAM::CreateSliver,
+        "DeleteSliver"  => \&GeniAM::DeleteSliver,
+        "SliverStatus"  => \&GeniAM::SliverStatus,
+        "RenewSliver"   => \&GeniAM::RenewSliver,
+        "Shutdown"      => \&GeniAM::Shutdown,
+    },);
+}
+else {
+    my $decoder = Frontier::RPC2->new();
+    print "Content-Type: text/xml \n\n";
+    print $decoder->encode_fault(-3, "Invalid API Version");
+    exit(0);
+}
+
+#
+# Use libaudit to capture any output from libraries and programs.
+# Send that to tbops so they can be fixed.
+#
+if ($MAINSITE) {
+    LogStart(0);
+    AddAuditInfo("to", "protogeni-errors\@flux.utah.edu")
+}
+else {
+    LogStart(0, undef, LIBAUDIT_LOGTBOPS());
+}
+
+# Add stuff for log message if sent.
+AddAuditInfo("message", $request);
+# CC errors to Utah for now.
+AddAuditInfo("cc", "protogeni-errors\@flux.utah.edu")
+    if (!$MAINSITE);
+
+my $response = $responder->{'_decode'}->serve($request,
+					      $responder->{'methods'});
+
+# Add stuff for log message if sent.
+AddAuditInfo("message", $response . "\n\n" . $request);
+
+# When debugging on, generate some output so email is sent.
+if ($debug) {
+    my $decoder = Frontier::RPC2->new();
+    my $object  = $decoder->decode($response);
+    my $value   = $object->{'value'};
+    print STDERR Dumper($value);
+}
+
+#
+# Terminate the log capture so that we can print the response to STDOUT
+# for the web server.
+#
+LogEnd(0);
+
+print "Content-Type: text/xml \n\n" . $response;
+exit(0);
+
+#
+# Want to prevent bad exit.
+#
+END {
+    my $exitcode = $?;
+
+    if ($exitcode) {
+	LogEnd(0);
+
+	my $decoder = Frontier::RPC2->new();
+	print "Content-Type: text/xml \n\n";
+	print $decoder->encode_fault(-2, "XMLRPC Server Error");
+
+	# Since we converted to a normal error and sent the log message.
+	$? = 0;
+    }
+}
+