# 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 = $req->{$server}{cred}; ################################## # 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;