git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@13136 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			2071 lines
		
	
	
		
			64 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			2071 lines
		
	
	
		
			64 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| # 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);
 | |
| 
 | |
| ##########################################
 | |
| # 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],
 | |
|      dev           => ["Service Processor Command Line",  \&devenable],
 | |
|      celogin1      => ["Service Processor Command Line",  \&ce1enable]},
 | |
| );
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # 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] = $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 
 | |
|     #####################################
 | |
|     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};
 | |
|         }
 | |
|     }
 | |
| #    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 ce1enable {
 | |
|     return &loginenable($_[0], $_[1], $_[2], "celogin1");
 | |
| }
 | |
| 
 | |
| sub devenable {
 | |
|     return &loginenable($_[0], $_[1], $_[2], "dev");
 | |
| }
 | |
| my %cmdline_for_log = (
 | |
|     dev => {
 | |
|         enable => "registry -Hw nets/DevEnabled 1",
 | |
|         disable => "registry -Hw nets/DevEnabled 0",
 | |
|         check_pwd => "registry -l DevPwdFile",
 | |
|         create_pwd => "netsDynPwdTool --create dev FipSdev",
 | |
|         password => "FipSdev"
 | |
|     },
 | |
|     celogin1 => {
 | |
|         enable => "registry -Hw nets/CE1Enabled 1",
 | |
|         disable => "registry -Hw nets/CE1Enabled 0",
 | |
|         check_pwd => "registry -l Ce1PwdFile",
 | |
|         create_pwd => "netsDynPwdTool --create celogin1 FipSce1",
 | |
|         password => "FipSce1"
 | |
|     },
 | |
|     );
 | |
| sub send_command {
 | |
|     my $ua     = shift;
 | |
|     my $server = shift;
 | |
|     my $id = shift;
 | |
|     my $log_name = shift;
 | |
|     my $cmd = shift;
 | |
|     my $cmd_line = $cmdline_for_log{$log_name}{$cmd};
 | |
|     if (!defined($cmd_line)) {
 | |
|         return undef;
 | |
|     }
 | |
|     my $res = $ua->post( "https://$server/cgi-bin/cgi",
 | |
|             [ form   => $id,
 | |
|             cmd   => $cmd_line,
 | |
|             submit => "Execute" ]
 | |
|             );
 | |
| 
 | |
|     if ( !$res->is_success() ) {
 | |
|         return undef;
 | |
|     }
 | |
|     if ( $res->content =~ /(not allowed.*\.|Invalid entry)/ ) {
 | |
|         return undef;
 | |
|     } 
 | |
|     return $res->content;
 | |
| }
 | |
| 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</td><td[^\>]*>(\w+)</td>#) {
 | |
|         my $out = sprintf("%9s: %8s", $log_name, $1);
 | |
|         return ( [SUCCESS, $out]);
 | |
|     } else {
 | |
|         return ( [RC_ERROR, "not found status for $log_name"]);
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub loginenable {
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $log_name = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     
 | |
|     my $value = $request->{method}{$log_name};
 | |
|     if (!defined($value)) {
 | |
|         return &loginstate($ua, $server, $log_name);
 | |
|        }
 | |
|     my $url = "https://$server/cgi-bin/cgi?form=$id";
 | |
|     my $res = $ua->get( $url );
 | |
|     if (!$res->is_success()) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
| 
 | |
|     $res = &send_command($ua, $server, $id, $log_name, $value);
 | |
|     if (!defined($res)) {
 | |
|         return ([RC_ERROR, "Send command Failed"]);
 | |
|     }
 | |
|     if ( $value =~ m/^disable$/ ) {
 | |
|         my $out = sprintf("%9s: Disabled", $log_name);
 | |
|         return( [SUCCESS, $out] );
 | |
|     }
 | |
| #check password#
 | |
|     $res = &send_command($ua, $server, $id, $log_name, "check_pwd");
 | |
|     if (!defined($res)) {
 | |
|         return ([RC_ERROR, "Send command Failed"]);
 | |
|     }
 | |
|     my $password = undef; 
 | |
|     if ($res =~ m/\[\d+([a-zA-Z]+)\d+\]/) {
 | |
|         $password = $1;
 | |
|     } else {
 | |
| # create password #
 | |
|         $res = &send_command($ua, $server, $id, $log_name, "create_pwd");
 | |
|         if (!defined($res)) {
 | |
|             return ([RC_ERROR, "Send command Failed"]);
 | |
|         }
 | |
|         $password = $cmdline_for_log{$log_name}{password};
 | |
|         print "create password for $log_name is '$cmdline_for_log{$log_name}{password}'\n";
 | |
|     }
 | |
|     my $out = sprintf("%9s:  Enabled, password: $password", $log_name);
 | |
|     return( [SUCCESS, $out] );
 | |
| }
 | |
| 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 
 | |
|         ##################################
 | |
|         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: (.*)<br>/) {
 | |
|         return( [SUCCESS,$1] );
 | |
|     }
 | |
