arif/xcat-core
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
be24ac6b23
xcat-core/perl-xCAT-2.0/xCAT/PPCfsp.pm
sakolish 5e20327791 Added connect timeout configurable through site.fsptimeout 
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@1251 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
2008-05-02 18:10:25 +00:00

1707 lines
52 KiB
Perl
Raw Blame History

# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
package xCAT::PPCfsp;
use strict;
use Getopt::Long;
use LWP;
use HTTP::Cookies;
use HTML::Form;
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
use xCAT::Usage;
##########################################
# Globals
##########################################
my %cmds = (
rpower => {
state => ["Power On/Off System", \&state],
powercmd => ["Power On/Off System", \&powercmd],
powercmd_boot => ["Power On/Off System", \&boot],
reset => ["System Reboot", \&reset] },
reventlog => {
all => ["Error/Event Logs", \&all],
all_clear => ["Error/Event Logs", \&all_clear],
entries => ["Error/Event Logs", \&entries],
clear => ["Error/Event Logs", \&clear] },
rspconfig => {
memdecfg => ["Memory Deconfiguration", \&memdecfg],
decfg => ["Deconfiguration Policies", \&decfg],
procdecfg => ["Processor Deconfiguration", \&procdecfg],
iocap => ["I/O Adapter Enlarged Capacity", \&iocap],
time => ["Time Of Day", \&time],
date => ["Time Of Day", \&date],
autopower => ["Auto Power Restart", \&autopower],
sysdump => ["System Dump", \&sysdump],
spdump => ["Service Processor Dump", \&spdump] },
);
##########################################################################
# Parse the command line for options and operands
##########################################################################
sub parse_args {
my $request = shift;
my $command = $request->{command};
my @rsp = keys %{$cmds{$command}};
my $args = $request->{arg};
my %opt = ();
my %cmds = ();
#############################################
# Responds with usage statement
#############################################
local *usage = sub {
my $usage_string = xCAT::Usage->getUsage($command);
return( [$_[0], $usage_string] );
};
#############################################
# Process command-line arguments
#############################################
if ( !defined( $args )) {
return(usage( "No command specified" ));
}
#############################################
# Checks case in GetOptions, allows opts
# to be grouped (e.g. -vx), and terminates
# at the first unrecognized option.
#############################################
@ARGV = @$args;
$Getopt::Long::ignorecase = 0;
Getopt::Long::Configure( "bundling" );
$request->{method} = undef;
if ( !GetOptions( \%opt, qw(V|Verbose) )) {
return( usage() );
}
####################################
# Check for "-" with no option
####################################
if ( grep(/^-$/, @ARGV )) {
return(usage( "Missing option: -" ));
}
####################################
# Check for "=" with no argument
####################################
if (my ($c) = grep(/=$/, @ARGV )) {
return(usage( "Missing argument: $c" ));
}
####################################
# Check for unsupported commands
####################################
foreach my $arg ( @ARGV ) {
my ($command,$value) = split( /=/, $arg );
if ( !grep( /^$command$/, @rsp )) {
return(usage( "Invalid command: $arg" ));
}
if ( exists( $cmds{$command} )) {
return(usage( "Command multiple times: $command" ));
}
$cmds{$command} = $value;
}
####################################
# Check command arguments
####################################
foreach ( keys %cmds ) {
if ( $cmds{$_} ) {
my $result = parse_option( $request, $_, $cmds{$_} );
if ( $result ) {
return( usage($result) );
}
}
}
$request->{method} = \%cmds;
return( \%opt );
}
##########################################################################
# Parse the command line optional arguments
##########################################################################
sub parse_option {
my $request = shift;
my $command = shift;
my $value = shift;
####################################
# Set/get time
####################################
if ( $command =~ /^time$/ ) {
if ( $value !~
/^([0-1]?[0-9]|2[0-3]):(0?[0-9]|[1-5][0-9]):(0?[0-9]|[1-5][0-9])$/){
return( "Invalid time format '$value'" );
}
}
####################################
# Set/get date
####################################
if ( $command =~ /^date$/ ) {
if ( $value !~
/^(0?[1-9]|1[012])-(0?[1-9]|[12][0-9]|3[01])-(20[0-9]{2})$/){
return( "Invalid date format '$value'" );
}
}
####################################
# Set/get options
####################################
if ( $command =~ /^(autopower|iocap)$/ ) {
if ( $value !~ /^(enable|disable)$/i ) {
return( "Invalid argument '$value'" );
}
}
####################################
# Deconfiguration policy
####################################
if ( $command =~ /^decfg$/ ) {
if ( $value !~ /^(enable|disable):.*$/i ) {
return( "Invalid argument '$value'" );
}
}
####################################
# Processor deconfiguration
####################################
if ( $command =~ /^procdecfg$/ ) {
if ( $value !~ /^(configure|deconfigure):\d+:(all|[\d,]+)$/i ) {
return( "Invalid argument '$value'" );
}
}
################################
# Memory deconfiguration
################################
elsif ( $command =~ /^memdecfg$/ ) {
if ($value !~/^(configure|deconfigure):\d+:(unit|bank):(all|[\d,]+)$/i){
return( "Invalid argument '$value'" );
}
}
return undef;
}
##########################################################################
# FSP command handler through HTTP interface
##########################################################################
sub handler {
my $server = shift;
my $request = shift;
my $exp = shift;
#####################################
# Convert command to correct format
#####################################
if ( ref($request->{method}) ne "HASH" ) {
$request->{method} = [{$request->{method}=>undef}];
}
#####################################
# Process FSP command
#####################################
my @outhash;
my $result = process_cmd( $exp, $request );
foreach ( @$result ) {
my %output;
$output{node}->[0]->{name}->[0] = $server;
$output{node}->[0]->{data}->[0]->{contents}->[0] = @$_[1];
$output{errorcode} = @$_[0];
push @outhash, \%output;
}
#####################################
# Disconnect from FSP
#####################################
xCAT::PPCfsp::disconnect( $exp );
return( \@outhash );
}
##########################################################################
# Logon through remote FSP HTTP-interface
##########################################################################
sub connect {
my $req = shift;
my $server = shift;
my $verbose = $req->{verbose};
my $timeout = $req->{fsptimeout};
my $lwp_log;
##################################
# Use timeout from site table
##################################
if ( !$timeout ) {
$timeout = 30;
}
##################################
# Get userid/password
##################################
my @cred = xCAT::PPCdb::credentials( $server, "fsp" );
##################################
# Redirect STDERR to variable
##################################
if ( $verbose ) {
close STDERR;
if ( !open( STDERR, '>', \$lwp_log )) {
return( "Unable to redirect STDERR: $!" );
}
}
##################################
# Turn on tracing
##################################
if ( $verbose ) {
LWP::Debug::level( '+' );
}
##################################
# Create cookie
##################################
my $cookie = HTTP::Cookies->new();
$cookie->set_cookie( 0,'asm_session','0','cgi-bin','','443',0,0,3600,0 );
##################################
# Create UserAgent
##################################
my $ua = LWP::UserAgent->new();
##################################
# Set options
##################################
my $url = "https://$server/cgi-bin/cgi?form=2";
$ua->cookie_jar( $cookie );
$ua->timeout( $timeout );
##################################
# Submit logon
##################################
my $res = $ua->post( $url,
[ user => $cred[0],
password => $cred[1],
lang => "0",
submit => "Log in" ]
);
##################################
# Logon failed
##################################
if ( !$res->is_success() ) {
return( $lwp_log.$res->status_line );
}
##################################
# To minimize number of GET/POSTs,
# if we successfully logon, we should
# get back a valid cookie:
# Set-Cookie: asm_session=3038839768778613290
#
##################################
if ( $res->as_string =~ /Set-Cookie: asm_session=(\d+)/ ) {
##############################
# Successful logon....
# Return:
# UserAgent
# Server hostname
# UserId
# Redirected STDERR/STDOUT
##############################
return( $ua,
$server,
$cred[0],
\$lwp_log );
}
##############################
# Logon error
##############################
$res = $ua->get( $url );
if ( !$res->is_success() ) {
return( $lwp_log.$res->status_line );
}
##############################
# Check for specific failures
##############################
if ( $res->content =~ /(Invalid user ID or password|Too many users)/i ) {
return( $lwp_log.$1 );
}
return( $lwp_log."Logon failure" );
}
##########################################################################
# Logoff through remote FSP HTTP-interface
##########################################################################
sub disconnect {
my $exp = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $uid = @$exp[2];
##################################
# POST Logoff
##################################
my $res = $ua->post( "https://$server/cgi-bin/cgi?form=1",
[ submit => "Log out" ]
);
##################################
# Logoff failed
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Execute FSP command
##########################################################################
sub process_cmd {
my $exp = shift;
my $request = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $uid = @$exp[2];
my $command = $request->{command};
my $methods = $request->{method};
my %menu = ();
my @result;
##################################
# We have to expand the main
# menu since unfortunately, the
# the forms numbers are not the
# same across FSP models/firmware
# versions.
##################################
my $res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => "2",
e => "1" ]
);
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
##################################
# Build hash of expanded menus
##################################
foreach ( split /\n/, $res->content ) {
if ( /form=(\d+).*window.status='(.*)'/ ) {
$menu{$2} = $1;
}
}
foreach ( keys %$methods ) {
##############################
# Get form id
##############################
my $form = $menu{$cmds{$command}{$_}[0]};
if ( !defined( $form )) {
return( [RC_ERROR,"Cannot find '$cmds{$command}{$_}[0]' menu"] );
}
##################################
# Run command
##################################
my $res = $cmds{$command}{$_}[1]($exp, $request, $form, \%menu);
push @result, $res
}
return( \@result );
}
##########################################################################
# Returns current power state
##########################################################################
sub state {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
##################################
# Get current power status
##################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
##################################
# Get power state
##################################
if ( $res->content =~ /Current system power state: (.*)<br>/) {
return( [SUCCESS,$1] );
}
return( [RC_ERROR,"unknown"] );
}
##########################################################################
# Powers FSP On/Off
##########################################################################
sub powercmd {
my $exp = shift;
my $request = shift;
my $id = shift;
my $op = $request->{op};
my $ua = @$exp[0];
my $server = @$exp[1];
##################################
# Get Power On/Off System URL
##################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
##################################
# Get current power state
##################################
if ( $res->content !~ /Current system power state: (.*)<br>/) {
return( [RC_ERROR,"Unable to determine current power state"] );
}
my $state = $1;
##################################
# Already in that state
##################################
if ( $op =~ /^$state$/i ) {
return( [SUCCESS,"Success"] );
}
##################################
# Get "Power On/Off System" form
##################################
my $form = HTML::Form->parse( $res->content, $res->base );
##################################
# Return error
##################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Power On/Off System' form not found"] );
}
##################################
# Get "Save and Submit" button
##################################
my $button = ($op eq "on") ? "on" : "of";
my @inputs = $form->inputs();
if ( !grep( $_->{name} eq $button, @inputs )) {
return( [RC_ERROR,"Unable to power $op from state: $state"] );
}
##################################
# Send command
##################################
my $request = $form->click( $button );
$res = $ua->request( $request );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content =~ /(not allowed.*\.)/ ) {
return( [RC_ERROR,$1] );
}
##################################
# Success
##################################
if ( $res->content =~ /(Operation completed successfully)/ ) {
return( [SUCCESS,"Success"] );
}
return( [RC_ERROR,"Unknown error"] );
}
##########################################################################
# Reset FSP
##########################################################################
sub reset {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
##################################
# Send Reset command
##################################
my $res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
submit => "Continue" ]
);
##################################
# Return error
##################################
if ( !$res->is_success()) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content =~ /(This feature is only available.*)/ ) {
return( [RC_ERROR,$1] );
}
##################################
# Success
##################################
if ( $res->content =~ /(Operation completed successfully)/ ) {
return( [SUCCESS,"Success"] );
}
return( [RC_ERROR,"Unknown error"] );
}
##########################################################################
# Boots FSP (Off->On, On->Reset)
##########################################################################
sub boot {
my $exp = shift;
my $request = shift;
my $id = shift;
my $menu = shift;
my $command = $request->{command};
##################################
# Check current power state
##################################
my $state = xCAT::PPCfsp::state(
$exp,
$request,
$menu->{$cmds{$command}{state}[0]},
$menu );
my $Rc = shift(@$state);
##################################
# Return error
##################################
if ( $Rc != SUCCESS ) {
return( [$Rc,@$state[0]] );
}
if ( @$state[0] !~ /^(on|off)$/i ) {
return( [RC_ERROR,"Unable to boot in state: '@$state[0]'"] );
}
##################################
# Get command
##################################
$request->{op} = "on";
my $method = ( $state =~ /^on$/i ) ? "reset" : "powercmd";
##################################
# Get command form id
##################################
$id = $menu->{$cmds{$command}{$method}[0]};
##################################
# Run command
##################################
my $result = $cmds{$command}{$method}[1]( $exp, $request, $id );
return( $result );
}
##########################################################################
# Clears Error/Event Logs
##########################################################################
sub clear {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
##################################
# Get Error/Event Logs URL
##################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
##################################
# Clear all error/event log entries:
# Are you sure? (OK/Cancel)
##################################
my $form = HTML::Form->parse( $res->content, $res->base );
##################################
# Return error
##################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Error/Event Logs' form not found"] );
}
##################################
# Send Clear to JavaScript
##################################
my $request = $form->click( 'clear' );
$res = $ua->request( $request );
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets the number of Error/Event Logs entries specified
##########################################################################
sub entries {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $opt = $request->{opt};
my $count = (exists($opt->{e})) ? $opt->{e} : -1;
my $result;
my $i = 1;
##################################
# Get log entries
##################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
my @entries = split /\n/, $res->content;
##################################
# Prepend header
##################################
$result = (@entries) ?
"\n#Log ID Time Failing subsystem Severity SRC\n" :
"No entries";
##################################
# Parse log entries
##################################
foreach ( @entries ) {
if ( /tabindex=\d+><\/td><td>(.*)<\/td><td / ) {
my $values = $1;
$values =~ s/<\/td><td>/ /g;
$result.= "$values\n";
if ( $i++ == $count ) {
last;
}
}
}
return( [SUCCESS,$result] );
}
##########################################################################
# Gets/Sets system time of day
##########################################################################
sub time {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $value = $request->{method}{time};
##############################
# Send command
##############################
my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id );
my $Rc = shift(@$result);
##############################
# Return error
##############################
if ( $Rc != SUCCESS ) {
return( [$Rc,"Time: @$result[0]"] );
}
##############################
# Get time
##############################
if ( !defined( $value )) {
@$result[0] =~ /(\d+) (\d+) (\d+) $/;
return( [SUCCESS,sprintf( "Time: %02d:%02d:%02d UTC",$1,$2,$3 )] );
}
##############################
# Set time
##############################
my @t = split / /, @$result[0];
my @new = split /:/, $value;
splice( @t,3,3,@new );
##############################
# Send command
##############################
my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t );
my $Rc = shift(@$result);
return( [$Rc,"Time: @$result[0]"] );
}
##########################################################################
# Gets/Sets system date
##########################################################################
sub date {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $value = $request->{method}{date};
##############################
# Send command
##############################
my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id );
my $Rc = shift(@$result);
##############################
# Return error
##############################
if ( $Rc != SUCCESS ) {
return( [$Rc,"Date: @$result[0]"] );
}
##############################
# Get date
##############################
if ( !defined( $value )) {
@$result[0] =~ /^(\d+) (\d+) (\d+)/;
return( [SUCCESS,sprintf( "Date: %02d-%02d-%4d",$1,$2,$3 )] );
}
##############################
# Set date
##############################
my @t = split / /, @$result[0];
my @new = split /-/, $value;
splice( @t,0,3,@new );
##############################
# Send command
##############################
my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t );
my $Rc = shift(@$result);
return( [$Rc,"Date: @$result[0]"] );
}
##########################################################################
# Gets/Sets system time/date
##########################################################################
sub timeofday {
my $exp = shift;
my $request = shift;
my $id = shift;
my $d = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
######################################
# Get time/date
######################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content =~ /(only when the system is powered off)/ ) {
return( [RC_ERROR,$1] );
}
##################################
# Get "Power On/Off System" form
##################################
my $form = HTML::Form->parse( $res->content, $res->base );
##################################
# Return error
##################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Time Of Day' form not found"] );
}
######################################
# Get time/date fields
######################################
my $result;
my @option = qw(omo od oy oh omi os);
foreach ( @option ) {
if ( $res->content !~ /name='$_' value='(\d+)'/ ) {
return( [RC_ERROR,"Error getting time of day"] );
}
$result.= "$1 ";
}
######################################
# Return time/date
######################################
if ( !defined( $d )) {
return( [SUCCESS,$result] );
}
######################################
# Set time/date
######################################
my $res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
mo => @$d[0],
d => @$d[1],
y => @$d[2],
h => @$d[3],
mi => @$d[4],
s => @$d[5],
submit => "Save settings" ]
);
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content =~ /(not allowed.*\.|Invalid entry)/ ) {
return( [RC_ERROR,$1] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets/Sets I/O Adapter Enlarged Capacity
##########################################################################
sub iocap {
my $result = option( @_,"iocap" );
@$result[1] = "iocap: @$result[1]";
return( $result );
}
##########################################################################
# Gets/Sets Auto Power Restart
##########################################################
sub autopower {
my $result = option( @_,"autopower" );
@$result[1] = "autopower: @$result[1]";
return( $result );
}
##########################################################################
# Gets/Sets options
##########################################################################
sub option {
my $exp = shift;
my $request = shift;
my $id = shift;
my $menu = shift;
my $command = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $option = ($command =~ /^iocap$/) ? "pe" : "apor";
my $value = $request->{method}{$command};
######################################
# Get option URL
######################################
if ( !defined( $value )) {
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
##################################
# Return errors
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content !~ /selected value='\d+'>(\w+)</ ) {
return( [RC_ERROR,"Unknown"] );
}
return( [SUCCESS,$1] );
}
######################################
# Set option
######################################
my $res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
$option => ($value =~ /^disable$/i) ? "0" : "1",
submit => "Save settings" ]
);
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content !~ /Operation completed successfully/i ) {
return( [RC_ERROR,"Error setting option"] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets/Sets Memory Deconfiguration
##########################################################################
sub memdecfg {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $values = $request->{method}{memdecfg};
##################################
# Get settings
##################################
if ( !defined( $values )) {
return( readdecfg( $exp, $request, $id ));
}
##################################
# Set settings
##################################
$values =~ /^(configure|deconfigure):(\d+):(unit|bank):(all|[\d,]+)$/i;
return( writedecfg( $exp, $request, $id, $1, $2, $3, $4 ));
}
##########################################################################
# Gets/Sets Processor Deconfiguration
##########################################################################
sub procdecfg {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $values = $request->{method}{procdecfg};
##################################
# Get settings
##################################
if ( !defined( $values )) {
return( readdecfg( $exp, $request, $id ));
}
##################################
# Set settings
##################################
$values =~ /^(configure|deconfigure):(\d+):(all|[\d,]+)$/i;
return( writedecfg( $exp, $request, $id, $1, $2, "Processor ID",$3 ));
}
##########################################################################
# Sets Deconfiguration settings
##########################################################################
sub writedecfg {
my $exp = shift;
my $request = shift;
my $formid = shift;
my $state = shift;
my $unit = shift;
my $type = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
######################################
# Command-line parameter specified
######################################
my @ids = split /,/, $id;
my $select = ($state =~ /^configure$/i) ? 0 : 1;
######################################
# Get Deconfiguration URL
######################################
my $url = "https://$server/cgi-bin/cgi?form=$formid";
my $res = $ua->get( $url );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Find unit specified by user
######################################
my $html = $res->content;
my $value;
while ( $html =~
s/<input type=radio name=(\w+) value=(\w+)[^>]+><\/td><td>(\d+)<// ) {
if ( $unit eq $3 ) {
$value = $2;
}
}
if ( !defined( $value )) {
return( [RC_ERROR,"Processing unit=$unit not found"] );
}
######################################
# Get current settings
######################################
my $form = HTML::Form->parse( $res->content, $res->base );
my @inputs = $form->inputs();
######################################
# Return error
######################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Deconfiguration' form not found"] );
}
######################################
# Find radio button
######################################
my ($radio) = grep($_->{type} eq "radio", @inputs );
if ( !defined( $radio )) {
return( [RC_ERROR,"Radio button not found"] );
}
######################################
# Select radio button
######################################
$radio->value( $value );
######################################
# Send command
######################################
my $request = $form->click( "submit" );
$res = $ua->request( $request );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Get current settings
######################################
$form = HTML::Form->parse( $res->content, $res->base );
@inputs = $form->inputs();
######################################
# Return error
######################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Deconfiguration' form not found"] );
}
######################################
# Get options
######################################
my %options = ();
my %key = ();
my $setall = 0;
foreach ( @inputs ) {
if ( $_->type eq "option" ) {
push @{$options{$_->name}}, $_->value;
}
}
my @units = split /<thead align=left><tr><th>/, $res->content;
shift(@units);
my $html;
######################################
# Break into unit types
######################################
foreach ( @units ) {
/([\w\s]+)<\/th><th>/;
if ( $1 =~ /$type/i ) {
$html = $_;
last;
}
}
######################################
# Look for unit type
######################################
if ( !defined( $html )) {
return( [RC_ERROR,"unit=$unit '$type' not found"] );
}
######################################
# Set all IDs
######################################
if ( $ids[0] eq "all" ) {
@ids = ();
$setall = 1;
}
######################################
# Associate 'option' name with ID
######################################
foreach ( keys %options ) {
if ( $html =~ /\n<tr><td>(\d+)<\/td><td>.*name='$_'/ ) {
if ( $setall ) {
push @ids, $1;
}
push @{$options{$_}}, $1;
}
}
######################################
# Check if each specified ID exist
######################################
foreach ( @ids ) {
foreach my $name ( keys %options ) {
my $id = @{$options{$name}}[1];
if ( $_ eq $id ) {
my $value = @{$options{$name}}[0];
$key{$id} = [$value,$name];
}
}
}
######################################
# Check if ID exists
######################################
foreach ( @ids ) {
if ( !exists( $key{$_} )) {
return( [RC_ERROR,"Processing unit=$unit $type=$_ not found"] );
}
my $value = @{$key{$_}}[0];
if ( $value == $select ) {
delete $key{$_};
}
}
######################################
# Check in already in that state
######################################
if ( !scalar( keys %key )) {
return( [RC_ERROR,"All $type(s) specified already in '$state' state"]);
}
######################################
# Make changes to form
######################################
foreach ( keys %key ) {
my $name = @{$key{$_}}[1];
my ($button) = grep($_->{name} eq $name, @inputs );
if ( !defined( $button )) {
return( [RC_ERROR,"Option=$name not found"] );
}
$button->value( $select );
}
##################################
# Send command
##################################
my $request = $form->click( "submit" );
$res = $ua->request( $request );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content =~ /\n(.*Operation not allowed.*\.)/ ) {
my $result = $1;
$result =~ s/<br><br>/\n/g;
return( [RC_ERROR,$result] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets Deconfiguration settings
##########################################################################
sub readdecfg {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $result = "\n";
######################################
# Get Deconfiguration URL
######################################
my $url = "https://$server/cgi-bin/cgi?form=$id";
my $res = $ua->get( $url );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Get current settings
######################################
my $form = HTML::Form->parse( $res->content, $res->base );
my @inputs = $form->inputs();
my $html = $res->content;
my $unit;
######################################
# Return error
######################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Deconfiguration' form not found"] );
}
######################################
# Find radio button
######################################
my ($radio) = grep($_->{type} eq "radio", @inputs );
if ( !defined( $radio )) {
return( [RC_ERROR,"Radio button not found"] );
}
######################################
# Find unit identifier
######################################
if ( $html =~ /<thead align=left><tr><th><\/th><th>([\w\s]+)</ ) {
$unit = $1;
}
foreach ( @{$radio->{menu}} ) {
##################################
# Select radio button
##################################
my $value = ( ref($_) eq 'HASH' ) ? %$_->{value} : $_;
$radio->value( $value );
##################################
# Send command
##################################
my $request = $form->click( "submit" );
$res = $ua->request( $request );
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
$html = $res->content;
##################################
# Find unit identifier
##################################
if ( $html =~ /<p>([\w\s:]+)</ ) {
$result.= "$1\n";
}
my @group = split /<thead align=left><tr><th>/, $res->content;
shift(@group);
foreach ( @group ) {
my @maxlen = ();
my @values = ();
##############################
# Entry heading
##############################
/(.*)<\/th><\/tr><\/thead>/;
my @heading = split /<\/th><th>/, $1;
pop(@heading);
pop(@heading);
foreach ( @heading ) {
push @maxlen, length($_);
}
##############################
# Entry values
##############################
foreach ( split /\n/ ) {
if ( s/^<tr><td>// ) {
s/<br>/ /g;
my $i = 0;
my @d = split /<\/td><td>/;
pop(@d);
pop(@d);
######################
# Length formatting
######################
foreach ( @d ) {
if ( length($_) > $maxlen[$i] ) {
$maxlen[$i] = length($_);
}
$i++;
}
push @values, [@d];
}
}
##############################
# Output header
##############################
my $i = 0;
foreach ( @heading ) {
my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
$result.= sprintf( $format, $_ );
}
$result.= "\n";
##############################
# Output values
##############################
foreach ( @values ) {
$i = 0;
foreach ( @$_ ) {
my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
$result.= sprintf( $format, $_ );
}
$result.= "\n";
}
$result.= "\n";
}
}
return( [SUCCESS,$result] );
}
##########################################################################
# Gets/sets Deconfiguration Policies
##########################################################################
sub decfg {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $value = $request->{method}{decfg};
######################################
# Get Deconfiguration Policy URL
######################################
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
my %d = ();
my $len = 0;
my $i = 0;
my $html = $res->content;
my $result;
while ( $html =~ s/<br>(.*:)\s+<// ) {
my $desc = $1;
my $value = "unknown";
my $name;
##################################
# Get values
##################################
if ( $html =~ s/selected value='\d+'>(\w+)<// ) {
$value = $1;
}
##################################
# Get name
##################################
if ( $html =~ s/select name='(\w+)'// ) {
$name = $1;
}
##################################
# Save for formatting output
##################################
if ( length( $desc ) > $len ) {
$len = length( $desc );
}
$d{$desc} = [$value,$name];
}
######################################
# Get Deconfiguration Policy
######################################
if ( !defined( $value )) {
my $format = sprintf( "\n%%-%ds %%s",$len );
foreach ( keys %d ) {
$result.= sprintf( $format,$_,$d{$_}[0] );
}
return( [SUCCESS,$result] );
}
######################################
# Set Deconfiguration Policy
######################################
my ($op,$names) = split /:/, $value;
my @policy = split /,/, $names;
my $state = ($op =~ /^enable$/i) ? 0 : 1;
######################################
# Check for duplicate policies
######################################
foreach my $name ( @policy ) {
if ( grep( /^$name$/, @policy ) > 1 ) {
return( [RC_ERROR,"Duplicate policy specified: $name"] );
}
}
######################################
# Get Deconfiguration Policy form
######################################
my $form = HTML::Form->parse( $res->content, $res->base );
######################################
# Return error
######################################
if ( !defined( $form )) {
return( [RC_ERROR,"'Deconfiguration Policies' form not found"] );
}
######################################
# Get hidden inputs
######################################
my @inputs = $form->inputs();
my (@hidden) = grep( $_->{type} eq "hidden", @inputs );
if ( !defined( @hidden )) {
return( [RC_ERROR,"<input type='hidden'> not found"] );
}
######################################
# Check for invalid policies
######################################
foreach my $name ( @policy ) {
my @p = grep( $_->{value_name}=~/\b$name\b/i, @hidden );
if ( @p > 1 ) {
return( [RC_ERROR,"Ambiguous policy: $name"] );
} elsif ( !@p ) {
return( [RC_ERROR,"Invalid policy: $name"] );
}
my $value_name = $p[0]->{value_name};
$policy[$i++] = @{$d{$value_name}}[1];
}
######################################
# Select option
######################################
foreach my $name ( @policy ) {
my ($in) = grep( $_->{name} eq $name, @inputs );
$in->value( $state );
}
######################################
# Send command
######################################
my $request = $form->click( "submit" );
$res = $ua->request( $request );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Performs a System Dump
##########################################################################
sub sysdump {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
######################################
# Get Dump URL
######################################
my $url = "https://$server/cgi-bin/cgi?form=$id";
my $res = $ua->get( $url );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Possible errors:
# not allowed when a dump of this type exists.
# not allowed when system is powered off.
######################################
if ( $res->content =~ /(not allowed.*\.)/ ) {
return( [RC_ERROR,$1] );
}
my @d;
my $html = $res->content;
######################################
# Get current dump settings
######################################
foreach ( my $i=0; $i<3; $i++ ) {
if ( $html !~ s/selected value='(\d+)'// ) {
return( [RC_ERROR,"Error getting dump settings"] );
}
push @d, $1;
}
######################################
# Send dump command
######################################
$res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
policy => $d[0],
content => $d[1],
phyp => $d[2],
page => "1",
takedump => "Save settings and initiate dump" ]
);
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Continue ?
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
$res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
policy => $d[0],
content => $d[1],
phyp => $d[2],
page => "2",
takedump => "Save settings and initiate dump",
submit => "Continue"]
);
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Performs a Service Processor Dump
##########################################################################
sub spdump {
my $exp = shift;
my $request = shift;
my $id = shift;
my $ua = @$exp[0];
my $server = @$exp[1];
my $button = "Save settings and initiate dump";
my $dump_setting = 1;
######################################
# Get Dump URL
######################################
my $url = "https://$server/cgi-bin/cgi?form=$id";
my $res = $ua->get( $url );
######################################
# Return error
######################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
######################################
# Dump disabled - enable it
######################################
if ( $res->content =~ /selected value='0'>Disabled/ ) {
$res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
bdmp => "1",
save => "Save settings" ]
);
##################################
# Return error
##################################
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
if ( $res->content !~ /Operation completed successfully/ ) {
return( [RC_ERROR,"Error enabling dump setting"] );
}
##################################
# Get Dump URL again
##################################
$res = $ua->get( $url );
if ( !$res->is_success() ) {
return( [RC_ERROR,$res->status_line] );
}
##################################
# Restore setting after dump
##################################
$dump_setting = 0;
}
if ( $res->content !~ /$button/ ) {
return( [RC_ERROR,"'$button' button not found"] );
}
######################################
# We will lose conection after dump
######################################
$ua->timeout(5);
######################################
# Send dump command
######################################
$res = $ua->post( "https://$server/cgi-bin/cgi",
[ form => $id,
bdmp => $dump_setting,
dump => "Save settings and initiate dump" ]
);
######################################
# Will lose connection on success -500
######################################
if ( !$res->is_success() ) {
if ( $res->code ne "500" ) {
return( [RC_ERROR,$res->status_line] );
}
}
return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets all Error/Event Logs entries
##########################################################################
sub all {
return( entries(@_) );
}
##########################################################################
# Gets all Error/Event Logs entries then clears the logs
##########################################################################
sub all_clear {
my $result = entries( @_ );
clear( @_);
return( $result );
}
1;
Reference in New Issue View Git Blame Copy Permalink