2011-05-20 15:36:27 +00:00
#!/usr/bin/perl
2014-02-23 09:13:15 +00:00
# IBM(c) 2014 EPL license http://www.eclipse.org/legal/epl-v10.html
2011-05-20 15:36:27 +00:00
use strict;
2014-02-03 20:58:15 +00:00
use CGI qw/:standard/; #todo: remove :standard when the code only uses object oriented interface
2014-02-27 00:34:16 +00:00
#use JSON; #todo: require this dynamically later on so that installations that do not use xcatws.cgi do not need perl-JSON
2011-05-20 15:36:27 +00:00
use Data::Dumper;
2014-02-03 20:58:15 +00:00
#talk to the server
use Socket;
use IO::Socket::INET;
use IO::Socket::SSL;
use lib "/opt/xcat/lib/perl";
use xCAT::Table;
2011-05-20 15:36:27 +00:00
2014-02-03 20:58:15 +00:00
# Development notes:
# - added this line to /etc/httpd/conf/httpd.conf to hide the cgi-bin and .cgi extension in the uri:
# ScriptAlias /xcatws /var/www/cgi-bin/xcatws.cgi
# - also upgraded CGI to 3.52
# - If "Internal Server Error" is returned, look at /var/log/httpd/ssl_error_log
2014-02-23 09:13:15 +00:00
# - can run your cgi script from the cli: http://perldoc.perl.org/CGI.html#DEBUGGING
2014-02-03 20:58:15 +00:00
# This is how the parameters come in:
# GET: url parameters come $q->url_param. There is no put/post data.
# PUT: url parameters come $q->url_param. Put data comes in q->param(PUTDATA).
# POST: url parameters come $q->url_param. Post data comes in q->param(POSTDATA).
# DELETE: ??
# Notes from http://perldoc.perl.org/CGI.html:
# %params = $q->Vars; # same as $q->param() except put it in a hash
# @foo = split("\0",$params{'foo'});
# my $error = $q->cgi_error; #todo: check for errors that occurred while processing user input
# print $q->end_html; #todo: add the </body></html> tags
# $q->url_param() # gets url options, even when there is put/post data (unlike q->param)
2011-05-20 15:36:27 +00:00
2012-09-26 07:18:39 +00:00
my $VERSION = "2.8";
2011-05-20 15:36:27 +00:00
2012-02-16 02:42:44 +00:00
my $q = CGI->new;
2014-02-03 20:58:15 +00:00
#my $url = $q->url; # the 1st part of the url, https, hostname, port num, and /xcatws
my $pathInfo = $q->path_info; # the resource specification, i.e. everything in the url after xcatws
my $requestType = $q->request_method(); # GET, PUT, POST, PATCH, DELETE
my $userAgent = $q->user_agent(); # the client program: curl, etc.
2012-02-16 13:06:45 +00:00
my @path = split(/\//, $pathInfo);
2014-02-03 20:58:15 +00:00
shift(@path); # get rid of the initial /
2012-02-16 02:42:44 +00:00
my $resource = $path[0];
2014-02-03 20:58:15 +00:00
my $pageContent = ''; # global var containing the ouptut back to the rest client
2014-02-09 20:43:37 +00:00
my $request = {clienttype => 'ws'}; # global var that holds the request to send to xcatd
2011-05-20 15:36:27 +00:00
#error status codes
2012-02-16 02:42:44 +00:00
my $STATUS_BAD_REQUEST = "400 Bad Request";
my $STATUS_UNAUTH = "401 Unauthorized";
my $STATUS_FORBIDDEN = "403 Forbidden";
my $STATUS_NOT_FOUND = "404 Not Found";
my $STATUS_NOT_ALLOWED = "405 Method Not Allowed";
my $STATUS_NOT_ACCEPTABLE = "406 Not Acceptable";
my $STATUS_TIMEOUT = "408 Request Timeout";
my $STATUS_EXPECT_FAILED = "417 Expectation Failed";
my $STATUS_TEAPOT = "418 I'm a teapot";
2011-05-20 15:36:27 +00:00
my $STATUS_SERVICE_UNAVAILABLE = "503 Service Unavailable";
#good status codes
2012-02-16 02:42:44 +00:00
my $STATUS_OK = "200 OK";
2011-05-20 15:36:27 +00:00
my $STATUS_CREATED = "201 Created";
2014-02-03 20:58:15 +00:00
my $XCAT_PATH = '/opt/xcat/bin';
2012-02-13 08:42:47 +00:00
2014-02-27 00:34:16 +00:00
my $JSON; # global ptr to the json object. Its set by loadJSON()
if (isPut() || isPost()) { loadJSON(); } # need to do this early, so we can fetch the params
# the input parameters from both the url and put/post data will combined and then
# separated into the general params (not specific to the api call) and params specific to the call
# Note: some of the values of the params in the hash can be arrays
my ($generalparams, $paramhash) = fetchParameters();
# sometimes we need to know the params that are not specific to the resource or action
2012-02-13 08:42:47 +00:00
2014-02-27 00:34:16 +00:00
my $DEBUGGING = $generalparams->{debug}; # turn on or off the debugging output by setting debug=1 (or 2) in the url string
2014-02-03 20:58:15 +00:00
if ($DEBUGGING) {
2014-02-27 00:34:16 +00:00
addPageContent($q->p("DEBUG: generalparams:". Dumper($generalparams)));
addPageContent($q->p("DEBUG: paramhash:". Dumper($paramhash)));
2014-02-03 20:58:15 +00:00
addPageContent($q->p("DEBUG: q->request_method: $requestType\n"));
addPageContent($q->p("DEBUG: q->user_agent: $userAgent\n"));
addPageContent($q->p("DEBUG: pathInfo: $pathInfo\n"));
#addPageContent($q->p("DEBUG: path " . Dumper(@path) . "\n"));
#foreach (keys(%ENV)) { addPageContent($q->p("DEBUG: ENV{$_}: $ENV{$_}\n")); }
addPageContent($q->p("DEBUG: resource: $resource\n"));
2014-02-27 00:34:16 +00:00
#addPageContent($q->p("DEBUG: userName=".$paramhash->{userName}.", password=".$paramhash->{password}."\n"));
2014-02-03 20:58:15 +00:00
#addPageContent($q->p("DEBUG: http() values:\n" . http() . "\n"));
2014-02-27 00:34:16 +00:00
#if ($pdata) { addPageContent($q->p("DEBUG: pdata: $pdata\n")); }
2014-02-03 20:58:15 +00:00
addPageContent("\n");
2014-02-27 00:34:16 +00:00
if ($DEBUGGING == 3) {
2014-02-03 20:58:15 +00:00
sendResponseMsg($STATUS_OK); # this will also exit
2012-02-13 08:42:47 +00:00
}
2011-05-20 15:36:27 +00:00
}
2014-02-03 20:58:15 +00:00
# Process the format requested
2014-02-27 00:34:16 +00:00
my $format = $generalparams->{format};
2014-02-23 21:00:37 +00:00
if (!$format) { $format = 'json'; } # this is the default format
2014-02-27 00:34:16 +00:00
if ($format eq 'json') {
loadJSON(); # in case it was not loaded before
if ($generalparams->{pretty}) { $JSON->indent(1); }
}
2011-05-20 15:36:27 +00:00
2014-02-03 20:58:15 +00:00
# supported formats
2012-02-16 02:42:44 +00:00
my %formatters = (
'html' => \&wrapHtml,
'json' => \&wrapJson,
2014-02-03 20:58:15 +00:00
'xml' => \&wrapXml
);
2011-05-20 15:36:27 +00:00
2012-02-16 13:06:45 +00:00
2014-02-03 20:58:15 +00:00
if (!exists $formatters{$format}) {
2014-02-27 00:34:16 +00:00
error("The format '$format' is not supported",$STATUS_BAD_REQUEST);
2014-02-03 20:58:15 +00:00
}
2014-02-23 09:13:15 +00:00
# require XML dynamically and let them know if it is not installed
# we need XML all the time to send request to xcat, even if thats not the return format requested by the user
my $xmlinstalled = eval { require XML::Simple; };
unless ($xmlinstalled) {
2014-02-27 00:34:16 +00:00
error('The XML::Simple perl module is missing. Install perl-XML-Simple before using the xCAT REST web services API with this format."}',$STATUS_SERVICE_UNAVAILABLE);
2014-02-03 20:58:15 +00:00
}
2014-02-23 09:13:15 +00:00
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';
#debugandexit('here');
2011-05-20 15:36:27 +00:00
2011-06-14 18:58:31 +00:00
#resource handlers
2012-02-16 02:42:44 +00:00
my %resources = (
groups => \&groupsHandler,
images => \&imagesHandler,
logs => \&logsHandler,
monitors => \&monitorsHandler,
networks => \&networksHandler,
nodes => \&nodesHandler,
notifications => \¬ificationsHandler,
policies => \&policiesHandler,
site => \&siteHandler,
tables => \&tablesHandler,
accounts => \&accountsHandler,
objects => \&objectsHandler,
2012-02-27 15:44:59 +00:00
vms => \&vmsHandler,
2013-06-19 16:16:51 +00:00
debug => \&debugHandler,
hypervisor => \&hypervisorHandler,
2012-02-27 15:44:59 +00:00
version => \&versionHandler);
2011-05-20 15:36:27 +00:00
2011-06-14 18:58:31 +00:00
#if no resource was specified
2012-02-16 02:42:44 +00:00
if ($pathInfo =~ /^\/$/ || $pathInfo =~ /^$/) {
2012-02-13 08:42:47 +00:00
addPageContent($q->p("This is the root page for the xCAT Rest Web Service. Available resources are:"));
2012-02-16 02:42:44 +00:00
foreach (sort keys %resources) {
addPageContent($q->p($_));
2012-02-13 08:42:47 +00:00
}
2014-02-03 20:58:15 +00:00
sendResponseMsg($STATUS_OK); # this will also exit
}
#my @imageFields = (
# 'imagename', 'profile', 'imagetype', 'provmethod', 'osname', 'osvers',
# 'osdistro', 'osarch', 'synclists', 'comments', 'disable');
my $formatType; # global var for tablesHandler to pass the splitCommas option to wrapHtml
#general tests for valid requests and responses with HTTP codes here
2014-02-23 09:13:15 +00:00
if (!exists($resources{$resource})) {
2014-02-27 00:34:16 +00:00
error("Resource '$resource' does not exist",$STATUS_NOT_FOUND); # this will also exit
2014-02-03 20:58:15 +00:00
}
# Main function - process user request
handleRequest();
# end of main
2014-02-09 20:43:37 +00:00
# The flow of functions is:
# handleRequest() - do the whole api call
# *Handler() - the specific handler routine for this resource
# genRequest() - convert xcat request to xml to prepare it for sending to xcatd
# sendRequest() - send the request to xcatd and read the xml response and convert it to a perl structure
# wrapData() - convert the output to the format requested by the user
# wrap*() - the specific formatter the user requested
# sendResponseMsg() - form/send the output header, and then exit
2012-03-15 06:54:28 +00:00
2014-02-09 20:43:37 +00:00
# Call one of the handler routines to process the api call, and then return the output
2012-02-16 02:42:44 +00:00
sub handleRequest {
2014-02-27 00:34:16 +00:00
if ($generalparams->{userName} && $generalparams->{password}) {
$request->{becomeuser}->[0]->{username}->[0] = $generalparams->{userName};
$request->{becomeuser}->[0]->{password}->[0] = $generalparams->{password};
2012-02-16 02:42:44 +00:00
}
2014-02-09 20:43:37 +00:00
# this calls one of the handler routines that are stored in the resources hash
2014-02-27 00:34:16 +00:00
my $data = $resources{$resource}->();
wrapData($data);
2011-05-20 15:36:27 +00:00
}
2014-02-09 20:43:37 +00:00
# handle all the api calls for listing nodes, modifying nodes, querying nodes, running cmds on nodes, etc.
sub nodesHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
2014-02-09 20:43:37 +00:00
my $noderange;
my @envs;
2014-02-03 20:58:15 +00:00
2012-02-16 02:42:44 +00:00
if (defined $path[1]) {
2014-02-09 20:43:37 +00:00
$noderange = $path[1];
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
if (isGet()) {
2014-02-09 20:43:37 +00:00
my $subResource;
if (defined $path[2]) {
$subResource = $path[2];
unless (defined($noderange)) {
2014-02-23 09:13:15 +00:00
error("Invalid nodes and/or groups in noderange",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
$request->{noderange} = $noderange;
#use the corresponding command by the subresource name
if ($subResource eq "power") {
$request->{command} = 'rpower';
push @args, 'stat';
}
elsif ($subResource eq "energy") {
$request->{command} = 'renergy';
2014-02-27 00:34:16 +00:00
if (ref($paramhash->{field}) eq 'ARRAY') { push @args, @{$paramhash->{field}}; }
elsif (defined($paramhash->{field})) { push @args, $paramhash->{field}; }
else { error('field must be specified for node energy action', $STATUS_BAD_REQUEST); }
2012-02-16 02:42:44 +00:00
}
2014-02-09 20:43:37 +00:00
elsif ($subResource eq "status") {
$request->{command} = 'nodestat';
}
elsif ($subResource eq "inventory") {
$request->{command} = 'rinv';
2014-02-27 00:34:16 +00:00
if (ref($paramhash->{field}) eq 'ARRAY') { push @args, @{$paramhash->{field}}; }
elsif (defined($paramhash->{field})) { push @args, $paramhash->{field}; }
2014-02-09 20:43:37 +00:00
else {
push @args, 'all';
2012-02-16 02:42:44 +00:00
}
}
2014-02-09 20:43:37 +00:00
elsif ($subResource eq "vitals") {
$request->{command} = 'rvitals';
2014-02-27 00:34:16 +00:00
if (ref($paramhash->{field}) eq 'ARRAY') { push @args, @{$paramhash->{field}}; }
elsif (defined($paramhash->{field})) { push @args, $paramhash->{field}; }
2014-02-09 20:43:37 +00:00
else {
push @args, 'all';
}
}
elsif ($subResource eq "scan") {
$request->{command} = 'rscan';
2014-02-27 00:34:16 +00:00
if (ref($paramhash->{field}) eq 'ARRAY') { push @args, @{$paramhash->{field}}; }
elsif (defined($paramhash->{field})) { push @args, $paramhash->{field}; }
2012-02-16 02:42:44 +00:00
}
else {
2014-02-27 00:34:16 +00:00
error("Unspported operation on nodes resource.",$STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
}
}
2014-02-27 00:34:16 +00:00
else { # no path[2] was specified
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
# maybe field parameters were also specified
my $value = $paramhash->{field};
if (defined($value)) {
$request->{command} = 'lsdef';
# add the nodegroup into args
if (defined($noderange)) { push @args, $noderange; }
if (!ref($value) && $value eq 'ALL') { push @args, '-l'; }
else {
push @args, "-i";
if (ref($value) eq 'ARRAY') { push @args, join(',', @$value); }
else { push @args, $value; }
}
2012-02-16 02:42:44 +00:00
}
2014-02-27 00:34:16 +00:00
else {
# not asking for attribute values, use nodels, its faster
$request->{command} = 'nodels';
if (defined($noderange)) { $request->{noderange} = $noderange; }
2012-02-16 02:42:44 +00:00
}
}
}
2014-02-09 20:43:37 +00:00
elsif (isPut()) { # this could be change node attributes, power state, etc.
my $subResource;
unless (defined($noderange)) {
2014-02-27 00:34:16 +00:00
error("Invalid nodes or groups in noderange",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
$request->{noderange} = $noderange;
if (defined $path[2]) {
2014-02-27 00:34:16 +00:00
$subResource = $path[2]; # this is the action like power, energy
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
# For all of these put calls, move all operands to the argument list.
foreach my $k (keys %$paramhash) {
my $param = $paramhash->{$k};
if (ref($param) eq 'ARRAY') { push @args, @$param; }
else { push @args, $param; }
2014-02-09 20:43:37 +00:00
}
if ($subResource eq "power") {
$request->{command} = "rpower";
2014-02-27 00:34:16 +00:00
unless (scalar(keys(%$paramhash))) {
2014-02-23 09:13:15 +00:00
error("No power operands were supplied.",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
}
elsif ($subResource eq "energy") {
$request->{command} = "renergy";
}
elsif ($subResource eq "bootstat" or $subResource eq "bootstate") {
$request->{command} = "nodeset";
}
elsif ($subResource eq "bootseq") {
$request->{command} = "rbootseq";
}
elsif ($subResource eq "setboot") {
$request->{command} = "rsetboot";
}
elsif ($subResource eq "migrate") {
$request->{command} = "rmigrate";
}
2014-02-27 00:34:16 +00:00
else { error("unsupported node resource subResource $subResource.", $STATUS_BAD_REQUEST); }
2014-02-09 20:43:37 +00:00
}
2014-02-27 00:34:16 +00:00
else { # no path[2] set, setting node attributes in the db
2014-02-09 20:43:37 +00:00
$request->{command} = "chdef";
push @args, "-t", "node";
push @args, "-o", $request->{noderange};
2014-02-23 09:13:15 +00:00
# input is a json object with key/value pairs
2014-02-27 00:34:16 +00:00
while (my ($name, $val) = each (%$paramhash)) {
2014-02-09 20:43:37 +00:00
push @args, $name . "=" . $val;
}
}
}
2014-02-27 00:34:16 +00:00
elsif (isPost()) { # this can be dsh, dcp, or creating a node def
my $subResource;
2014-02-09 20:43:37 +00:00
unless (defined($noderange)) {
2014-02-27 00:34:16 +00:00
error("Invalid nodes or groups in noderange",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $path[2]) {
$subResource = $path[2]; # this is the action like dsh or dcp
$request->{noderange} = $noderange;
if ($subResource eq "dsh") {
$request->{command} = "xdsh";
# flags (options) for xdsh. Format of this array: <urlparam-name> <xdsh-cli-flag> <if-there-is-associated-value>
my @flags = (
[qw(devicetype --devicetype 1)],
[qw(execute -e 0)],
[qw(environment -E 1)],
[qw(fanout -f 1)],
[qw(nolocale -L 0)],
[qw(userid -l 1)],
[qw(monitor -m 0)],
[qw(options -o 1)],
[qw(showconfig -q 0)],
[qw(silent -Q 0)],
[qw(remoteshell -r 1)],
[qw(syntax -S 1)],
[qw(timeout -t 1)],
[qw(envlist -X 1)],
[qw(sshsetup -K 1)],
[qw(rootimg -i 1)],
);
pushFlags(\@args, \@flags);
if (defined($paramhash->{'command'})) {
push @args, $paramhash->{'command'};
}
if (defined($paramhash->{'remotepasswd'})) {
push @envs, 'DSH_REMOTE_PASSWORD=' . $paramhash->{'remotepasswd'};
push @envs, 'DSH_FROM_USERID=root';
push @envs, 'DSH_TO_USERID=root'; # i think this is overridden with the 'userid' param
}
}
elsif ($subResource eq "dcp") {
$request->{command} = "xdcp";
# flags (options) for xdcp. Format of this array: <urlparam-name> <xdsh-cli-flag> <if-there-is-associated-value>
my @flags = (
[qw(fanout -f 1)],
[qw(options -o 1)],
[qw(showconfig -q 0)],
[qw(remotecopy -r 1)],
[qw(timeout -t 1)],
[qw(rootimg -i 1)],
[qw(rsyncfile -F 1)],
[qw(preserve -p 0)],
[qw(pull -P 0)],
[qw(recursive -R 0)],
);
pushFlags(\@args, \@flags);
if (defined($paramhash->{'source'})) {
push @args, $paramhash->{'source'};
}
if (defined($paramhash->{'target'})) {
push @args, $paramhash->{'target'};
}
}
else { error("unsupported node resource subResource $subResource.", $STATUS_BAD_REQUEST); }
}
else { # create a node def
$request->{command} = 'mkdef';
push @args, "-t", "node";
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
unless (defined($noderange)) {
error("No nodename was supplied.",$STATUS_BAD_REQUEST);
}
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
push @args, "-o", $noderange;
if (scalar(keys(%$paramhash))) {
while (my ($name, $val) = each (%$paramhash)) {
push @args, $name . "=" . $val;
}
2014-02-09 20:43:37 +00:00
}
2014-02-27 00:34:16 +00:00
else { error('no input parameters given.', $STATUS_BAD_REQUEST); }
2014-02-09 20:43:37 +00:00
}
}
2014-02-27 00:34:16 +00:00
elsif (isDelete()) { # deleting a node def
2014-02-09 20:43:37 +00:00
$request->{command} = 'rmdef';
push @args, "-t", "node";
unless (defined($noderange)) {
2014-02-23 09:13:15 +00:00
error("No nodename was supplied.",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
push @args, "-o", $noderange;
}
2012-02-16 02:42:44 +00:00
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
2014-02-09 20:43:37 +00:00
if (@envs) {
push @{$request->{env}}, @envs;
}
2014-02-27 00:34:16 +00:00
#debug("request: " . Dumper($request));
2012-02-16 02:42:44 +00:00
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2011-05-20 15:36:27 +00:00
}
2014-02-09 20:43:37 +00:00
#get is done
#post and delete are done but not tested
#groupfiles4dsh is done but not tested
sub groupsHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
2014-02-09 20:43:37 +00:00
my $groupName;
2012-02-16 02:42:44 +00:00
2014-02-09 20:43:37 +00:00
my @groupFields = ('groupname', 'grouptype', 'members', 'wherevals', 'comments', 'disable');
#is the group name in the URI?
if (defined $path[1]) {
$groupName = $path[1];
}
#in the query string?
else {
$groupName = $q->param('groupName');
2012-02-16 02:42:44 +00:00
}
if (isGet()) {
2014-02-09 20:43:37 +00:00
if (defined $groupName) {
$request->{command} = 'tabget';
push @args, "groupname=$groupName";
if (defined $q->param('field')) {
foreach ($q->param('field')) {
push @args, "nodegroup.$_";
}
}
else {
foreach (@groupFields) {
push @args, "nodegroup.$_";
}
2013-06-19 16:16:51 +00:00
}
}
2014-02-09 20:43:37 +00:00
else {
$request->{command} = 'tabdump';
push @args, 'nodegroup';
}
2012-02-16 02:42:44 +00:00
}
2014-02-09 20:43:37 +00:00
#does it make sense to even have this?
elsif (isPost()) {
my $nodeRange = $q->param('nodeRange');
if ((defined $groupName) && (defined $nodeRange)) {
$request->{command} = 'mkdef';
push @args, '-t';
push @args, 'group';
push @args, '-o';
push @args, $groupName;
push @args, "members=$nodeRange";
}
else {
addPageContent("A node range and group name must be specified for creating a group");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
elsif (isPut()) {
#handle groupfiles4dsh -p /tmp/nodegroupfiles
if ($q->param('command') eq "4dsh") {
if ($q->param('path')) {
$request->{command} = 'groupfiles4dsh';
push @args, "p=$q->param('path')";
}
else {
addPageContent("The path must be specified for creating directories for dsh");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
if (defined $groupName && defined $q->param('fields')) {
$request->{command} = 'nodegrpch';
push @args, $groupName;
push @args, $q->param('field');
}
else {
addPageContent("The group and fields must be specified to update groups");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
}
elsif (isDelete()) {
if (defined $groupName) {
$request->{command} = 'rmdef';
push @args, '-d';
push @args, 'group';
push @args, '-o';
push @args, $groupName;
}
else {
addPageContent("The group must be specified to delete a group");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2014-02-09 20:43:37 +00:00
}
#get is done, nothing else
sub imagesHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2014-02-09 20:43:37 +00:00
my @args;
my $image;
my $subResource;
if (defined($path[1])) {
$image = $path[1];
}
if (isGet()) {
$request->{command} = 'lsdef';
push @args, '-t', 'osimage';
if (defined $image) {
push @args, '-o', $image;
}
if (defined($q->param('field'))) {
push @args, '-i';
push @args, join(',', $q->param('field'));
}
if (defined($q->param('criteria'))) {
foreach ($q->param('criteria')) {
push @args, '-w', "$_";
}
}
}
elsif (isPost()) {
my $operationname = $image;
my $entries;
my %entryhash;
2012-03-20 07:54:21 +00:00
2014-02-27 00:34:16 +00:00
# check input
unless (scalar(keys(%$paramhash))) {
error("no parameters specified", $STATUS_BAD_REQUEST);
2012-03-20 07:54:21 +00:00
}
#for image capture
if ($operationname eq 'capture') {
$request->{command} = 'imgcapture';
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'nodename'})) {
$request->{noderange} = $paramhash->{'nodename'};
2012-03-20 07:54:21 +00:00
}
else {
addPageContent('No node range.');
sendResponseMsg($STATUS_BAD_REQUEST);
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'profile'})) {
2012-03-20 07:54:21 +00:00
push @args, '-p';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'profile'};
2012-03-20 07:54:21 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'osimage'})) {
2012-03-20 07:54:21 +00:00
push @args, '-o';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'osimage'};
2012-03-20 07:54:21 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'bootinterface'})) {
2012-03-20 07:54:21 +00:00
push @args, '-i';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'bootinterface'};
2012-03-20 07:54:21 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'netdriver'})) {
2012-03-20 07:54:21 +00:00
push @args, '-n';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'netdriver'};
2012-03-20 07:54:21 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'device'})) {
2013-06-19 16:16:51 +00:00
push @args, '-d';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'device'};
2013-06-19 16:16:51 +00:00
}
}
elsif ($operationname eq 'export') {
$request->{command} = 'imgexport';
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'osimage'})) {
push @args, $paramhash->{'osimage'};
2013-06-19 16:16:51 +00:00
}
else {
addPageContent('No image specified');
sendResponseMsg($STATUS_BAD_REQUEST);
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'destination'})) {
push @args, $paramhash->{'destination'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'postscripts'})) {
2013-06-19 16:16:51 +00:00
push @args, '-p';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'postscripts'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'extra'})) {
2013-06-19 16:16:51 +00:00
push @args, '-e';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'extra'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'remotehost'})) {
2013-06-19 16:16:51 +00:00
push @args, '-R';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'remotehost'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'verbose'})) {
2013-06-19 16:16:51 +00:00
push @args, '-v';
}
}
elsif ($operationname eq 'import') {
$request->{command} = 'imgimport';
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'osimage'})) {
push @args, $paramhash->{'osimage'};
2013-06-19 16:16:51 +00:00
}
else {
addPageContent('No image specified');
sendResponseMsg($STATUS_BAD_REQUEST);
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'profile'})) {
2013-06-19 16:16:51 +00:00
push @args, '-f';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'profile'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'remotehost'})) {
2013-06-19 16:16:51 +00:00
push @args, '-R';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'remotehost'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'postscripts'})) {
2013-06-19 16:16:51 +00:00
push @args, '-p';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'postscripts'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{'verbose'})) {
2013-06-19 16:16:51 +00:00
push @args, '-v';
}
}
2011-05-20 15:36:27 +00:00
}
2012-03-19 09:31:33 +00:00
elsif (isPut()) {
#check the operation type
unless (defined $path[2]) {
addPageContent("The subResource $subResource does not exist");
sendResponseMsg($STATUS_BAD_REQUEST);
}
$subResource = $path[2];
2012-02-16 02:42:44 +00:00
2012-03-19 09:31:33 +00:00
#check the image name
unless (defined $image) {
addPageContent("The image name is required to clean an os image");
sendResponseMsg($STATUS_BAD_REQUEST);
}
if ($subResource eq 'check') {
$request->{command} = 'chkosimage';
if (defined($q->param('PUTDATA'))) {
2012-02-16 02:42:44 +00:00
push @args, '-c';
}
2012-03-19 09:31:33 +00:00
push @args, $image;
}
else {
addPageContent("The subResource $subResource does not exist");
sendResponseMsg($STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
}
}
elsif (isDelete()) {
if (defined $image) {
$request->{command} = 'rmimage';
if (defined $q->param('verbose')) {
push @args, '-v';
}
push @args, $image;
}
elsif (defined $q->param('os') && defined $q->param('arch') && defined $q->param('profile')) {
push @args, '-o';
push @args, $q->param('os');
push @args, '-a';
push @args, $q->param('arch');
push @args, '-p';
push @args, $q->param('profile');
}
else {
addPageContent(
"Either the image name or the os, architecture and profile must be specified to remove an image");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2011-05-20 15:36:27 +00:00
}
#complete
2012-02-16 02:42:44 +00:00
sub logsHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
my $logType;
if (defined $path[1]) {
$logType = $path[1];
}
#in the query string?
else {
$logType = $q->param('logType');
}
my $nodeRange = $q->param('nodeRange');
#no real output unless the log type is defined
if (!defined $logType) {
addPageContent("Current logs available are auditlog and eventlog");
2012-02-13 08:42:47 +00:00
sendResponseMsg($STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
exit(0);
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
if (isGet()) {
if ($logType eq "reventLog") {
if (defined $nodeRange) {
$request->{command} = 'reventlog';
push @args, $nodeRange;
if (defined $q->param('count')) {
push @args, $q->param('count');
}
}
else {
addPageContent("nodeRange must be specified to GET remote event logs");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
$request->{command} = 'tabdump';
push @args, $logType;
}
}
#this clears the log
elsif (isPut()) {
if ($logType eq "reventlog") {
if (defined $nodeRange) {
$request->{command} = 'reventlog';
push @args, $nodeRange;
push @args, 'clear';
}
else {
addPageContent("nodeRange must be specified to clean remote event logs");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
#should it return the removed entries?
if (defined $q->param('showRemoved')) {
push @args, '-V';
}
if (defined $q->param('count') || defined $q->param('percent') || defined $q->param('lastRecord')) {
#remove some of the entries
$request->{command} = 'tabprune';
#remove a certain number of records
if (defined $q->param('count')) {
push @args, ('-n', $q->param('count'));
}
#remove a percentage of the records
if (defined $q->param('percent')) {
push @args, ('-p', $q->param('percent'));
}
#remove all records before this record
if (defined $q->param('lastRecord')) {
push @args, ('-i', $q->param('lastRecord'));
}
}
else {
$request->{command} = 'tabprune';
#-a removes all
push @args, '-a';
}
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2014-02-09 20:43:37 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2014-02-09 20:43:37 +00:00
}
sub networksHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2014-02-09 20:43:37 +00:00
my @args;
my $netname = '';
if (isGet()) {
$request->{command} = 'lsdef';
push @{$request->{arg}}, '-t', 'network';
if (defined($path[1])) {
push @{$request->{arg}}, '-o', $path[1];
2012-02-16 02:42:44 +00:00
}
2014-02-09 20:43:37 +00:00
my @temparray = $q->param('field');
2012-02-16 02:42:44 +00:00
2014-02-09 20:43:37 +00:00
#add the field name to get
if (scalar(@temparray) > 0) {
push @{$request->{arg}}, '-i';
push @{$request->{arg}}, join(',', @temparray),;
}
}
elsif (isPut() || isPost()) {
my $entries;
my $iscommand = 0;
if (isPut()) {
$request->{command} = 'chdef';
if (defined($path[1])) {
if ($path[1] eq "makehosts" || $path[1] eq "makedns") {
# Issue makehost/makedns directly
$request->{command} = $path[1];
$iscommand = 1;
}
}
}
else {
$request->{command} = 'mkdef';
}
if (!$iscommand) {
if (defined $path[1]) {
$netname = $path[1];
}
if ($netname eq '') {
addPageContent('A network name must be specified.');
sendResponseMsg($STATUS_BAD_REQUEST);
}
push @{$request->{arg}}, '-t', 'network', '-o', $netname;
2014-02-27 00:34:16 +00:00
if (!scalar(keys(%$paramhash))) {
error("No Field and Value map was supplied.",$STATUS_BAD_REQUEST);
2014-02-09 20:43:37 +00:00
}
2012-02-22 02:24:16 +00:00
2014-02-27 00:34:16 +00:00
foreach my $k (keys(%$paramhash)) {
push @{$request->{arg}}, "$k=" . $paramhash->{$k};
2012-02-16 02:42:44 +00:00
}
}
}
elsif (isDelete()) {
2012-02-22 02:24:16 +00:00
$request->{command} = 'rmdef';
2014-02-09 20:43:37 +00:00
if (defined $path[1]) {
$netname = $path[1];
}
if ($netname eq '') {
2014-02-27 00:34:16 +00:00
error('A network name must be specified.',$STATUS_BAD_REQUEST);
2012-02-22 02:24:16 +00:00
}
2014-02-09 20:43:37 +00:00
push @{$request->{arg}}, '-t', 'network', '-o', $netname;
2012-02-16 02:42:44 +00:00
}
else {
unsupportedRequestType();
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
$responses = sendRequest(genRequest());
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2011-05-20 15:36:27 +00:00
}
#complete, unless there is some way to alter existing notifications
2012-02-16 02:42:44 +00:00
sub notificationsHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
2014-02-03 20:58:15 +00:00
my @notificationFields = ('filename', 'tables', 'tableops', 'comments', 'disable');
2012-02-16 02:42:44 +00:00
#does not support using the notification fileName in the URI
if (isGet()) {
if (defined $q->param('fileName')) {
$request->{command} = 'gettab';
push @args, "filename" . $q->param('fileName');
#if they specified the fields, just get those
if (defined $q->param('field')) {
foreach ($q->param('field')) {
push @args, $_;
}
}
#else show all of the fields
else {
foreach (@notificationFields) {
push @args, "notification.$_";
}
}
}
else {
$request->{command} = 'tabdump';
push @args, "notification";
}
}
elsif (isPost()) {
$request->{command} = 'regnotif';
if (!defined $q->param('fileName') || !defined $q->param('table') || !defined $q->param('operation')) {
addPageContent("fileName, table and operation must be specified for a POST on /notifications");
sendResponseMsg($STATUS_BAD_REQUEST);
}
else {
push @args, $q->param('fileName');
my $tables;
foreach ($q->param('table')) {
$tables .= "$_,";
}
2011-05-20 15:36:27 +00:00
2012-02-16 02:42:44 +00:00
#get rid of the extra comma
chop($tables);
push @args, $tables;
push @args, '-o';
my $operations;
foreach ($q->param('operation')) {
$operations .= "$_,";
}
2011-05-20 15:36:27 +00:00
2012-02-16 02:42:44 +00:00
#get rid of the extra comma
chop($operations);
push @args, $q->param('operation');
}
}
elsif (isDelete()) {
$request->{command} = 'unregnotif';
if (defined $q->param('fileName')) {
push @args, $q->param('fileName');
}
else {
addPageContent("fileName must be specified for a DELETE on /notifications");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
addPageContent("request is " . Dumper($request));
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2011-05-20 15:36:27 +00:00
}
#complete
2012-02-16 02:42:44 +00:00
sub policiesHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
my $priority;
2014-02-03 20:58:15 +00:00
my @policyFields =
('priority', 'name', 'host', 'commands', 'noderange', 'parameters', 'time', 'rule', 'comments', 'disable');
2012-02-16 02:42:44 +00:00
#does it specify the prioirty in the URI?
if (defined $path[1]) {
$priority = $path[1];
}
#in the query string?
elsif (defined $q->param('priority')) {
$priority = $q->param('priority');
}
if (isGet()) {
if (defined $priority) {
$request->{command} = 'gettab';
push @args, "priority=$priority";
my @fields = $q->param('field');
#if they specified fields to retrieve
if (@fields) {
push @args, @fields;
}
#give them everything if nothing is specified
else {
foreach (@policyFields) {
push @args, "policy.$_";
}
}
}
else {
$request->{command} = 'tabdump';
push @args, 'policy';
}
}
elsif (isPost()) {
if (defined $priority) {
$request->{command} = 'tabch';
push @args, "priority=$priority";
for ($q->param) {
if ($_ ne /priority/) {
push @args, "policy.$_=" . $q->param($_);
}
}
}
#some response about the priority being required
else {
addPageContent("The priority must be specified when creating a policy");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
elsif (isDelete()) {
#just allowing a delete by priority at the moment, could expand this to anything
if (defined $priority) {
$request->{command} = 'tabch';
push @args, '-d';
push @args, "priority=$priority";
push @args, "policy";
}
}
elsif (isPut() || isPatch()) {
if (defined $priority) {
$request->{command} = 'tabch';
push @args, "priority=$priority";
for ($q->param) {
if ($_ ne /priority/) {
push @args, "policy.$_=" . $q->param($_);
}
}
}
#some response about the priority being required
else {
addPageContent("The priority must be specified when updating a policy");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
addPageContent("request is " . Dumper($request));
2011-05-20 15:36:27 +00:00
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
return $responses;
2012-02-16 02:42:44 +00:00
}
#complete
sub siteHandler {
my @data;
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
if (isGet()) {
$request->{command} = 'lsdef';
push @{$request->{arg}}, '-t', 'site', '-o', 'clustersite';
2012-02-16 13:06:45 +00:00
my @temparray = $q->param('field');
#add the field name to get
if (scalar(@temparray) > 0) {
push @{$request->{arg}}, '-i';
2012-02-22 02:24:16 +00:00
push @{$request->{arg}}, join(',', @temparray);
2012-02-16 13:06:45 +00:00
}
2012-02-16 02:42:44 +00:00
}
2012-02-16 13:06:45 +00:00
elsif (isPut()) {
$request->{command} = 'chdef';
push @{$request->{arg}}, '-t', 'site', '-o', 'clustersite';
2014-02-27 00:34:16 +00:00
if (scalar(keys(%$paramhash))) {
foreach my $k (keys(%$paramhash)) {
push @{$request->{arg}}, "$k=".$paramhash->{$k};
2012-08-06 21:04:24 +00:00
}
}
2014-02-27 00:34:16 +00:00
else {
error("No Field and Value map was supplied.",$STATUS_BAD_REQUEST);
}
2012-02-16 02:42:44 +00:00
}
else {
unsupportedRequestType();
}
2012-02-16 13:06:45 +00:00
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2011-05-20 15:36:27 +00:00
}
#provide direct table access
#complete and tested on the site table
#use of the actual DELETE doesn't seem to fit here, since a resource would not be deleted
#using PUT or PATCH instead, though it doesn't feel all that correct either
2014-02-27 00:34:16 +00:00
#todo: this should use the xcatd xml api that lissa implemented for pcm
2012-02-16 02:42:44 +00:00
sub tablesHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my $table;
my @args;
#is the table name specified in the URI?
if (defined $path[1]) {
$table = $path[1];
}
#handle all gets
if (isGet()) {
#table was specified
if (defined $table) {
2014-02-27 00:34:16 +00:00
#todo: the input format needs to change
if (defined($paramhash->{col})) {
2012-03-20 09:16:06 +00:00
$request->{command} = 'gettab';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{col} . '=' . $paramhash->{value};
my @temparray = $paramhash->{attribute};
2012-03-20 09:16:06 +00:00
foreach (@temparray) {
push @args, $table . '.' . $_;
}
2012-02-16 02:42:44 +00:00
}
2012-03-20 09:16:06 +00:00
else {
$request->{command} = 'tabdump';
push @args, $table;
2014-02-27 00:34:16 +00:00
if (!defined($paramhash->{desc})) {
2012-03-20 09:16:06 +00:00
$formatType = 'splitCommas';
}
}
}
else {
$request->{command} = 'tabdump';
2012-02-16 02:42:44 +00:00
}
}
elsif (isPut() || isPatch()) {
2014-02-27 00:34:16 +00:00
my $condition = $paramhash->{condition};
2012-08-30 15:01:58 +00:00
if (!defined $condition) {
2014-02-27 00:34:16 +00:00
#todo: the input format needs to change
if (scalar(keys(%$paramhash)) < 1) {
error("No set attribute was supplied.",$STATUS_BAD_REQUEST);
2013-06-19 16:16:51 +00:00
}
2012-08-30 15:01:58 +00:00
}
2012-02-16 02:42:44 +00:00
if (!defined $table || !defined $condition) {
2014-02-27 00:34:16 +00:00
if (scalar(keys(%$paramhash)) < 1) {
error("The table and condition must be specified when adding, changing or deleting an entry",$STATUS_BAD_REQUEST);
2013-06-19 16:16:51 +00:00
}
2012-02-16 02:42:44 +00:00
}
$request->{command} = 'tabch';
2012-08-30 15:01:58 +00:00
2014-02-27 00:34:16 +00:00
if (defined($paramhash->{delete})) {
2012-02-16 02:42:44 +00:00
push @args, '-d';
push @args, $condition;
push @args, $table;
}
2013-06-19 16:16:51 +00:00
elsif (defined $condition) {
2012-02-16 02:42:44 +00:00
push @args, $condition;
2014-02-27 00:34:16 +00:00
if ($paramhash->{value}) {
for ($paramhash->{value}) {
2013-01-11 21:21:05 +00:00
push @args, "$table.$_";
}
}
2012-02-16 02:42:44 +00:00
}
2013-06-19 16:16:51 +00:00
else {
2014-02-27 00:34:16 +00:00
foreach my $k (keys(%$paramhash)) {
push @args, ($k, $paramhash->{$k});
2013-06-19 16:16:51 +00:00
}
}
2012-02-16 02:42:44 +00:00
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2011-05-20 15:36:27 +00:00
}
#done aside from being able to change cluster users, which xcat can't do yet
2012-02-16 02:42:44 +00:00
sub accountsHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
my $key = $q->param('key');
2014-02-03 20:58:15 +00:00
my @accountFields = ('key', 'username', 'password', 'cryptmethod', 'comments', 'disable');
2012-02-16 02:42:44 +00:00
if (isGet()) {
#passwd table
if (!defined $q->param('clusterUser')) {
if (defined $key) {
$request->{command} = 'tabget';
push @args, "key=$key";
if (defined $q->param('field')) {
foreach ($q->param('field')) {
push @args, "passwd.$_";
}
}
else {
foreach (@accountFields) {
push @args, "passwd.$_";
}
}
}
else {
$request->{command} = 'tabdump';
push @args, 'passwd';
}
}
#cluster user list
else {
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruserlist';
push @args, '-p';
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
elsif (isPost()) {
if (!defined $q->param('clusterUser')) {
if (defined $key) {
$request->{command} = 'tabch';
push @args, "key=$key";
for ($q->param) {
if ($_ !~ /key/) {
push @args, "passwd.$_=" . $q->param($_);
}
}
}
else {
addPageContent("The key must be specified when creating a non-cluster user");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
#active directory user
else {
2014-02-27 00:34:16 +00:00
#todo: should this really be using the same userName that is used to run the api call?
if (defined($generalparams->{userName}) && defined($paramhash->{userPass})) {
2012-02-16 02:42:44 +00:00
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruseradd';
2014-02-27 00:34:16 +00:00
push @args, $generalparams->{userName};
2012-02-16 02:42:44 +00:00
push @{$request->{arg}}, @args;
2014-02-27 00:34:16 +00:00
$request->{environment} = {XCAT_USERPASS => $paramhash->{userPass}};
2012-02-16 02:42:44 +00:00
}
else {
addPageContent("The key must be specified when creating a cluster user");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
elsif (isDelete()) {
if (!defined $q->param('clusterUser')) {
#just allowing a delete by key at the moment, could expand this to anything
if (defined $key) {
$request->{command} = 'tabch';
push @args, '-d';
push @args, "key=$key";
push @args, "passwd";
}
else {
addPageContent("The key must be specified when deleting a non-cluster user");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
else {
2014-02-27 00:34:16 +00:00
if (defined($generalparams->{userName})) {
2012-02-16 02:42:44 +00:00
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruserdel';
2014-02-27 00:34:16 +00:00
push @args, $generalparams->{userName};
2012-02-16 02:42:44 +00:00
}
else {
addPageContent("The userName must be specified when deleting a cluster user");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
elsif (isPut() || isPatch()) {
if (!defined $q->param('clusterUser')) {
if (defined $key) {
$request->{command} = 'tabch';
push @args, "key=$key";
for ($q->param) {
if ($_ !~ /key/) {
push @args, "passwd.$_=" . $q->param($_);
}
}
}
else {
addPageContent("The key must be specified when updating a non-cluster user");
sendResponseMsg($STATUS_BAD_REQUEST);
}
}
#TODO: there isn't currently a way to update cluster users
else {
2011-05-20 15:36:27 +00:00
2012-02-16 02:42:44 +00:00
}
}
else {
unsupportedRequestType();
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
sub objectsHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2012-02-16 02:42:44 +00:00
my @args;
my @objectTypeList = (
"auditlog", "boottarget", "eventlog", "firmware", "group", "monitoring",
"network", "node", "notification", "osimage", "policy", "route",
"site");
#my %objectTypes;
#foreach my $item (@objectTypeList) { $objectTypes{$item} = 1 }
my @objectTypes;
my @objects;
if (defined $path[1]) {
$objectTypes[0] = $path[1];
if (defined $path[2]) {
$objects[0] = $path[2];
}
}
if (defined $q->param('objectType')) {
@objectTypes = $q->param('objectType');
}
if (defined $q->param('object')) {
@objects = $q->param('object');
}
if ($q->param('verbose')) {
push @args, '-v';
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
if (isGet()) {
if (defined $objectTypes[0]) {
$request->{command} = 'lsdef';
push @args, '-l';
push @args, '-t';
push @args, join(',', @objectTypes);
if (defined $objects[0]) {
push @args, '-o';
push @args, join(',', @objects);
}
if ($q->param('info')) {
push @args, '-h';
}
}
else {
if ($q->param('info')) {
push @args, '-h';
}
else {
#couldn't find a way to do this through xcatd, so shortcutting the request
my %resp = (data => \@objectTypeList);
return (\%resp);
}
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
elsif (isPut()) {
$request->{command} = 'chdef';
if ($q->param('verbose')) {
push @args, '-v';
}
if (!defined $q->param('objectType')) {
addPageContent("The object must be specified.");
sendResponseMsg($STATUS_BAD_REQUEST);
}
else {
push @args, '-t';
push @args, join(',', $q->param('objectType'));
}
if ($q->param('objectName')) {
push @args, join(',', $q->param('objectName'));
}
if ($q->param('dynamic')) {
push @args, '-d';
}
if ($q->param('minus')) {
push @args, '-m';
}
if ($q->param('plus')) {
push @args, '-p';
}
if (defined $q->param('field')) {
foreach ($q->param('field')) {
#if it has ==, !=. =~ or !~ operators in the field, use the -w option
if (/==|!=|=~|!~/) {
push @args, '-w';
}
push @args, $_;
}
}
if ($q->param('nodeRange')) {
push @args, $q->param('nodeRange');
}
2011-05-20 15:36:27 +00:00
2012-02-16 02:42:44 +00:00
}
elsif (isPost()) {
$request->{command} = 'mkdef';
if ($q->param('verbose')) {
push @args, '-v';
}
if (!defined $q->param('objectType')) {
addPageContent("The object must be specified.");
sendResponseMsg($STATUS_BAD_REQUEST);
}
else {
push @args, '-t';
push @args, join(',', $q->param('objectType'));
}
if ($q->param('objectName')) {
push @args, join(',', $q->param('objectName'));
}
if ($q->param('dynamic')) {
push @args, '-d';
}
if ($q->param('force')) {
push @args, '-f';
}
if (defined $q->param('field')) {
foreach ($q->param('field')) {
#if it has ==, !=. =~ or !~ operators in the field, use the -w option
if (/==|!=|=~|!~/) {
push @args, '-w';
}
push @args, $_;
}
}
if ($q->param('nodeRange')) {
push @args, $q->param('nodeRange');
}
}
elsif (isDelete()) {
$request->{command} = 'rmdef';
if (defined $q->param('info')) {
push @args, '-h';
}
elsif (defined $q->param('all')) {
push @args, '-a';
}
elsif (defined $objectTypes[0]) {
push @args, '-t';
push @args, join(',', @objectTypes);
if (defined $objects[0]) {
push @args, '-o';
push @args, join(',', @objects);
}
}
else {
addPageContent(
"Either the help info must be requested or the object must be specified or the flag that indicates everything should be removed."
);
sendResponseMsg($STATUS_BAD_REQUEST);
}
if (defined $q->param('nodeRange')) {
push @args, $q->param('nodeRange');
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2011-05-20 15:36:27 +00:00
}
#complete i think, tho chvm could handle args better
2012-02-16 02:42:44 +00:00
sub vmsHandler {
my @args;
2012-03-13 08:34:30 +00:00
my $noderange;
2013-06-19 16:16:51 +00:00
my $subResource;
2012-03-13 08:34:30 +00:00
if (defined $path[1]) {
$noderange = $path[1];
$request->{noderange} = $noderange;
2012-02-16 02:42:44 +00:00
}
2012-03-13 08:34:30 +00:00
else {
addPageContent("Invalid nodes and/or groups in noderange");
sendResponseMsg($STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
}
if (isGet()) {
$request->{command} = 'lsvm';
if (defined $q->param('all')) {
push @args, '-a';
}
2013-06-19 16:16:51 +00:00
# for z/VM
if (defined $q->param('networknames')) {
push @args, '--getnetworknames';
}
if (defined $q->param('network')) {
push @args, '--getnetwork';
push @args, $q->param('getnetwork');
}
if (defined $q->param('diskpoolnames')) {
push @args, '--diskpoolnames';
}
if (defined $q->param('diskpool')) {
push @args, '--diskpool';
push @args, $q->param('diskpool');
}
2012-02-16 02:42:44 +00:00
}
elsif (isPost()) {
2012-03-13 08:34:30 +00:00
my $position;
$request->{command} = 'mkvm';
2014-02-27 00:34:16 +00:00
unless (scalar(keys(%$paramhash))) {
error("no parameters specified", $STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
}
2012-03-13 08:34:30 +00:00
#for system p
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'cec'}) {
2012-03-13 08:34:30 +00:00
push @args, '-c';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'cec'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'startId'}) {
2012-03-13 08:34:30 +00:00
push @args, '-i';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'startId'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'source'}) {
2012-03-13 08:34:30 +00:00
push @args, '-l';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'source'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'profile'}) {
2012-03-13 08:34:30 +00:00
push @args, '-p';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'profile'};
2012-03-13 08:34:30 +00:00
}
2012-02-16 02:42:44 +00:00
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'full'}) {
2012-03-13 08:34:30 +00:00
push @args, '--full';
}
#for KVM & Vmware
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'master'}) {
2012-03-13 08:34:30 +00:00
push @args, '-m';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'master'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'disksize'}) {
2012-03-13 08:34:30 +00:00
push @args, '-s';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'disksize'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'memory'}) {
2012-03-13 08:34:30 +00:00
push @args, '--mem';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'memory'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'cpu'}) {
2012-03-13 08:34:30 +00:00
push @args, '--cpus';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'cpu'};
2012-03-13 08:34:30 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'force'}) {
2012-03-13 08:34:30 +00:00
push @args, '-f';
2012-02-16 02:42:44 +00:00
}
2013-06-19 16:16:51 +00:00
# for z/VM
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'userid'}) {
2013-06-19 16:16:51 +00:00
push @args, '--userid';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'userid'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'size'}) {
2013-06-19 16:16:51 +00:00
push @args, '--size';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'size'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'password'}) {
2013-06-19 16:16:51 +00:00
push @args, '--password';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'password'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'privilege'}) {
2013-06-19 16:16:51 +00:00
push @args, '--privilege';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'privilege'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'diskpool'}) {
2013-06-19 16:16:51 +00:00
push @args, '--diskpool';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'diskpool'};
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{'diskvdev'}) {
2013-06-19 16:16:51 +00:00
push @args, '--diskVdev';
2014-02-27 00:34:16 +00:00
push @args, $paramhash->{'diskvdev'};
2013-06-19 16:16:51 +00:00
}
2012-02-16 02:42:44 +00:00
}
2012-03-13 08:34:30 +00:00
elsif (isPut()) {
2012-02-16 02:42:44 +00:00
$request->{command} = 'chvm';
2014-02-27 00:34:16 +00:00
if (scalar(keys(%$paramhash)) < 1) {
error("No Field and Value map was supplied.", $STATUS_BAD_REQUEST);
2012-02-16 02:42:44 +00:00
}
2014-02-27 00:34:16 +00:00
foreach my $k (%$paramhash) {
push @args, ($k, $paramhash->{$k});
2012-03-13 08:34:30 +00:00
}
2012-02-16 02:42:44 +00:00
}
elsif (isDelete()) {
$request->{command} = 'rmvm';
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{retain}) {
2012-03-13 08:34:30 +00:00
push @args, '-r';
2012-02-16 02:42:44 +00:00
}
2014-02-27 00:34:16 +00:00
if (defined $paramhash->{service}) {
2012-03-13 08:34:30 +00:00
push @args, '--service';
2012-02-16 02:42:44 +00:00
}
}
else {
unsupportedRequestType();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
my $responses = sendRequest($req);
return $responses;
2011-05-20 15:36:27 +00:00
}
2012-03-13 08:34:30 +00:00
sub versionHandler {
2012-02-27 15:44:59 +00:00
addPageContent($q->p("API version is $VERSION"));
sendResponseMsg($STATUS_OK);
exit(0);
}
2013-06-19 16:16:51 +00:00
sub hypervisorHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2013-06-19 16:16:51 +00:00
my @args;
if (isPut()) {
if (defined $path[1]) {
$request->{noderange} = $path[1];
}
else {
2014-02-27 00:34:16 +00:00
error("Invalid nodes and/or groups in node in noderange",$STATUS_BAD_REQUEST);
2013-06-19 16:16:51 +00:00
}
if (defined $path[2]) {
$request->{command} = $path[2];
}
else {
$request->{command} = 'chhypervisor';
}
2014-02-27 00:34:16 +00:00
if (scalar(keys(%$paramhash)) < 1) {
error("No set attribute was supplied.",$STATUS_BAD_REQUEST);
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
foreach my $k (keys(%$paramhash)) {
push @args, ($k, $paramhash->{$k});
2013-06-19 16:16:51 +00:00
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2013-06-19 16:16:51 +00:00
}
}
2014-02-09 20:43:37 +00:00
#for operations that take a 'long' time to finish, this will provide the interface to check their status
#todo: this is not supported in xcatd yet, so not sure what to do about this one
sub jobsHandler {
}
2013-06-19 16:16:51 +00:00
sub debugHandler {
2014-02-27 00:34:16 +00:00
my $responses;
2013-06-19 16:16:51 +00:00
my @args;
if (isPut()) {
$request->{command} = 'xcatclientnnr xcatdebug';
2014-02-27 00:34:16 +00:00
if (scalar(keys(%$paramhash)) < 1) {
error("No set attribute was supplied.",$STATUS_BAD_REQUEST);
2013-06-19 16:16:51 +00:00
}
2014-02-27 00:34:16 +00:00
foreach (@{$paramhash->{xcatdebug}}) {
2013-06-19 16:16:51 +00:00
push @{$request->{arg}}, $_;
}
push @{$request->{arg}}, @args;
my $req = genRequest();
2014-02-27 00:34:16 +00:00
$responses = sendRequest($req);
return $responses;
2013-06-19 16:16:51 +00:00
}
}
2014-02-09 20:43:37 +00:00
# Format the output data the way the user requested. All data wrapping and writing is funneled through here.
# This will call one of the other wrap*() functions.
2012-02-16 02:42:44 +00:00
sub wrapData {
my $data = shift;
2012-02-13 08:42:47 +00:00
my $errorInformation = '';
2012-02-16 02:42:44 +00:00
2012-02-13 08:42:47 +00:00
#trim the serverdone message off
2012-02-16 02:42:44 +00:00
if (exists $data->[0]->{serverdone} && exists $data->[0]->{error}) {
$errorInformation = $data->[0]->{error}->[0];
2014-02-23 09:13:15 +00:00
addPageContent($q->p($errorInformation)); #todo: put this in the requested format?
2012-02-16 02:42:44 +00:00
if (($errorInformation =~ /Permission denied/) || ($errorInformation =~ /Authentication failure/)) {
sendResponseMsg($STATUS_UNAUTH);
}
else {
sendResponseMsg($STATUS_FORBIDDEN);
}
2012-02-13 08:42:47 +00:00
}
2012-02-16 02:42:44 +00:00
else {
2014-02-23 09:13:15 +00:00
pop @{$data}; #todo: are we sure this is the serverdone entry?
2012-02-13 08:42:47 +00:00
}
2014-02-09 20:43:37 +00:00
# Call the appropriate formatting function stored in the formatters hash
2012-02-16 02:42:44 +00:00
if (exists $formatters{$format}) {
$formatters{$format}->($data);
2012-02-13 08:42:47 +00:00
}
2014-02-23 09:13:15 +00:00
# all output has been added into the global varibale pageContent, now complete the response to the user
2012-08-06 21:04:24 +00:00
if (exists $data->[0]->{info} && $data->[0]->{info}->[0] =~ /Could not find an object/) {
sendResponseMsg($STATUS_NOT_FOUND);
}
elsif (isPost()) {
2012-02-13 08:42:47 +00:00
sendResponseMsg($STATUS_CREATED);
}
2012-02-16 02:42:44 +00:00
else {
2012-02-13 08:42:47 +00:00
sendResponseMsg($STATUS_OK);
}
2011-05-20 15:36:27 +00:00
}
2014-02-23 09:13:15 +00:00
# Structure the response perl data structure into well-formed json. Since the structure of the
# xml output that comes from xcatd is inconsistent and not very structured, we have a lot of work to do.
2012-02-16 02:42:44 +00:00
sub wrapJson {
2014-02-23 09:13:15 +00:00
# this is an array of responses from xcatd. Often all the output comes back in 1 response, but not always.
2012-06-25 14:03:30 +00:00
my $data = shift;
2014-02-23 09:13:15 +00:00
2014-02-27 00:34:16 +00:00
# put, delete, and patch usually just give a short msg, if anything
if (isPut() || isDelete() || isPatch()) {
2014-02-23 09:13:15 +00:00
addPageContent($JSON->encode($data));
return;
}
2014-02-27 00:34:16 +00:00
if ($resource eq 'nodes') { wrapJsonNodes($data); }
else { addPageContent($JSON->encode($data)); } #todo: implement wrappers for each of the resources
}
# structure the json output for node resource api calls
sub wrapJsonNodes {
# this is an array of responses from xcatd. Often all the output comes back in 1 response, but not always.
my $data = shift;
2014-02-23 09:13:15 +00:00
# Divide the processing into several groups of requests, according to how they return the output
2014-02-27 00:34:16 +00:00
# At this point, these are all gets and posts. The others were taken care of wrapJson()
2012-02-16 02:42:44 +00:00
my $json;
2014-02-27 00:34:16 +00:00
if (isGet()) {
if (!defined $path[2] && !defined($paramhash->{field})) { # querying node list
# The data structure is: array of hashes that have a single key 'node'. The value for that key
# is an array of hashes with a single key 'name'. The value for that key
# is a 1-element array that contains the node name.
2014-02-23 21:00:37 +00:00
# Create a json array of node name strings.
$json = [];
foreach my $d (@$data) {
2014-02-27 00:34:16 +00:00
my $ar = $d->{node};
foreach my $a (@$ar) {
my $nodename = $a->{name}->[0];
2014-02-23 21:00:37 +00:00
if (!defined($nodename)) { error('improperly formatted lsdef output from xcatd', $STATUS_TEAPOT); }
push @$json, $nodename;
}
}
addPageContent($JSON->encode($json));
}
2014-02-27 00:34:16 +00:00
elsif (!defined $path[2] && defined($paramhash->{field})) { # querying node attributes
2014-02-23 09:13:15 +00:00
# The data structure is: array of hashes that have a single key 'info'. The value for that key
# is an array of lines of lsdef output (all nodes in the same array).
# Create a json array of node objects. Each node object contains the attributes/values (including
# the nodename) of that object.
$json = [];
foreach my $d (@$data) {
my $jsonnode;
my $lines = $d->{info};
foreach my $l (@$lines) {
if ($l =~ /^Object name: /) { # start new node
if (defined($jsonnode)) { push @$json, $jsonnode; } # push previous object onto array
my ($nodename) = $l =~ /^Object name:\s+(\S+)/;
$jsonnode = { nodename => $nodename };
}
else { # just an attribute of the current node
if (!defined($jsonnode)) { error('improperly formatted lsdef output from xcatd', $STATUS_TEAPOT); }
my ($attr, $val) = $l =~ /^\s*(\S+)=(.*)$/;
if (!defined($attr)) { error('improperly formatted lsdef output from xcatd', $STATUS_TEAPOT); }
$jsonnode->{$attr} = $val;
}
}
if (defined($jsonnode)) { push @$json, $jsonnode; $jsonnode=undef; } # push last object onto array
}
addPageContent($JSON->encode($json));
}
2014-02-27 00:34:16 +00:00
elsif (grep(/^$path[2]$/, qw(power inventory vitals energy status))) { # querying other node info
2014-02-23 09:13:15 +00:00
# The data structure is: array of hashes that have a single key 'node'. The value for that key
# is a 1-element array that has a hash with keys 'name' and 'data'. The 'name' value is a 1-element
# array that has the nodename. The 'data' value is a 1-element array of a hash that has keys 'desc'
2014-02-27 00:34:16 +00:00
# and 'content' (sometimes desc is ommited), or in the case of status it has the status directly in the array.
2014-02-23 09:13:15 +00:00
# Create a json array of node objects. Each node object contains the attributes/values (including
# the nodename) of that object.
$json = {}; # its keys are nodenames
foreach my $d (@$data) {
# each element is a complex structure that contains 1 attr and value for a node
my $node = $d->{node}->[0];
my $nodename = $node->{name}->[0];
my $nodedata = $node->{data}->[0];
2014-02-27 00:34:16 +00:00
if ($path[2] eq 'status') {
$json->{$nodename} = $nodedata;
}
else {
my $contents = $nodedata->{contents}->[0];
my $desc = 'power'; # rpower doesn't output a desc tag
if (defined($nodedata->{desc})) { $desc = $nodedata->{desc}->[0]; }
# add this desc and content into this node's hash
$json->{$nodename}->{$desc} = $contents;
}
2014-02-23 09:13:15 +00:00
}
2014-02-27 00:34:16 +00:00
if ($path[2] eq 'status') { addPageContent($JSON->encode($json)); }
else {
# convert this hash of hashes into an array of hashes
my @jsonarray;
foreach my $n (sort(keys(%$json))) {
$json->{$n}->{nodename} = $n; # add the key (nodename) inside of the node's hash
push @jsonarray, $json->{$n};
}
addPageContent($JSON->encode(\@jsonarray));
2014-02-23 09:13:15 +00:00
}
}
else { # querying a node subresource (rpower, rvitals, rinv, etc.)
addPageContent($JSON->encode($data));
} # end else path[2] defined
2014-02-27 00:34:16 +00:00
}
elsif (isPost()) { # dsh or dcp
if ($path[2] eq 'dsh') {
# The data structure is: array of hashes with a single key, either 'data' or 'errorcode'. The value
# of 'errorcode' is a 1-element array containing the error code. The value of 'data' is an array of
# output lines prefixed by the node name. Some of the lines can be null.
# Create a hash with 2 keys: 'errorcode' and 'nodes'. The 'nodes' value is a hash of nodenames, each
# value is an array of the output for that node.
$json = {}; # its keys are nodenames
foreach my $d (@$data) {
# this is either an errorcode hash or data hash
if (defined($d->{errorcode})) {
$json->{errorcode} = $d->{errorcode}->[0];
}
elsif (defined($d->{data})) {
foreach my $line (@{$d->{data}}) {
my ($nodename, $output) = $line =~ m/^(\S+): (.*)$/;
if (defined($nodename)) { push @{$json->{$nodename}}, $output; }
}
}
else { error('improperly formatted xdsh output from xcatd', $STATUS_TEAPOT); }
}
addPageContent($JSON->encode($json));
}
elsif ($path[2] eq 'dcp') {
# The data structure is a 1-element array of a hash with 1 key 'errorcode'. That has a 1-element
# array with the code in it. Let's simplify it.
$json->{errorcode} = $data->[0]->{errorcode}->[0];
addPageContent($JSON->encode($json));
}
else {
addPageContent($JSON->encode($data));
}
} # end if isPost
2011-05-20 15:36:27 +00:00
}
2014-02-27 00:34:16 +00:00
2012-02-16 02:42:44 +00:00
sub wrapHtml {
my $item;
my $response = shift;
foreach my $element (@$response) {
if ($element->{node}) {
addPageContent("<table border=1>");
foreach $item (@{$element->{node}}) {
#my $url = $baseUri.$item->{name}[0];
addPageContent("<tr><td>$item->{name}[0]</td>");
if (exists $item->{data} && exists $item->{data}[0]) {
if (ref($item->{data}[0]) eq 'HASH') {
if (exists $item->{data}[0]->{desc} && exists $item->{data}[0]->{desc}[0]) {
addPageContent("<td>$item->{data}[0]->{desc}[0]</td>");
}
if (ref($item->{data}[0]) eq 'HASH' && exists $item->{data}[0]->{contents}[0]) {
addPageContent("<td>$item->{data}[0]->{contents}[0]</td>");
}
}
else {
addPageContent("<td>$item->{data}[0]</td>");
}
}
elsif (exists $item->{error}) {
addPageContent("<td>$item->{error}[0]</td>");
}
addPageContent("</tr>");
}
addPageContent("</table>");
}
if ($element->{data}) {
addPageContent("<table border=1>");
foreach $item (@{$element->{data}}) {
my @values = split(/:/, $item, 2);
addPageContent("<tr>");
foreach (@values) {
if ($formatType =~ /splitCommas/) {
my @fields = split(/,/, $_, -1);
foreach (@fields) {
addPageContent("<td>$_</td>");
}
}
else {
addPageContent("<td>$_</td>");
}
}
addPageContent("</tr>\n");
}
addPageContent("</table>");
}
if ($element->{info}) {
addPageContent("<table border=1>");
foreach $item (@{$element->{info}}) {
addPageContent("<tr>");
2012-02-16 13:06:45 +00:00
my $fieldname = '';
my $fieldvalue = '';
#strip whitespace in the string
$item =~ s/^\s+//;
$item =~ s/\s+$//;
if ($item =~ /Object/) {
($fieldname, $fieldvalue) = split(/:/, $item);
}
elsif ($item =~ /.*=.*/) {
my $position = index $item, '=';
$fieldname = substr $item, 0, $position;
$fieldvalue = substr $item, $position + 1;
}
else {
$fieldname = $item;
}
addPageContent("<td>" . $fieldname . "</td>");
if ($fieldvalue ne '') {
addPageContent("<td>" . $fieldvalue . "</td>");
2012-02-16 02:42:44 +00:00
}
addPageContent("</tr>\n");
}
addPageContent("</table>");
}
if ($element->{error}) {
addPageContent("<table border=1>");
foreach $item (@{$element->{error}}) {
addPageContent("<tr><td>" . $item . "</td></tr>");
}
addPageContent("</table>");
}
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
sub wrapXml {
my @data = shift;
foreach (@data) {
foreach (@$_) {
2014-02-03 20:58:15 +00:00
addPageContent(XML::Simple::XMLout($_, RootName => '', NoAttr => 1, KeyAttr => []));
2012-02-16 02:42:44 +00:00
}
2011-06-14 18:58:31 +00:00
}
2011-05-20 15:36:27 +00:00
}
2014-02-09 20:43:37 +00:00
# Send the request to xcatd and read the response. The request passed in has already been converted to xml.
# The response returned to the caller of this function has already been converted from xml to perl structure.
2012-02-16 02:42:44 +00:00
sub sendRequest {
my $request = shift;
my $sitetab;
my $retries = 0;
2014-02-27 00:34:16 +00:00
if ($DEBUGGING == 2) {
my $preXml = $request;
$preXml =~ s/</<br>< /g;
$preXml =~ s/>/><br>/g;
addPageContent($q->p("DEBUG: request XML: " . $request . "\n"));
2012-02-16 02:42:44 +00:00
}
#hardcoded port for now
my $port = 3001;
my $xcatHost = "localhost:$port";
#temporary, will be using username and password
my $homedir = "/root";
my $keyfile = $homedir . "/.xcat/client-cred.pem";
my $certfile = $homedir . "/.xcat/client-cred.pem";
my $cafile = $homedir . "/.xcat/ca.pem";
my $client;
if (-r $keyfile and -r $certfile and -r $cafile) {
$client = IO::Socket::SSL->new(
PeerAddr => $xcatHost,
SSL_key_file => $keyfile,
SSL_cert_file => $certfile,
SSL_ca_file => $cafile,
SSL_use_cert => 1,
Timeout => 15,);
}
else {
$client = IO::Socket::SSL->new(
PeerAddr => $xcatHost,
Timeout => 15,);
}
unless ($client) {
if ($@ =~ /SSL Timeout/) {
2014-02-23 09:13:15 +00:00
error("Connection failure: SSL Timeout or incorrect certificates in ~/.xcat",$STATUS_TIMEOUT);
2011-05-20 15:36:27 +00:00
}
else {
2014-02-23 09:13:15 +00:00
error("Connection failurexx: $@",$STATUS_SERVICE_UNAVAILABLE);
2012-02-16 02:42:44 +00:00
}
}
print $client $request;
my $response;
my $rsp;
2014-02-27 00:34:16 +00:00
my $fullResponse = [];
2012-02-16 02:42:44 +00:00
my $cleanexit = 0;
while (<$client>) {
$response .= $_;
if (m/<\/xcatresponse>/) {
#replace ESC with xxxxESCxxx because XMLin cannot handle it
2012-02-22 02:24:16 +00:00
if ($DEBUGGING) {
2014-02-03 20:58:15 +00:00
#addPageContent("DEBUG: response from xcatd: " . $response . "\n");
2012-02-22 02:24:16 +00:00
}
2012-02-16 02:42:44 +00:00
$response =~ s/\e/xxxxESCxxxx/g;
#print "responseXML is ".$response;
2014-02-03 20:58:15 +00:00
$rsp = XML::Simple::XMLin($response, SuppressEmpty => undef, ForceArray => 1);
2012-02-16 02:42:44 +00:00
#add ESC back
foreach my $key (keys %$rsp) {
if (ref($rsp->{$key}) eq 'ARRAY') {
foreach my $text (@{$rsp->{$key}}) {
next unless defined $text;
$text =~ s/xxxxESCxxxx/\e/g;
}
}
else {
$rsp->{$key} =~ s/xxxxESCxxxx/\e/g;
}
}
$response = '';
2014-02-27 00:34:16 +00:00
push(@$fullResponse, $rsp);
2012-02-16 02:42:44 +00:00
if ($rsp->{serverdone}) {
$cleanexit = 1;
last;
}
2011-05-20 15:36:27 +00:00
}
2012-02-16 02:42:44 +00:00
}
unless ($cleanexit) {
2014-02-23 09:13:15 +00:00
error("communication with the xCAT server seems to have been ended prematurely",$STATUS_SERVICE_UNAVAILABLE);
2012-02-16 02:42:44 +00:00
}
2011-05-20 15:36:27 +00:00
2014-02-27 00:34:16 +00:00
if ($DEBUGGING == 2) {
addPageContent($q->p("DEBUG: full response from xcatd: " . Dumper($fullResponse)));
}
return $fullResponse;
}
# Load the JSON perl module, if not already loaded. Sets the $JSON global var.
sub loadJSON {
if ($JSON) { return; } # already loaded
# require JSON dynamically and let them know if it is not installed
my $jsoninstalled = eval { require JSON; };
unless ($jsoninstalled) {
error("JSON perl module missing. Install perl-JSON before using the xCAT REST web services API.", $STATUS_SERVICE_UNAVAILABLE);
}
$JSON = JSON->new();
}
# push flags (options) onto the xcatd request. Arguments: request args array, flags array.
# Format of flags array: <urlparam-name> <xdsh-cli-flag> <if-there-is-associated-value>
sub pushFlags {
my ($args, $flags) = @_;
foreach my $f (@$flags) {
my ($key, $flag, $arg) = @$f;
if (defined($paramhash->{$key})) {
push @$args, $flag;
if ($arg) { push @$args, $paramhash->{$key}; }
}
}
}
# if debugging, output the given string
sub debug {
if (!$DEBUGGING) { return; }
addPageContent($q->p("DEBUG: $_[0]\n"));
}
# when having bugs that cause this cgi to not produce any output, output something and then exit.
sub debugandexit {
addPageContent("$_[0]\n");
sendResponseMsg($STATUS_OK);
}
# add a error msg to the output in the correct format and end this request
#todo: replace all addPageContent/sendResponseMsg pairs to call this function instead
sub error {
my ($msg, $errorcode) = @_;
my $severity = 'error';
my $m;
if ($format eq 'xml') { $m = "<$severity>$msg</$severity>\n"; }
elsif ($format eq 'json') { $m = qq({"$severity":"$msg"}\n); }
else { $m = "<p>$severity: $msg</p>\n"; }
addPageContent($m);
sendResponseMsg($errorcode);
}
# Append content to the global var holding the output to go back to the rest client
sub addPageContent {
my $newcontent = shift;
$pageContent .= $newcontent;
}
# send the response to client side, then exit
# with http there is only one return for each request, so all content should be in pageContent global variable when you call this
# create the response header by status code and format
sub sendResponseMsg {
my $code = shift;
my $tempFormat = '';
if ('json' eq $format) { $tempFormat = 'application/json'; }
elsif ('xml' eq $format) { $tempFormat = 'text/xml'; }
else { $tempFormat = 'text/html'; }
print $q->header(-status => $code, -type => $tempFormat);
print $pageContent;
exit(0);
}
sub unsupportedRequestType {
addPageContent("request method '$requestType' is not supported on resource '$resource'");
sendResponseMsg($STATUS_NOT_ALLOWED);
}
# Convert xcat request to xml for sending to xcatd
sub genRequest {
2012-02-16 02:42:44 +00:00
if ($DEBUGGING) {
2014-02-27 00:34:16 +00:00
#addPageContent($q->p("DEBUG: request to xcatd: " . Dumper($request) . "\n"));
2011-05-20 15:36:27 +00:00
}
2014-02-27 00:34:16 +00:00
my $xml = XML::Simple::XMLout($request, RootName => 'xcatrequest', NoAttr => 1, KeyAttr => []);
}
# Put input parameters from both $q->url_param and put/post data (if it exists) into generalparams and paramhash for all to use
sub fetchParameters {
my @generalparamlist = qw(userName password format pretty debug);
# 1st check for put/post data and put that in the hash
my $pdata;
if (isPut()) { $pdata = $q->param('PUTDATA'); }
elsif (isPost()) { $pdata = $q->param('POSTDATA'); }
my $genparms = {};
my $phash;
if ($pdata) {
$phash = eval { $JSON->decode($pdata); };
if ($@) { error("$@",$STATUS_BAD_REQUEST); }
#debug("phash=" . Dumper($phash));
if (ref($phash) ne 'HASH') { error("put or post data must be a json object (hash/dict).", $STATUS_BAD_REQUEST); }
# if any general parms are in the put/post data, move them to genparms
foreach my $k (keys %$phash) {
if (grep(/^$k$/, @generalparamlist)) {
$genparms->{$k} = $phash->{$k};
delete($phash->{$k});
}
}
}
else { $phash = {}; }
# now get params from the url (if any of the keys overlap, the url value will overwrite the put/post value)
foreach my $p ($q->url_param) {
my @a = $q->url_param($p); # this could be a single value or an array, have to figure it out
my $value;
if (scalar(@a) > 1) { $value = [@a]; } # convert it to a reference to an array
else { $value = $a[0]; }
if (grep(/^$p$/, @generalparamlist)) { $genparms->{$p} = $value; }
else { $phash->{$p} = $value; }
}
return ($genparms, $phash);
2011-05-20 15:36:27 +00:00
}
2014-02-09 20:43:37 +00:00
# Functions to test the http request type
sub isGet { return uc($requestType) eq "GET"; }
2011-05-20 15:36:27 +00:00
2014-02-09 20:43:37 +00:00
sub isPut { return uc($requestType) eq "PUT"; }
2011-05-20 15:36:27 +00:00
2014-02-09 20:43:37 +00:00
sub isPost { return uc($requestType) eq "POST"; }
2011-05-20 15:36:27 +00:00
2014-02-09 20:43:37 +00:00
sub isPatch { return uc($requestType) eq "PATCH"; }
2011-05-20 15:36:27 +00:00
2014-02-09 20:43:37 +00:00
sub isDelete { return uc($requestType) eq "DELETE"; }
2011-05-20 15:36:27 +00:00
2014-02-09 20:43:37 +00:00
# check to see if this is a valid user. userName and password are already set
# this function is not currently used.
2012-02-16 02:42:44 +00:00
sub isAuthenticUser {
$request->{command} = 'authcheck';
my $req = genRequest();
2014-02-27 00:34:16 +00:00
my $responses = sendRequest($req);
if ($responses->[0]->{data}[0] eq "Authenticated") {
2012-02-16 02:42:44 +00:00
#user is authenticated
return 1;
}
#authentication failure
2014-02-27 00:34:16 +00:00
error($responses->[0]->{error}[0], $STATUS_UNAUTH);
2011-05-20 15:36:27 +00:00
}