All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

protogeni-cm.pl.in 4.28 KB
Newer Older
1 2 3
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
5 6 7 8
# All rights reserved.
#

#
9
# Simple CGI interface to the GENI xmlrpc interface. This script is invoked
10 11 12 13
# from the web server. The certificate information is in the environment
# set up by apache.
#
use strict;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
14
use English;
15
use Frontier::Responder;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
16
use Data::Dumper;
17 18 19 20 21 22 23 24 25 26
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);
    }
}
27

Leigh B. Stoller's avatar
Leigh B. Stoller committed
28 29
# Do this early so that we talk to the right DB.
use vars qw($GENI_DBNAME);
30
BEGIN { $GENI_DBNAME = "geni-cm"; }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31

32 33 34
# Configure variables
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";

35 36
# Testbed libraries.
use lib '@prefix@/lib';
Leigh B. Stoller's avatar
Leigh B. Stoller committed
37
use GeniCM;
38
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
39
use libaudit;
40

Leigh B. Stoller's avatar
Leigh B. Stoller committed
41 42 43 44
# Geniuser.
my $user  = "geniuser";
my $group = "GeniSlices";

45 46 47 48 49 50 51 52 53 54 55
#
# 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'};

56 57 58
#
# So we know who/what we are acting as.
#
59 60
my $certificate = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
if (!defined($certificate)) {
61 62 63
    die("*** $0:\n".
	"    Could not get uuid from $EMULAB_PEMFILE\n");
}
64
$ENV{'MYUUID'} = $certificate->uuid();
65

Leigh B. Stoller's avatar
Leigh B. Stoller committed
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
#
# 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;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
86 87 88 89 90 91 92 93 94 95
#
# 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'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
    $ENV{'GENIUUID'} = $ENV{'SSL_CLIENT_S_DN_CN'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
97 98
}
else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
99 100 101 102 103
    my $decoder = Frontier::RPC2->new();
    print "Content-Type: text/xml \n\n";
    print $decoder->encode_fault(-1, "Invalid certificate; no UUID");
    exit(0);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
104 105 106 107 108 109 110 111
#
# 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);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
112

Leigh B. Stoller's avatar
Leigh B. Stoller committed
113 114 115 116
#
# Use libaudit to capture any output from libraries and programs.
# Send that to tbops so they can be fixed.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
117
LogStart(0, undef, LIBAUDIT_LOGTBOPS());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
118

119 120 121
#
# Create and set our RPC context for any calls we end up making.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
122
Genixmlrpc->SetContext(Genixmlrpc->Context($certificate));
123

124
my $responder = Frontier::Responder->new( "methods" => {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
125
    "Resolve"	        => \&GeniCM::Resolve,
126 127
    "DiscoverResources" => \&GeniCM::DiscoverResources,
    "GetTicket"         => \&GeniCM::GetTicket,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128
    "ReleaseTicket"     => \&GeniCM::ReleaseTicket,
129 130 131
    "RedeemTicket"      => \&GeniCM::RedeemTicket,
    "StartSliver"       => \&GeniCM::StartSliver,
    "DeleteSliver"      => \&GeniCM::DeleteSliver,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
132
    "DeleteSlice"       => \&GeniCM::DeleteSlice,
133
    "SplitSliver"       => \&GeniCM::SplitSliver,
134
    "UpdateSliver"      => \&GeniCM::UpdateSliver,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
135
    "GetSliver"         => \&GeniCM::GetSliver,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
136
    "BindToSlice"       => \&GeniCM::BindToSlice,
137
    "Shutdown"          => \&GeniCM::Shutdown,
138
    "ListUsage"         => \&GeniCM::ListUsage,
139 140
    "SliceStatus"       => \&GeniCM::SliceStatus,
    "SliverStatus"      => \&GeniCM::SliverStatus,
141 142 143
   },
);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
144 145
my $response = $responder->{'_decode'}->serve($request,
					      $responder->{'methods'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
146

147 148
# Add stuff for log message if sent.
AddAuditInfo("message", $response . "\n\n" . $request);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
149 150 151 152
#
# Terminate the log capture so that we can print the response to STDOUT
# for the web server.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153
LogEnd(0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
154

Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
print "Content-Type: text/xml \n\n" . $response;
156
exit(0);