2011-05-20 15:36:27 +00:00
#!/usr/bin/perl
use strict;
use CGI qw/:standard/;
use JSON;
use Data::Dumper;
#added the line:
#ScriptAlias /xcatws /var/www/cgi-bin/xcatws.cgi
#to /etc/httpd/conf/httpd.conf to hid the cgi-bin and .cgi extension in the uri
#
# also upgraded CGI to 3.52
#take the JSON or XML and put it into a data structure
#all data input will be done from the common structure
#turn on or off the debugging output
2011-05-23 18:04:23 +00:00
my $DEBUGGING = 0;
2011-05-20 15:36:27 +00:00
my $q = CGI->new;
my $url = $q->url;
my $pathInfo = $q->path_info;
my $requestType = $ENV{'REQUEST_METHOD'};
my $queryString = $ENV{'QUERY_STRING'};
my @path = split(/\//, $pathInfo);
shift(@path);
my $resource = $path[0];
2012-02-08 05:55:13 +00:00
#print $q->header('text/html');
2011-05-20 15:36:27 +00:00
my $request = {clienttype =>'ws'};
#error status codes
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";
my $STATUS_SERVICE_UNAVAILABLE = "503 Service Unavailable";
#good status codes
my $STATUS_OK = "200 OK";
my $STATUS_CREATED = "201 Created";
sub sendStatusMsg{
my $code = shift;
my $message = shift;
print $q->header(-status => $code);
print $message;
}
sub unsupportedRequestType{
sendStatusMsg($STATUS_NOT_ALLOWED, "request method '$requestType' is not supported on resource '$resource'");
}
use XML::Simple;
$XML::Simple::PREFERRED_PARSER='XML::Parser';
sub genRequest{
if($DEBUGGING){
print $q->p("request ".Dumper($request));
}
my $xml = XMLout($request, RootName=>'xcatrequest',NoAttr=>1,KeyAttr=>[]);
}
#default format
my $format = 'html';
#data formatters. To add one simple copy the format of an existing one
# and add it to this hash
my %formatters = ('html' => \&wrapHtml,
'json' => \&wrapJson,
'xml' => \&wrapXml,
);
if($q->param('format'))
{
$format = $q->param('format');
if(!exists $formatters{$format}){
sendStatusMsg($STATUS_BAD_REQUEST, "The format '$format' is not valid");
exit(0);
}
}
my $XCAT_PATH = '/opt/xcat/bin';
2011-06-14 18:58:31 +00:00
#resource handlers
2011-05-20 15:36:27 +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,
vms => \&vmsHandler);
2011-06-14 18:58:31 +00:00
#if no resource was specified
if($pathInfo =~ /^\/$/ || $pathInfo =~ /^$/){
2012-02-08 05:55:13 +00:00
print $q->header('text/html');
2011-06-14 18:58:31 +00:00
print $q->p("This is the root page for the xCAT Rest Web Service. Available resources are:");
foreach (sort keys %resources){
print $q->p($_);
}
exit(0);
}
2011-05-20 15:36:27 +00:00
sub doesResourceExist
{
my $res = shift;
return exists $resources{$res};
}
if($DEBUGGING){
if(defined $q->param('PUTDATA')){
print "put data ".$q->p($q->param('PUTDATA')."\n");
}
if(defined $q->param('POSTDATA')){
print "post data ".$q->p($q->param('POSTDATA')."\n");
}
print $q->p("Parameters ");
my @params = $q->param;
foreach (@params)
{
print "$_ = ".$q->param($_)."\n";
}
print $q->p("Query String $queryString"."\n");
print $q->p("HTTP Method $requestType"."\n");
print $q->p("URI $url"."\n");
print $q->p("path ".Dumper(@path)."\n");
}
my $userName;
my $password;
sub handleRequest{
if(defined $q->param('userName')){
$userName = $q->param('userName')
}
if(defined $q->param('password')){
$password = $q->param('password')
}
if($userName && $password){
$request->{becomeuser}->[0]->{username}->[0] = $userName;
$request->{becomeuser}->[0]->{password}->[0] = $password;
}
my @data = $resources{$resource}->();
wrapData(\@data);
}
my @groupFields = ('groupname', 'grouptype', 'members', 'wherevals', 'comments', 'disable');
#get is done
#post and delete are done but not tested
#groupfiles4dsh is done but not tested
sub groupsHandler{
my @responses;
my @args;
my $groupName;
#is the group name in the URI?
if(defined $path[1]){
$groupName = $path[1];
}
#in the query string?
else{
$groupName = $q->param('groupName');
}
if(isGet()){
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.$_";
}
}
}
else {
$request->{command} = 'tabdump';
push @args, 'nodegroup';
}
}
#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{
sendStatusMsg($STATUS_BAD_REQUEST, "A node range and group name must be specified for creating a group");
exit(0);
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "The path must be specified for creating directories for dsh");
exit(0);
}
}
else{
if(defined $groupName && defined $q->param('fields')){
$request->{command} = 'nodegrpch';
push @args, $groupName;
push @args, $q->param('field');
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The group and fields must be specified to update groups");
exit(0);
}
}
}
elsif(isDelete()){
if(defined $groupName){
$request->{command} = 'rmdef';
push @args, '-d';
push @args, 'group';
push @args, '-o';
push @args, $groupName;
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The group must be specified to delete a group");
exit(0);
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
my @imageFields = ('imagename','profile','imagetype','provmethod','osname','osvers','osdistro','osarch','synclists','comments','disable');
#get is done, nothing else
sub imagesHandler{
my @responses;
my @args;
my $image;
if(defined($path[1])){
$image = $path[1];
}
else{
$image = $q->param('imageName');
}
if(isGet()){
if(defined $image){
#call chkosimage, but should only be used for AIX images
2011-06-14 18:58:31 +00:00
if($q->param('checkAixImage')){
2011-05-20 15:36:27 +00:00
$request->{command} = 'chkosimage';
push @args, $image;
}
else{
$request->{command} = 'tabget';
push @args, "imagename=$image";
if(defined $q->param('field')){
foreach ($q->param('field')){
push @args, "osimage.$_";
}
}
else{
foreach (@groupFields){
push @args, "osimage.$_";
}
}
}
}
#no image indicated, so list all
else{
$request->{command} = 'tabdump';
push @args, 'osimage';
}
}
elsif(isPost()){
####genimage and related commands do not go through xcatd....
####not supported at the moment
#if($q->param('type') eq /stateless/){
#if(!defined $image){
#sendStatusMsg($STATUS_BAD_REQUEST, "The image name is required to create a stateless image");
#exit(0);
#}
#$request->{command} = 'genimage';
#foreach(param->{'field'}){
#}
#}
#else{
#if(defined $q->param('path')){
#$request->{command} = 'copycds';
#push @args, $q->param('path');
#}
#}
}
elsif(isPut() || isPatch()){
#use chkosimage to remove any older versions of the rpms. should only be used for AIX
2011-06-14 18:58:31 +00:00
if($q->param('cleanAixImage')){
2011-05-20 15:36:27 +00:00
if(defined $image){
$request->{command} = 'chkosimage';
push @args, '-c';
push @args, $image;
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The image name is required to clean an os image");
}
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "Either the image name or the os, architecture and profile must be specified to remove an image");
exit(0);
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
#complete
sub logsHandler{
my @responses;
my @args;
my $logType;
if(defined $path[1]){
$logType = $path[1];
}
#in the query string?
else{
$logType = $q->param('logType');
}
2011-06-14 18:58:31 +00:00
my $nodeRange = $q->param('nodeRange');
2011-05-20 15:36:27 +00:00
#no real output unless the log type is defined
if(!defined $logType){
print $q->p("Current logs available are auditlog and eventlog");
exit(0);
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "nodeRange must be specified to GET remote event logs");
}
}
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{
2011-06-14 18:58:31 +00:00
sendStatusMsg($STATUS_BAD_REQUEST, "nodeRange must be specified to clean remote event logs");
2011-05-20 15:36:27 +00:00
}
}
else{
#should it return the removed entries?
if(defined $q->param('showRemoved'))
{
push @args, '-V';
}
2011-06-14 18:58:31 +00:00
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';
}
2011-05-20 15:36:27 +00:00
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
#complete
sub monitorsHandler{
my @responses;
my @args;
my $monitor;
if(defined $path[1]){
$monitor = $path[1];
}
#in the query string?
elsif(defined $q->param('monitor')){
push @args, $q->param('monitor');
}
if(defined $monitor)
{
push @args, $monitor;
}
if(isGet()){
$request->{command} = 'monls';
}
elsif(isPost()){
$request->{command} = 'monadd';
if($q->param('nodeStatMon')){
push @args, '-n';
}
#get the plug-in specific settings array
2011-09-26 16:51:19 +00:00
foreach ($q->param('pluginSetting')){
push @args, '-s';
push @args, $_;
2011-05-20 15:36:27 +00:00
}
}
elsif(isDelete()){
$request->{command} = 'monrm'
}
elsif(isPut() || isPatch()){
my $action = $q->param('action');
if($action eq "start"){
$request->{command} = 'monstart';
}
elsif($action eq "stop"){
$request->{command} = 'monstop';
}
elsif($action eq "config"){
$request->{command} = 'moncfg';
}
elsif($action eq "deconfig"){
$request->{command} = 'mondeconfig';
}
else{
unsupportedRequestType();
}
if(!defined $q->param('nodeRange')){
#error
}
else{
push @args, $q->param('nodeRange');
}
if(defined $q->param('remote')){
push @args, '-r';
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
sub networksHandler{
my @responses;
my @args;
if(isGet()){
2011-06-14 18:58:31 +00:00
$request->{command} = 'tabdump';
push @args, 'networks';
2011-05-20 15:36:27 +00:00
}
elsif(isPut() or isPatch()){
my $subResource;
if(defined $path[1]){
$subResource = $path[1];
}
if($subResource eq "hosts"){
$request->{command} = 'makehosts';
#is this needed?
push @args, 'all';
}
elsif($subResource eq "dhcp"){
#allow restarting of the dhcp service. scary?
if($q->param('command') eq "restart"){
if(isAuthenticUser()){
system('service dhcp restart');
}
else{
exit(0);
}
}
else{
$request->{command} = 'makedhcp';
foreach($q->param('field')){
push @args, $_;
}
}
}
elsif($subResource eq "dns"){
#allow restarting of the named service. scary?
if($q->param('command') eq "restart"){
if(isAuthenticUser()){
system('service named restart');
}
}
else{
2011-06-14 18:58:31 +00:00
$request->{command} = 'makedns';
2011-05-20 15:36:27 +00:00
foreach($q->param('field')){
push @args, $_;
}
}
}
}
elsif(isPost()){
}
elsif(isDelete()){
}
else{
unsupportedRequestType();
exit(0);
}
return @responses;
}
sub nodesHandler{
my @responses;
my @args;
#does it specify nodes in the URI?
if(defined $path[1]){
$request->{noderange} = $path[1];
}
#in the query string?
elsif(defined $q->param('nodeRange')){
$request->{noderange} = $q->param('nodeRange');
}
if(isGet()){
my $subResource;
if(defined $path[2]){
$subResource = $path[2];
}
if($subResource =~ "power"){
$request->{command} = 'rpower';
push @args, 'stat';
}
elsif($subResource =~ "bootState"){
$request->{command} = 'nodeset';
push @args,'stat';
}
elsif($subResource =~ "energy"){
$request->{command} = 'renergy';
#no fields will default to 'all'
if(defined $q->param('field')){
foreach ($q->param('field')){
push @args, $_;
}
}
}
2011-06-14 18:58:31 +00:00
elsif($subResource =~ "osImage"){
2011-05-20 15:36:27 +00:00
}
elsif($subResource =~ "status"){
$request->{command} = 'nodestat';
}
elsif($subResource =~ "inventory"){
$request->{command} = 'rinv';
if(defined $q->param('field')){
push @args, $q->param('field');
}
else{
push @args, 'all';
}
}
elsif($subResource =~ "location"){
$request->{command} = 'nodels';
push @args, 'nodepos';
}
2011-09-26 16:51:19 +00:00
elsif($subResource =~ "vitals"){
$request->{command} = 'rvitals';
if(defined $q->param('field')){
push @args, $q->param('field');
}
else{
push @args, 'all';
}
}
2011-05-20 15:36:27 +00:00
else{
$request->{command} = 'nodels';
#if the table or field is specified in the URI
if(defined $subResource){
push @args, $subResource;
}
#maybe it's specified in the parameters
else{
push @args, $q->param('field');
}
}
}
elsif(isPut()){
my $subResource;
if(defined $path[2]){
$subResource = $path[2];
}
if($subResource =~ "bootState"){
$request->{command} = 'nodeset';
if(defined $q->param('boot')){
push @args, 'boot';
}
if(defined $q->param('install')){
if($q->param('install')){
push @args, "install=".$q->param('install');
}
else{
push @args, 'install';
}
}
if(defined $q->param('netboot')){
if($q->param('netboot')){
push @args, "netboot=".$q->param('netboot');
}
else{
push @args, 'netboot';
}
}
if(defined $q->param('statelite')){
if($q->param('statelite')){
push @args, "statelite=".$q->param('statelite');
}
else{
push @args, 'statelite';
}
}
2011-06-14 18:58:31 +00:00
if(defined $q->param('bmcSetup')){
2011-05-20 15:36:27 +00:00
push @args, "runcmd=bmcsetup";
}
2011-06-14 18:58:31 +00:00
#can't do this
#if(defined $q->param('shell')){
#push @args, 'shell';
#}
2011-05-20 15:36:27 +00:00
}
else{
sendErrorMessage($STATUS_BAD_REQUEST, "The subResource \'$request->{subResource}\' does not exist");
}
}
elsif(isPost()){
$request->{command} = 'nodeadd';
if(defined $q->param('groups')){
$request->{groups} = $q->param('groups');
}
#since we can't predict which table fields will be passed
#we just pass everything else
for my $arg ($q->param){
if($arg !~ "nodeRange" && $arg !~ "groups"){
push @args, $arg;
}
}
}
elsif(isPatch()){
$request->{command} = 'nodech';
}
elsif(isDelete()){
#FYI: the nodeRange for delete has to be specified in the URI
$request->{command} = 'noderm';
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
my @notificationFields = ('filename', 'tables', 'tableops', 'comments', 'disable');
#complete, unless there is some way to alter existing notifications
sub notificationsHandler{
my @responses;
my @args;
#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')){
sendStatusMsg($STATUS_BAD_REQUEST, "fileName, table and operation must be specified for a POST on /notifications");
}
else{
push @args, $q->param('fileName');
my $tables;
foreach ($q->param('table')){
$tables .= "$_,";
}
#get rid of the extra comma
chop($tables);
push @args, $tables;
push @args, '-o';
my $operations;
foreach ($q->param('operation')){
$operations .= "$_,";
}
#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{
sendStatusMsg($STATUS_BAD_REQUEST, "fileName must be specified for a DELETE on /notifications");
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
print "request is ".Dumper($request);
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
my @policyFields = ('priority','name','host','commands','noderange','parameters','time','rule','comments','disable');
#complete
sub policiesHandler{
my @responses;
my @args;
my $priority;
#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{
sendStatusMsg($STATUS_BAD_REQUEST, "The priority must be specified when creating a policy");
exit(0);
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "The priority must be specified when updating a policy");
exit(0);
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
print "request is ".Dumper($request);
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
#complete
sub siteHandler{
my @data;
my @responses;
my @args;
if(isGet()){
$request->{command} = 'tabdump';
push @{$request->{arg}}, 'site';
my $req = genRequest();
@responses = sendRequest($req);
}
elsif(isPut() || isPatch()){
$request->{command} = 'tabch';
if(defined $q->param('PUTDATA')){
my $entries = decode_json $q->param('PUTDATA');;
foreach (values %$entries){
my %fields = %$_;
foreach my $key (keys %fields){
if($key =~ /key/){
#the key needs to be first
unshift @args, "key=$fields{$key}";
}
else{
push @args, "site.$key=$fields{$key}";
}
}
push @{$request->{arg}}, @args;
my $req = genRequest();
my @subResponses = sendRequest($req);
#TODO: look at the reponses and see if there are errors
push @responses, @subResponses;
}
}
}
else{
unsupportedRequestType();
exit();
}
#change response formatting
foreach my $response (@responses){
foreach my $item (@{$response->{data}}){
if($item !~ /^#/)
{
my @values = split(/,/, $item);
my %item = (
entry => $values[0],
value => $values[1],
comments => $values[2],
disable => $values[3]);
push @data, \%item;
}
}
}
return @responses;
}
my $formatType;
#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
sub tablesHandler{
my @responses;
my $table;
my @args;
#is the table name specified in the URI?
if(defined $path[1]){
$table = $path[1];
}
#handle all gets
if(isGet()){
$request->{command} = 'tabdump';
if(defined $q->param('desc')){
push @args, '-d';
}
#table was specified
if (defined $table){
push @args, $table;
if(!defined $q->param('desc')){
$formatType = 'splitCommas';
}
}
}
elsif(isPut() || isPatch()){
my $condition = $q->param('condition');
if(!defined $table || !defined $condition){
sendStatusMsg($STATUS_BAD_REQUEST, "The table and condition must be specified when adding, changing or deleting an entry");
exit(0);
}
$request->{command} = 'tabch';
if(defined $q->param('delete')){
push @args, '-d';
push @args, $condition;
push @args, $table;
}
else{
push @args, $condition;
for($q->param('value')){
push @args, "$table.$_";
}
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
my @accountFields = ('key', 'username', 'password', 'cryptmethod', 'comments', 'disable');
#done aside from being able to change cluster users, which xcat can't do yet
sub accountsHandler{
my @responses;
my @args;
my $key = $q->param('key');
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.$_";
}
}
}
2011-06-14 18:58:31 +00:00
else{
$request->{command} = 'tabdump';
push @args, 'passwd';
}
2011-05-20 15:36:27 +00:00
}
#cluster user list
else{
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruserlist';
push @args, '-p';
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "The key must be specified when creating a non-cluster user");
exit(0);
}
}
#active directory user
else{
if(defined $q->param('userName') && defined $q->param('userPass')){
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruseradd';
push @args, $q->param('userName');
push @{$request->{arg}}, @args;
$request->{environment} = {XCAT_USERPASS => $q->param('userPass')};
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The key must be specified when creating a cluster user");
exit(0);
}
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "The key must be specified when deleting a non-cluster user");
exit(0);
}
}
else{
if(defined $q->param('userName')){
$request->{command} = 'xcatclientnnr';
push @args, 'clusteruserdel';
push @args, $q->param('userName');
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The userName must be specified when deleting a cluster user");
exit(0);
}
}
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "The key must be specified when updating a non-cluster user");
exit(0);
}
}
#TODO: there isn't currently a way to update cluster users
else{
}
}
else{
unsupportedRequestType();
exit(0);
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
sub objectsHandler{
my @responses;
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';
}
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);
}
}
}
elsif(isPut()){
2011-05-23 18:04:23 +00:00
$request->{command} = 'chdef';
if($q->param('verbose')){
push @args, '-v';
}
if(!defined $q->param('objectType')){
sendStatusMsg($STATUS_BAD_REQUEST, "The object must be specified.");
}
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
}
elsif(isPost()){
2011-05-23 18:04:23 +00:00
$request->{command} = 'mkdef';
if($q->param('verbose')){
push @args, '-v';
}
if(!defined $q->param('objectType')){
sendStatusMsg($STATUS_BAD_REQUEST, "The object must be specified.");
}
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');
}
2011-05-20 15:36:27 +00:00
}
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{
sendStatusMsg($STATUS_BAD_REQUEST, "Either the help info must be requested or the object must be specified or the flag that indicates everything should be removed.");
exit(0);
}
if(defined $q->param('nodeRange')){
push @args, $q->param('nodeRange');
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
@responses = sendRequest($req);
return @responses;
}
#complete i think, tho chvm could handle args better
sub vmsHandler{
my @args;
if(defined $q->param('nodeRange')){
$request->{noderange} = $q->param('nodeRange');
}
if(defined $q->param('verbose')){
push @args, '-V';
}
if(isGet()){
$request->{command} = 'lsvm';
if(defined $q->param('all')){
push @args, '-a';
}
}
elsif(isPost()){
if(defined $q->param('clone')){
$request->{command} = 'clonevm';
if(defined $q->param('target')){
push @args, '-t';
push @args, $q->param('target');
}
if(defined $q->param('source')){
push @args, '-b';
push @args, $q->param('source');
}
if(defined $q->param('detached')){
push @args, '-d';
}
if(defined $q->param('force')){
push @args, '-f';
}
}
else{
#man page for mkvm needs updating for options
$request->{command} = 'mkvm';
if(defined $q->param('cec')){
push @args, '-c';
push @args, $q->param('cec');
}
if(defined $q->param('startId')){
push @args, '-i';
push @args, $q->param('startId');
}
if(defined $q->param('source')){
push @args, '-l';
push @args, $q->param('source');
}
if(defined $q->param('profile')){
push @args, '-p';
push @args, $q->param('profile');
}
if(defined $q->param('full')){
push @args, '--full';
}
#if(defined $q->param('master')){
#push @args, '-m';
#push @args, $q->param('master');
#}
#if(defined $q->param('size')){
#push @args, '-s';
#push @args, $q->param('size');
#}
#if(defined $q->param('force')){
#push @args, '-f';
#}
}
}
elsif(isPut() || isPatch()){
$request->{command} = 'chvm';
if(defined $q->param('field')){
foreach ($q->param('field')){
push @args, $_;
}
}
}
elsif(isDelete()){
2011-06-14 18:58:31 +00:00
$request->{command} = 'rmvm';
2011-05-20 15:36:27 +00:00
if(defined $request->{nodeRange}){
if(defined $q->param('retain')){
push @args, '-r';
}
if(defined $q->param('service')){
push @args, '--service';
}
}
else{
sendStatusMsg($STATUS_BAD_REQUEST, "The node range must be specified when deleting vms");
exit(0);
}
}
else{
unsupportedRequestType();
exit();
}
push @{$request->{arg}}, @args;
my $req = genRequest();
my @responses = sendRequest($req);
return @responses;
}
#for operations that take a 'long' time to finish, this will provide the interface to check their status
sub jobsHandler{
}
#all data wrapping and writing is funneled through here
sub wrapData{
my @data = shift;
2011-06-14 18:58:31 +00:00
#trim the serverdone message off
if(exists $data[0][$#{$data[0]}]->{serverdone}){
pop @{$data[0]};
}
2011-05-20 15:36:27 +00:00
if(exists $formatters{$format}){
$formatters{$format}->(@data);
}
}
sub wrapJson
{
my @data = shift;
print header('application/json');
my $json;
$json->{'data'} = \@data;
print to_json($json);
}
sub wrapHtml
{
my $item;
my @response = shift;
my $baseUri = $url.$pathInfo;
if($baseUri !~ /\/^/)
{
$baseUri .= "/";
}
2012-02-08 05:55:13 +00:00
print $q->header('text/html');
2011-05-20 15:36:27 +00:00
#print $q->p("dumping in wrapHtml ".Dumper(@response));
foreach my $data (@response){
if(@$data[0]->{error}){
if(@$data[0]->{error}[0] =~ /Permission denied/ || @$data[0]->{error}[0] =~ /Authentication failure/){
sendStatusMsg($STATUS_UNAUTH, @$data[0]->{error}[0]);
}
else{
2011-05-23 18:04:23 +00:00
sendStatusMsg($STATUS_FORBIDDEN, @$data[0]->{error}[0]);
2011-05-20 15:36:27 +00:00
}
exit(0);
}
else{
if(isPost()){
sendStatusMsg($STATUS_CREATED);
}
else{
sendStatusMsg($STATUS_OK);
}
}
foreach my $element (@$data){
#if($element->{error}){
if($element->{node}){
print "<table border=1>";
foreach $item (@{$element->{node}}){
#my $url = $baseUri.$item->{name}[0];
#print "<tr><td><a href=$url>$item->{name}[0]</td></tr>";
print "<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]){
print "<td>$item->{data}[0]->{desc}[0]</td>";
}
if(ref($item->{data}[0]) eq 'HASH' && exists $item->{data}[0]->{contents}[0]){
print "<td>$item->{data}[0]->{contents}[0]</td>";
}
}
else{
print "<td>$item->{data}[0]</td>";
}
}
2011-06-14 18:58:31 +00:00
elsif(exists $item->{error}){
print "<td>$item->{error}[0]</td>";
}
2011-05-20 15:36:27 +00:00
print "</tr>";
}
print "</table>";
}
elsif($element->{data}){
print "<table border=1>";
foreach $item (@{$element->{data}}){
my @values = split(/:/, $item, 2);
#print "<tr><td><a href=$url$pathInfo$key>$key</a></td><td>$value</td></tr>";
print "<tr>";
foreach (@values){
if($formatType =~ /splitCommas/){
my @fields = split(/,/, $_,-1);
foreach (@fields){
print "<td>$_</td>";
}
}
else{
print "<td>$_</td>";
}
}
print "</tr>\n";
}
print "</table>";
}
elsif($element->{info}){
print "<table border=1>";
foreach $item (@{$element->{info}}){
my @values = split(/:/, $item, 2);
#print "<tr><td><a href=$url$pathInfo$key>$key</a></td><td>$value</td></tr>";
print "<tr>";
foreach (@values){
if($formatType =~ /splitCommas/){
my @fields = split(/,/, $_,-1);
foreach (@fields){
print "<td>$_</td>";
}
}
else{
print "<td>$_</td>";
}
}
print "</tr>\n";
}
print "</table>";
#foreach $item (@{$element->{info}}){
#print $item;
#}
}
}
}
}
sub wrapXml
{
my @data = shift;
2011-06-14 18:58:31 +00:00
print header('text/xml');
foreach(@data){
foreach(@$_){
print XMLout($_, RootName=>'',NoAttr=>1,KeyAttr=>[]);
}
}
2011-05-20 15:36:27 +00:00
}
#general tests for valid requests and responses with HTTP codes here
if(!doesResourceExist($resource)){
sendStatusMsg($STATUS_NOT_FOUND, "Resource '$resource' does not exist");
exit(0);
}
else{
if($DEBUGGING){
print $q->p("resource is $resource");
}
handleRequest();
}
#talk to the server
use Socket;
use IO::Socket::INET;
use IO::Socket::SSL;
use lib "/opt/xcat/lib/perl";
use xCAT::Table;
# The database initialization may take some time in the system boot scenario
# wait for a while for the database initialization
#do we really need to do this for the web service?
sub sendRequest{
my $request = shift;
my $sitetab;
my $retries = 0;
if($DEBUGGING){
my $preXml = $request;
#$preXml =~ s/</<br>< /g;
#$preXml =~ s/>/><br>/g;
print $q->p("request XML<br>$preXml");
}
2011-05-23 18:04:23 +00:00
#hardcoded port for now
my $port = 3001;
2011-05-20 15:36:27 +00:00
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/) {
sendStatusMsg($STATUS_TIMEOUT, "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat");
exit(0);
}
else{
sendStatusMsg($STATUS_SERVICE_UNAVAILABLE, "Connection failure: $@");
exit(0);
}
}
print $client $request;
my $response;
my $rsp;
my @fullResponse;
my $cleanexit=0;
while (<$client>) {
$response .= $_;
if (m/<\/xcatresponse>/) {
#replace ESC with xxxxESCxxx because XMLin cannot handle it
$response =~ s/\e/xxxxESCxxxx/g;
#print "responseXML is ".$response;
$rsp = XMLin($response,SuppressEmpty=>undef,ForceArray=>1);
#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='';
push (@fullResponse, $rsp);
if ($rsp->{serverdone}) {
$cleanexit=1;
last;
}
}
}
unless ($cleanexit) {
sendStatusMsg($STATUS_SERVICE_UNAVAILABLE, "ERROR/WARNING: communication with the xCAT server seems to have been ended prematurely");
exit(0);
}
if($DEBUGGING){
print $q->p("response ".Dumper(@fullResponse));
}
return @fullResponse;
}
sub isGet{
return uc($requestType) eq "GET";
}
sub isPut{
return uc($requestType) eq "PUT";
}
sub isPost{
return uc($requestType) eq "POST";
}
sub isPatch{
return uc($requestType) eq "PATCH";
}
sub isDelete{
return uc($requestType) eq "DELETE";
}
#check to see if this is a valid user. userName and password are already set
sub isAuthenticUser{
$request->{command} = 'authcheck';
my $req = genRequest();
my @responses = sendRequest($req);
if($responses[0]->{data}[0] eq "Authenticated"){
#user is authenticated
return 1;
}
#authentication failure
sendStatusMsg($STATUS_UNAUTH, $responses[0]->{error}[0]);
return 0;
}