# 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; use xCAT::PPCdb; use xCAT::MsgUtils qw(verbose_message); use xCAT::Utils; use xCAT::TableUtils; use xCAT::NetworkUtils; ########################################## # 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; my $flag = 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] = $request->{host}; $output{node}->[0]->{data}->[0]->{contents}->[0] = $server . ": " . @$_[1]; $output{node}->[0]->{cmd}->[0] = @$_[2]; $output{errorcode} = @$_[0]; push @outhash, \%output; } ##################################### # Disconnect from FSP ##################################### unless ($flag) { 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 = undef; if (($req->{dev} eq '1') or ($req->{command} eq 'rpower')) { my @cred_array = xCAT::PPCdb::credentials($server, $req->{hwtype}, "celogin"); $cred = \@cred_array; } else { $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 otherinterfaces)]); # if ( $hostshash ) { # $server = $hostshash->{ip}; # } #} $server = xCAT::NetworkUtils::getNodeIPaddress($server); unless ($server) { return ("Unable to get IP address for $server"); } # 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"); } sub loginstate { my $ua = shift; my $server = shift; my $log_name = shift; my $url = "https://$server/cgi-bin/cgi?form=4"; my $res = $ua->get($url); if (!$res->is_success()) { return ([ RC_ERROR, $res->status_line ]); } if ($res->content =~ m#[\d\D]+Status[\d\D]+$log_name]*>(\w+)#) { my $out = sprintf("%9s: %8s", $log_name, $1); return ([ SUCCESS, $out ]); } else { return ([ RC_ERROR, "not found status for $log_name" ]); } } 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()) { my @tmpres = (RC_ERROR, $res->status_line); my @rs; push @rs, \@tmpres; return (\@rs); } ################################## # 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)) { my @tmpres = (RC_ERROR, "Cannot find '$cmds{$command}{$_}[0]' menu"); my @rs; push @rs, \@tmpres; return (\@rs); } ################################## # Run command ################################## xCAT::MsgUtils->verbose_message($request, "$command :$_ for node:$server."); my $res = $cmds{$command}{$_}[1]($exp, $request, $form, \%menu); push @$res, $_; 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 ($i == 0) { if ($html !~ /Dump policy:\s+(\w+)/) { goto ERROR; } } if ($i != 0) { if ($html !~ s/selected value='(\d+)'//) { ERROR: 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 at parse" ]); } ################################## # 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 at submit" ]); } } elsif ($$form->find_input('submit', 'submit', 1)) { my $data = $$form->click('submit'); sleep 5; $res = $ua->request($data); $$form = HTML::Form->parse($res->content, $res->base); if (!defined($$form)) { return ([ RC_ERROR, "'Network Configuration' form not found at submit2" ]); } 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 at submit3" ]); } } } ####################################### # 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::NetworkUtils::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 { my @types = $interfaces->{$real_inc_name}->{'type'}->possible_values(); if ($inc_type eq 'Dynamic') { $interfaces->{$real_inc_name}->{'type'}->value(@types[0]); } else { $interfaces->{$real_inc_name}->{'type'}->value(@types[1]); } } #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 sleep 2; 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 !~ /content; 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;