# 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; use Socket; ########################################## # 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], network => ["Network Configuration", \&netcfg]}, ); ########################################################################## # 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: $!" ); } } $IO::Socket::SSL::VERSION = undef; eval { require Net::SSL }; ################################## # 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 $hosttab = xCAT::Table->new( 'hosts' ); if ( $hosttab) { my $hostshash = $hosttab->getNodeAttribs( $server, [qw(ip)]); if ( $hostshash ) { $server = $hostshash->{ip}; } } # my $serverip = inet_ntoa(inet_aton($server)); 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 . ". Please check node attribute hcp and its password settings."); } 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: (.*)
/) { 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: (.*)
/) { 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 $data = $form->click( $button ); $res = $ua->request( $data ); ################################## # 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 $data = $form->click( 'clear' ); $res = $ua->request( $data ); 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><\/tr>/ ){ my $values = $2; $values =~ s/<\/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 $time = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t ); $Rc = shift(@$time); return( [$Rc,"Time: @$time[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 $date = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t ); $Rc = shift(@$date); return( [$Rc,"Date: @$date[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 ###################################### $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+)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/]+><\/td>(\d+)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 $data = $form->click( "submit" ); $res = $ua->request( $data ); ###################################### # 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 //, $res->content; shift(@units); $html = undef; ###################################### # Break into unit types ###################################### foreach ( @units ) { /([\w\s]+)<\/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(\d+)<\/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 ################################## $data = $form->click( "submit" ); $res = $ua->request( $data ); ################################## # Return error ################################## if ( !$res->is_success() ) { return( [RC_ERROR,$res->status_line] ); } if ( $res->content =~ /\n(.*Operation not allowed.*\.)/ ) { my $result = $1; $result =~ s/

/\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 =~ /<\/th>([\w\s]+){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 =~ /

([\w\s:]+)/, $res->content; shift(@group); foreach ( @group ) { my @maxlen = (); my @values = (); ############################## # Entry heading ############################## /(.*)<\/th><\/tr><\/thead>/; my @heading = split /<\/th>/, $1; pop(@heading); pop(@heading); foreach ( @heading ) { push @maxlen, length($_); } ############################## # Entry values ############################## foreach ( split /\n/ ) { if ( s/^// ) { s/
/ /g; my $i = 0; my @d = split /<\/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/
(.*:)\s+(\w+) $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 ( !@hidden ) { return( [RC_ERROR," 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 $data = $form->click( "submit" ); $res = $ua->request( $data ); ###################################### # 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/ ) { ################################################################# # For some firmware levels, button is changed to "initiate dump" ################################################################# $button = "Initiate dump"; if ( $res->content !~ /$button/ ) { return( [RC_ERROR,"'$button' button not found"] ); } } ###################################### # We will lose conection after dump ###################################### $ua->timeout(10); ###################################### # Send dump command ###################################### $res = $ua->post( "https://$server/cgi-bin/cgi", [ form => $id, bdmp => $dump_setting, dump => $button ] ); ###################################### # 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 ); } ########################################################################## # Gets and set network configuration ########################################################################## sub netcfg { my $exp = shift; my $request = shift; my $id = shift; ###################################### # Parsing arg ###################################### my $set_config = 0; my ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask) = (); my $real_inc_name = undef; if ( $request->{'method'}->{'network'}) { $set_config = 1; } my $interfaces = undef; my $form = undef; my $res = get_netcfg( $exp, $request, $id, \$interfaces, \$form); return $res if ( $res->[0] == RC_ERROR); my $output = ""; ####################################### # Set configuration ####################################### if ( $set_config) { return set_netcfg( $exp, $request, $interfaces, $form); } ####################################### # Get configuration and format output ####################################### else { return format_netcfg( $interfaces); } } ########################################################################## # Gets network configuration ########################################################################## sub get_netcfg { my $exp = shift; my $request = shift; my $id = shift; my $interfaces = shift; my $form = shift; my $ua = @$exp[0]; my $server = @$exp[1]; ###################################### # Get Network Configuration 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 "Network Configuraiton" form ################################## $$form = HTML::Form->parse( $res->content, $res->base ); ################################## # Return error ################################## if ( !defined( $$form )) { return( [RC_ERROR,"'Network Configuration' form not found"] ); } ################################## # For some P6 machines ################################## if ( $$form->find_input('ip', 'radio', 1)) { my $ipv4Radio = $$form->find_input('ip', 'radio', 1); if (!$ipv4Radio) { print "Cannot find IPv4 option\n"; exit; } #$ipv4Radio->check(); my $data = $$form->click('submit'); $res = $ua->request( $data); $$form = HTML::Form->parse( $res->content, $res->base ); if ( !defined( $$form )) { return( [RC_ERROR,"'Network Configuration' form not found"] ); } } else { my $data = $$form->click('submit'); $res = $ua->request( $data); $$form = HTML::Form->parse( $res->content, $res->base ); if ( !defined( $$form )) { return( [RC_ERROR,"'Network Configuration' form not found' form not found"] ); } if ( $$form->find_input('ip', 'radio', 1)) { my $ipv4Radio = $$form->find_input('ip', 'radio', 1); if (!$ipv4Radio) { print "Cannot find IPv4 option\n"; exit; } #$ipv4Radio->check(); my $data = $$form->click('submit'); $res = $ua->request( $data); $$form = HTML::Form->parse( $res->content, $res->base ); if ( !defined( $$form )) { return( [RC_ERROR,"'Network Configuration' form not found"] ); } } } ####################################### # Parse the form to get the inc input ####################################### my $has_found_all = 0; my $i = 0; while ( not $has_found_all) { my $input = $$form->find_input( "interface$i", 'checkbox'); if ( ! $input) { $has_found_all = 1; } else { $$interfaces->{"interface$i"}->{'selected'} = $input; $$interfaces->{"interface$i"}->{'type'} = $$form->find_input("ip$i", 'option'); $$interfaces->{"interface$i"}->{'hostname'} = $$form->find_input("host$i", 'text'); $$interfaces->{"interface$i"}->{'ip'} = $$form->find_input("static_ip$i", 'text'); $$interfaces->{"interface$i"}->{'gateway'} = $$form->find_input("gateway$i", 'text'); $$interfaces->{"interface$i"}->{'netmask'} = $$form->find_input("subnet$i", 'text'); #we do not support dns yet, just in case of future support $$interfaces->{"interface$i"}->{'dns0'} = $$form->find_input("dns0$i", 'text'); $$interfaces->{"interface$i"}->{'dns1'} = $$form->find_input("dns1$i", 'text'); $$interfaces->{"interface$i"}->{'dns2'} = $$form->find_input("dns2$i", 'text'); $i++; } } return ( [RC_ERROR,"Cannot find any network interface on $server"]) if ( ! $$interfaces); return ( [SUCCESS, undef]); } ########################################################################## # Set network configuration ########################################################################## sub set_netcfg { my $exp = shift; my $request = shift; my $interfaces = shift; my $form = shift; my $ua = @$exp[0]; my $real_inc_name; my ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask) = split /,/, $request->{'method'}->{'network'}; chomp ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask); if ( $inc_name =~ /^eth(\d)$/) { $real_inc_name = "interface$1"; } elsif ( $inc_name =~/(\d+)\.(\d+)\.(\d+)\.(\d+)/) { for my $inc (keys %$interfaces) { if ($interfaces->{ $inc}->{'ip'}->value() eq $inc_name) { $real_inc_name = $inc; last; } } } else { return( [RC_ERROR, "Incorrect network interface name $inc_name"] ); } return ( [RC_ERROR,"Cannot find interface $inc_name"]) if ( ! exists ($$interfaces{ $real_inc_name})); my $inc_type; my @set_entries = (); if ( $inc_ip eq '0.0.0.0') { $inc_type = 'Dynamic'; push @set_entries, 'IP type to dynamic.'; } elsif ( $inc_ip eq '*') { $inc_type = 'Static'; ($inc_ip, $inc_host, $inc_gateway, $inc_netmask) = xCAT::Utils::getNodeNetworkCfg(@$exp[1]); } else { $inc_type = 'Static'; } #not work on AIX # $interfaces->{ $real_inc_name}->{'selected'}->check(); my @tmp_options = $interfaces->{ $real_inc_name}->{'selected'}->possible_values(); $interfaces->{ $real_inc_name}->{'selected'}->value(@tmp_options[1] ); if ( $interfaces->{ $real_inc_name}->{'type'}) { my @type_options = @{$interfaces->{ $real_inc_name}->{'type'}->{'menu'}}; if (ref( $type_options[0]) eq 'HASH') { for my $typeopt ( @type_options) { if ( $typeopt->{'name'} eq $inc_type) { $interfaces->{ $real_inc_name}->{'type'}->value($typeopt->{'value'}); last; } } } else #AIX made the things more complicated, it didn't ship the #last HTML::Form. So let's take a guess of the type value #Not sure if it can work for all AIX version { if ( $inc_type eq 'Dynamic') { $interfaces->{ $real_inc_name}->{'type'}->value(1); } else { $interfaces->{ $real_inc_name}->{'type'}->value(0); } } #not work on AIX # $interfaces->{ $real_inc_name}->{'type'}->value('Static'); } else { return ( [RC_ERROR,"Cannot change interface type"]); } if ( $inc_type eq 'Static') { if ( $inc_ip) { return ( [RC_ERROR,"Cannot set IP address to $inc_ip"]) if (! $interfaces->{ $real_inc_name}->{'ip'}); $interfaces->{ $real_inc_name}->{'ip'}->value( $inc_ip); push @set_entries, 'IP address'; } if ( $inc_host) { return ( [RC_ERROR,"Cannot set hostname to $inc_host"]) if (! $interfaces->{ $real_inc_name}->{'hostname'}); $interfaces->{ $real_inc_name}->{'hostname'}->value( $inc_host); push @set_entries, 'hostname'; if( ! $interfaces->{ $real_inc_name}->{'hostname'}->value()) { $inc_host = $exp->[1]; } } if ( $inc_gateway) { return ( [RC_ERROR,"Cannot set gateway to $inc_gateway"]) if (! $interfaces->{ $real_inc_name}->{'gateway'}); $interfaces->{ $real_inc_name}->{'gateway'}->value( $inc_gateway); push @set_entries, 'gateway'; } if ( $inc_netmask) { return ( [RC_ERROR,"Cannot set netmask to $inc_netmask"]) if (! $interfaces->{ $real_inc_name}->{'netmask'}); $interfaces->{ $real_inc_name}->{'netmask'}->value( $inc_netmask); push @set_entries, 'netmask'; } } #Click "Continue" button my $data = $form->click('save'); my $res = $ua->request( $data); if (!$res->is_success()) { return ( [RC_ERROR, "Failed to set " . join ',', @set_entries]); } #Go to the confirm page if ( $res->content !~ /\Qcontent; my @lines_to_print; for my $page_line (@page_lines) { chomp $page_line; if ( $page_line =~ s/
$//) { push @lines_to_print, $page_line; } } return ( [RC_ERROR,join "\n", @lines_to_print]); } $ua->timeout( 2 ); $form = HTML::Form->parse( $res->content, $res->base ); $data = $form->click('submit'); $res = $ua->request( $data); ############################################################## # We cannot get the result of this update, since the network # is updated, the old URI is invalid anymore # Return success directory ############################################################## return ( [SUCCESS, "Success to set " . join ',', @set_entries]); } ########################################################################## # Format the output of network configuration ########################################################################## sub format_netcfg { my $interfaces = shift; my $output = undef; for my $inc ( sort keys %$interfaces) { #improve needed: need to make the output consistent to MM $output .= "\n\t" . $inc . ":\n"; $output =~ s/interface(\d)/eth$1/; # There are 2 possible value for $type, # the first means "Dynamic", 2nd means "Static" # Now to find the correct type name my $curr_type = $interfaces->{$inc}->{'type'}->value(); my @possible_values = $interfaces->{$inc}->{'type'}->possible_values(); my $type; if ($curr_type == @possible_values[0]) { $type = "Dynamic"; } else { $type = "Static"; } #not work on AIX #my @possible_names = $interfaces->{$inc}->{'type'}->value_names(); #my %value_names = {}; #for ( my $i = 0; $i < scalar( @possible_values); $i++) #{ # $value_names{ @possible_values[$i]} = @possible_names[$i]; #} #my $type = $interfaces->{$inc}->{'type'} ? $value_names{ $interfaces->{$inc}->{'type'}->value()} : undef;; $type = "Static" if ( $type == 2); my $ip = $interfaces->{$inc}->{'ip'} ? $interfaces->{$inc}->{'ip'}->value() : undef; my $hostname = $interfaces->{$inc}->{'hostname'} ? $interfaces->{$inc}->{'hostname'}->value() : undef; my $gateway = $interfaces->{$inc}->{'gateway'} ? $interfaces->{$inc}->{'gateway'}->value() : undef; my $netmask = $interfaces->{$inc}->{'netmask'} ? $interfaces->{$inc}->{'netmask'}->value() : undef; $output .= "\t\tIP Type: " . $type . "\n"; $output .= "\t\tIP Address: " . $ip . "\n"; $output .= "\t\tHostname: " . $hostname . "\n"; $output .= "\t\tGateway: " . $gateway . "\n"; $output .= "\t\tNetmask: " . $netmask . "\n"; } return( [SUCCESS,$output] ); } 1;