git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@13601 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			2084 lines
		
	
	
		
			65 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			2084 lines
		
	
	
		
			65 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);
 | 
						|
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],
 | 
						|
     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;
 | 
						|
    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};
 | 
						|
        }
 | 
						|
    }
 | 
						|
#    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() ) {
 | 
						|
        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: (.*)<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 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 !~ /<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;
 | 
						|
 |