|     return( [RC_ERROR,"unknown"] );    
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Powers FSP On/Off
 | |
| ##########################################################################
 | |
| sub powercmd {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $op      = $request->{op};
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
| 
 | |
|     ##################################
 | |
|     # Get Power On/Off System URL 
 | |
|     ##################################
 | |
|     my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
 | |
| 
 | |
|     ##################################
 | |
|     # Return error
 | |
|     ##################################
 | |
|     if ( !$res->is_success() ) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
|     ##################################
 | |
|     # Get current power state
 | |
|     ##################################
 | |
|     if ( $res->content !~ /Current system power state: (.*)<br>/) {
 | |
|         return( [RC_ERROR,"Unable to determine current power state"] );
 | |
|     }
 | |
|     my $state = $1;
 | |
| 
 | |
|     ##################################
 | |
|     # Already in that state
 | |
|     ##################################
 | |
|     if ( $op =~ /^$state$/i ) {
 | |
|         return( [SUCCESS,"Success"] );
 | |
|     }
 | |
|     ##################################
 | |
|     # Get "Power On/Off System" form 
 | |
|     ##################################
 | |
|     my $form = HTML::Form->parse( $res->content, $res->base );
 | |
| 
 | |
|     ##################################
 | |
|     # Return error
 | |
|     ##################################
 | |
|     if ( !defined( $form )) {
 | |
|         return( [RC_ERROR,"'Power On/Off System' form not found"] );
 | |
|     }
 | |
|     ##################################
 | |
|     # Get "Save and Submit" button
 | |
|     ##################################
 | |
|     my $button = ($op eq "on") ? "on" : "of"; 
 | |
|     my @inputs = $form->inputs();
 | |
| 
 | |
|     if ( !grep( $_->{name} eq $button, @inputs )) {
 | |
|         return( [RC_ERROR,"Unable to power $op from state: $state"] );
 | |
|     } 
 | |
|     ##################################
 | |
|     # Send command 
 | |
|     ##################################
 | |
|     my $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>(.*)<\/td><\/tr>/ ){
 | |
|             my $values = $2;
 | |
|             $values =~ s/<\/td><td>/  /g;
 | |
|             $result.= "$values\n";
 | |
| 
 | |
|             if ( $i++ == $count ) {
 | |
|                 last;
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     return( [SUCCESS,$result] );
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Gets/Sets system time of day 
 | |
| ##########################################################################
 | |
| sub time {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     my $value   = $request->{method}{time};
 | |
| 
 | |
|     ##############################
 | |
|     # Send command 
 | |
|     ##############################
 | |
|     my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id ); 
 | |
|     my $Rc = shift(@$result);
 | |
| 
 | |
|     ##############################
 | |
|     # Return error
 | |
|     ##############################
 | |
|     if ( $Rc != SUCCESS ) {
 | |
|         return( [$Rc,"Time: @$result[0]"] );
 | |
|     }
 | |
|     ##############################
 | |
|     # Get time
 | |
|     ##############################
 | |
|     if ( !defined( $value )) {
 | |
|         @$result[0] =~ /(\d+) (\d+) (\d+) $/; 
 | |
|         return( [SUCCESS,sprintf( "Time: %02d:%02d:%02d UTC",$1,$2,$3 )] );
 | |
|     }
 | |
|     ##############################
 | |
|     # Set time 
 | |
|     ##############################
 | |
|     my @t   = split / /, @$result[0];
 | |
|     my @new = split /:/, $value;
 | |
|     splice( @t,3,3,@new );
 | |
| 
 | |
|     ##############################
 | |
|     # Send command 
 | |
|     ##############################
 | |
|     my $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+)</ ) {
 | |
|             return( [RC_ERROR,"Unknown"] );
 | |
|         }
 | |
|         return( [SUCCESS,$1] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Set option
 | |
|     ######################################
 | |
|     my $res = $ua->post( "https://$server/cgi-bin/cgi",
 | |
|         [ form    => $id,
 | |
|           $option => ($value =~ /^disable$/i) ? "0" : "1",
 | |
|           submit  => "Save settings" ]
 | |
|     );
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !$res->is_success() ) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
|     if ( $res->content !~ /Operation completed successfully/i ) {
 | |
|         return( [RC_ERROR,"Error setting option"] );
 | |
|     }
 | |
|     return( [SUCCESS,"Success"] );
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Gets/Sets Memory Deconfiguration
 | |
| ##########################################################################
 | |
| sub memdecfg {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     my $values  = $request->{method}{memdecfg};
 | |
| 
 | |
|     ##################################
 | |
|     # Get settings
 | |
|     ##################################
 | |
|     if ( !defined( $values )) {
 | |
|         return( readdecfg( $exp, $request, $id ));
 | |
|     }
 | |
|     ##################################
 | |
|     # Set settings
 | |
|     ##################################
 | |
|     $values =~ /^(configure|deconfigure):(\d+):(unit|bank):(all|[\d,]+)$/i;
 | |
|     return( writedecfg( $exp, $request, $id, $1, $2, $3, $4 ));
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Gets/Sets Processor Deconfiguration
 | |
| ##########################################################################
 | |
| sub procdecfg {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     my $values  = $request->{method}{procdecfg};
 | |
| 
 | |
|     ##################################
 | |
|     # Get settings
 | |
|     ##################################
 | |
|     if ( !defined( $values )) {
 | |
|         return( readdecfg( $exp, $request, $id ));
 | |
|     }
 | |
|     ##################################
 | |
|     # Set settings
 | |
|     ##################################
 | |
|     $values =~ /^(configure|deconfigure):(\d+):(all|[\d,]+)$/i;
 | |
|     return( writedecfg( $exp, $request, $id, $1, $2, "Processor ID",$3 ));
 | |
| }
 | |
| 
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Sets Deconfiguration settings
 | |
| ##########################################################################
 | |
| sub writedecfg {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $formid  = shift;
 | |
|     my $state   = shift;
 | |
|     my $unit    = shift;
 | |
|     my $type    = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
| 
 | |
|     ######################################
 | |
|     # Command-line parameter specified 
 | |
|     ######################################
 | |
|     my @ids    = split /,/, $id;
 | |
|     my $select = ($state =~ /^configure$/i) ? 0 : 1; 
 | |
| 
 | |
|     ######################################
 | |
|     # Get Deconfiguration URL
 | |
|     ######################################
 | |
|     my $url = "https://$server/cgi-bin/cgi?form=$formid";
 | |
|     my $res = $ua->get( $url );
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !$res->is_success() ) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Find unit specified by user 
 | |
|     ######################################
 | |
|     my $html = $res->content;
 | |
|     my $value;
 | |
| 
 | |
|     while ( $html =~
 | |
|        s/<input type=radio name=(\w+) value=(\w+)[^>]+><\/td><td>(\d+)<// ) {
 | |
|        if ( $unit eq $3 ) {
 | |
|            $value = $2;
 | |
|        }
 | |
|     }
 | |
|     if ( !defined( $value )) {
 | |
|         return( [RC_ERROR,"Processing unit=$unit not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Get current settings
 | |
|     ######################################
 | |
|     my $form = HTML::Form->parse( $res->content, $res->base );
 | |
|     my @inputs = $form->inputs();
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !defined( $form )) {
 | |
|         return( [RC_ERROR,"'Deconfiguration' form not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Find radio button
 | |
|     ######################################
 | |
|     my ($radio) = grep($_->{type} eq "radio", @inputs );
 | |
|     if ( !defined( $radio )) {
 | |
|         return( [RC_ERROR,"Radio button not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Select radio button
 | |
|     ######################################
 | |
|     $radio->value( $value );
 | |
| 
 | |
|     ######################################
 | |
|     # Send command
 | |
|     ######################################
 | |
|     my $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 /<thead align=left><tr><th>/, $res->content;
 | |
|     shift(@units);
 | |
|     $html = undef;
 | |
| 
 | |
|     ######################################
 | |
|     # Break into unit types 
 | |
|     ######################################
 | |
|     foreach ( @units ) {
 | |
|         /([\w\s]+)<\/th><th>/;
 | |
|         if ( $1 =~ /$type/i ) {
 | |
|             $html = $_;
 | |
|             last;
 | |
|         }
 | |
|     }
 | |
|     ######################################
 | |
|     # Look for unit type 
 | |
|     ######################################
 | |
|     if ( !defined( $html )) {
 | |
|         return( [RC_ERROR,"unit=$unit '$type' not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Set all IDs 
 | |
|     ######################################
 | |
|     if ( $ids[0] eq "all" ) {
 | |
|        @ids = ();
 | |
|        $setall = 1;
 | |
|     }
 | |
|     ######################################
 | |
|     # Associate 'option' name with ID 
 | |
|     ######################################
 | |
|     foreach ( keys %options ) {
 | |
|         if ( $html =~ /\n<tr><td>(\d+)<\/td><td>.*name='$_'/ ) {
 | |
|             if ( $setall ) {
 | |
|                 push @ids, $1;
 | |
|             }
 | |
|             push @{$options{$_}}, $1;
 | |
|         }
 | |
|     }
 | |
|     ######################################
 | |
|     # Check if each specified ID exist 
 | |
|     ######################################
 | |
|     foreach ( @ids ) {
 | |
|         foreach my $name ( keys %options ) {
 | |
|             my $id = @{$options{$name}}[1];
 | |
|             
 | |
|             if ( $_ eq $id ) {
 | |
|                 my $value = @{$options{$name}}[0];
 | |
|                 $key{$id} = [$value,$name];
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     ######################################
 | |
|     # Check if ID exists 
 | |
|     ######################################
 | |
|     foreach ( @ids ) {
 | |
|         if ( !exists( $key{$_} )) {
 | |
|             return( [RC_ERROR,"Processing unit=$unit $type=$_ not found"] );
 | |
|         }
 | |
|         my $value = @{$key{$_}}[0];
 | |
|         if ( $value == $select ) {
 | |
|            delete $key{$_};
 | |
|         }
 | |
|     }
 | |
|     ######################################
 | |
|     # Check in already in that state 
 | |
|     ######################################
 | |
|     if ( !scalar( keys %key )) {
 | |
|         return( [RC_ERROR,"All $type(s) specified already in '$state' state"]); 
 | |
|     } 
 | |
|     ######################################
 | |
|     # Make changes to form  
 | |
|     ######################################
 | |
|     foreach ( keys %key ) {
 | |
|         my $name = @{$key{$_}}[1];
 | |
|         my ($button) = grep($_->{name} eq $name, @inputs );
 | |
|         if ( !defined( $button )) {
 | |
|             return( [RC_ERROR,"Option=$name not found"] );
 | |
|         }
 | |
|         $button->value( $select );
 | |
|     }
 | |
|     ##################################
 | |
|     # Send command
 | |
|     ##################################
 | |
|     $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/<br><br>/\n/g;
 | |
|         return( [RC_ERROR,$result] ); 
 | |
|     }
 | |
|     return( [SUCCESS,"Success"] );       
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Gets Deconfiguration settings
 | |
| ##########################################################################
 | |
| sub readdecfg {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     my $result  = "\n";
 | |
| 
 | |
|     ######################################
 | |
|     # Get Deconfiguration URL
 | |
|     ######################################
 | |
|     my $url = "https://$server/cgi-bin/cgi?form=$id";
 | |
|     my $res = $ua->get( $url );
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !$res->is_success() ) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Get current settings
 | |
|     ######################################
 | |
|     my $form = HTML::Form->parse( $res->content, $res->base );
 | |
|     my @inputs = $form->inputs();
 | |
|     my $html   = $res->content;
 | |
|     my $unit;
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !defined( $form )) {
 | |
|         return( [RC_ERROR,"'Deconfiguration' form not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Find radio button
 | |
|     ######################################
 | |
|     my ($radio) = grep($_->{type} eq "radio", @inputs );
 | |
|     if ( !defined( $radio )) {
 | |
|         return( [RC_ERROR,"Radio button not found"] ); 
 | |
|     }
 | |
|     ######################################
 | |
|     # Find unit identifier
 | |
|     ######################################
 | |
|     if ( $html =~ /<thead align=left><tr><th><\/th><th>([\w\s]+)</ ) {
 | |
|         $unit = $1;
 | |
|     }
 | |
|     foreach ( @{$radio->{menu}} ) {
 | |
|         ##################################
 | |
|         # Select radio button
 | |
|         ##################################
 | |
|         my $value = ( ref($_) eq 'HASH' ) ? $_->{value} : $_;
 | |
|         $radio->value( $value );
 | |
| 
 | |
|         ##################################
 | |
|         # Send command
 | |
|         ##################################
 | |
|         my $request = $form->click( "submit" );
 | |
|         $res = $ua->request( $request );
 | |
| 
 | |
|         ##################################
 | |
|         # Return error
 | |
|         ##################################
 | |
|         if ( !$res->is_success() ) {
 | |
|             return( [RC_ERROR,$res->status_line] );
 | |
|         }
 | |
|         $html = $res->content;
 | |
| 
 | |
|         ##################################
 | |
|         # Find unit identifier
 | |
|         ##################################
 | |
|         if ( $html =~ /<p>([\w\s:]+)</ ) {
 | |
|             $result.= "$1\n";
 | |
|         }   
 | |
|         my @group = split /<thead align=left><tr><th>/, $res->content;
 | |
|         shift(@group);
 | |
| 
 | |
|         foreach ( @group ) {
 | |
|             my @maxlen = ();
 | |
|             my @values = ();
 | |
| 
 | |
|             ##############################
 | |
|             # Entry heading
 | |
|             ##############################
 | |
|             /(.*)<\/th><\/tr><\/thead>/;
 | |
|             my @heading = split /<\/th><th>/, $1;
 | |
|             pop(@heading);
 | |
|             pop(@heading);
 | |
| 
 | |
|             foreach ( @heading ) {
 | |
|                 push @maxlen, length($_);
 | |
|             }
 | |
|             ##############################
 | |
|             # Entry values
 | |
|             ##############################
 | |
|             foreach ( split /\n/ ) {
 | |
|                 if ( s/^<tr><td>// ) {
 | |
|                     s/<br>/ /g;
 | |
| 
 | |
|                     my $i = 0;
 | |
|                     my @d = split /<\/td><td>/;
 | |
|                     pop(@d);
 | |
|                     pop(@d);
 | |
| 
 | |
|                     ######################
 | |
|                     # Length formatting
 | |
|                     ######################
 | |
|                     foreach ( @d ) {
 | |
|                         if ( length($_) > $maxlen[$i] ) {
 | |
|                             $maxlen[$i] = length($_);
 | |
|                         }
 | |
|                         $i++;
 | |
|                     }
 | |
|                     push @values, [@d];
 | |
|                 }
 | |
|             }
 | |
|             ##############################
 | |
|             # Output header
 | |
|             ##############################
 | |
|             my $i = 0;
 | |
|             foreach ( @heading ) {
 | |
|                 my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
 | |
|                 $result.= sprintf( $format, $_ );
 | |
|             }
 | |
|             $result.= "\n";
 | |
| 
 | |
|             ##############################
 | |
|             # Output values
 | |
|             ##############################
 | |
|             foreach ( @values ) {
 | |
|                 $i = 0;
 | |
|                 foreach ( @$_ ) {
 | |
|                     my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
 | |
|                     $result.= sprintf( $format, $_ );
 | |
|                 }
 | |
|                 $result.= "\n";
 | |
|             }
 | |
|             $result.= "\n";
 | |
|         }
 | |
|     }
 | |
|     return( [SUCCESS,$result] );
 | |
| }
 | |
| 
 | |
| 
 | |
| ##########################################################################
 | |
| # Gets/sets Deconfiguration Policies
 | |
| ##########################################################################
 | |
| sub decfg {
 | |
| 
 | |
|     my $exp     = shift;
 | |
|     my $request = shift;
 | |
|     my $id      = shift;
 | |
|     my $ua      = @$exp[0];
 | |
|     my $server  = @$exp[1];
 | |
|     my $value   = $request->{method}{decfg};
 | |
| 
 | |
|     ######################################
 | |
|     # Get Deconfiguration Policy URL
 | |
|     ######################################
 | |
|     my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !$res->is_success() ) {
 | |
|         return( [RC_ERROR,$res->status_line] );
 | |
|     }
 | |
|     my %d    = ();
 | |
|     my $len  = 0;
 | |
|     my $i    = 0;
 | |
|     my $html = $res->content;
 | |
|     my $result;
 | |
| 
 | |
|     while ( $html =~ s/<br>(.*:)\s+<// ) {
 | |
|         my $desc  = $1;
 | |
|         my $value = "unknown";
 | |
|         my $name;
 | |
| 
 | |
|         ##################################
 | |
|         # Get values
 | |
|         ##################################
 | |
|         if ( $html =~ s/selected value='\d+'>(\w+)<// ) {
 | |
|             $value = $1;
 | |
|         }
 | |
|         ##################################
 | |
|         # Get name 
 | |
|         ##################################
 | |
|         if ( $html =~ s/select name='(\w+)'// ) {
 | |
|             $name = $1;
 | |
|         }
 | |
|         ##################################
 | |
|         # Save for formatting output 
 | |
|         ##################################
 | |
|         if ( length( $desc ) > $len ) {
 | |
|             $len = length( $desc );
 | |
|         }
 | |
|         $d{$desc} = [$value,$name];
 | |
|     }
 | |
| 
 | |
|     ######################################
 | |
|     # Get Deconfiguration Policy
 | |
|     ######################################
 | |
|     if ( !defined( $value )) {
 | |
|         my $format = sprintf( "\n%%-%ds %%s",$len );
 | |
|         foreach ( keys %d ) {
 | |
|             $result.= sprintf( $format,$_,$d{$_}[0] );
 | |
|         }
 | |
|         return( [SUCCESS,$result] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Set Deconfiguration Policy
 | |
|     ######################################
 | |
|     my ($op,$names) = split /:/, $value;
 | |
|     my @policy      = split /,/, $names;
 | |
|     my $state       = ($op =~ /^enable$/i) ? 0 : 1;
 | |
| 
 | |
|     ######################################
 | |
|     # Check for duplicate policies
 | |
|     ######################################
 | |
|     foreach my $name ( @policy ) {
 | |
|         if ( grep( /^$name$/, @policy ) > 1 ) {
 | |
|             return( [RC_ERROR,"Duplicate policy specified: $name"] );
 | |
|         }
 | |
|     }
 | |
|     ######################################
 | |
|     # Get Deconfiguration Policy form 
 | |
|     ######################################
 | |
|     my $form = HTML::Form->parse( $res->content, $res->base );
 | |
| 
 | |
|     ######################################
 | |
|     # Return error
 | |
|     ######################################
 | |
|     if ( !defined( $form )) {
 | |
|         return( [RC_ERROR,"'Deconfiguration Policies' form not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Get hidden inputs 
 | |
|     ######################################
 | |
|     my @inputs = $form->inputs();
 | |
| 
 | |
|     my (@hidden) = grep( $_->{type} eq "hidden", @inputs );
 | |
|     if ( !@hidden ) {
 | |
|         return( [RC_ERROR,"<input type='hidden'> not found"] );
 | |
|     }
 | |
|     ######################################
 | |
|     # Check for invalid policies
 | |
|     ######################################
 | |
|     foreach my $name ( @policy ) {
 | |
|         my @p = grep( $_->{value_name}=~/\b$name\b/i, @hidden );
 | |
| 
 | |
|         if ( @p > 1 ) {
 | |
|             return( [RC_ERROR,"Ambiguous policy: $name"] );
 | |
|         } elsif ( !@p ) {
 | |
|             return( [RC_ERROR,"Invalid policy: $name"] );
 | |
|         }
 | |
|         my $value_name = $p[0]->{value_name};
 | |
|         $policy[$i++] = @{$d{$value_name}}[1]; 
 | |
|     }
 | |
|     ######################################
 | |
|     # Select option 
 | |
|     ######################################
 | |
|     foreach my $name ( @policy ) {
 | |
|         my ($in) = grep( $_->{name} eq $name, @inputs );
 | |
|         $in->value( $state );
 | |
|     }
 | |
|     ######################################
 | |
|     # Send command
 | |
|     ######################################
 | |
|     my $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"] );
 | |
|     } 
 | |
| 
 | |
|     ##################################
 | |
|     # 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"] );
 | |
|         } 
 | |
|    } elsif ( $$form->find_input('submit', 'submit', 1) ) {
 | |
|         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
 | |
|         {
 | |
|             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
 | |
|     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 !~ /<input type=\'submit\'/) #If there is no submit button,get the error message and return
 | |
|     {
 | |
|         my @page_lines = split /\n/, $res->content;
 | |
|         my @lines_to_print;
 | |
|         for my $page_line (@page_lines)
 | |
|         {
 | |
|             chomp $page_line;
 | |
|             if ( $page_line =~ s/<br>$//)
 | |
|             {
 | |
|                 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;
 | |
| 
 |