xcat-core/perl-xCAT-2.0/xCAT/PPCfsp.pm

# 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);


##########################################
# 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] },
  rfsp => {
     memdecfg      => ["Memory Deconfiguration",        \&memdecfg],
     decfg         => ["Deconfiguration Policies",      \&decfg],
     procdecfg     => ["Processor Deconfiguration",     \&procdecfg],
     iocap         => ["I/O Adapter Enlarged Capacity", \&iocap],
     time          => ["Time Of Day",                   \&time], 
     date          => ["Time Of Day",                   \&date], 
     autopower     => ["Auto Power Restart",            \&autopower],
     sysdump       => ["System Dump",                   \&sysdump],
     spdump        => ["Service Processor Dump",        \&spdump] },
);


##########################################################################
# Parse the command line for options and operands
##########################################################################
sub parse_args {

    my $request = shift;
    my $command = $request->{command};
    my @rsp     = keys %{$cmds{$command}};
    my $args    = $request->{arg};
    my $cmd     = join( '|',@rsp );
    my %opt     = ();
    my @VERSION = qw( 2.0 );
 
    #############################################
    # Modify usage statement 
    #############################################
    my $option = "configure|deconfigure";
    $cmd =~ s/spdump/\n\t spdump/;
    $cmd =~ s/sysdump/\n\t sysdump/;
    $cmd =~ s/time/\n\t time [hh:mm:ss]/;
    $cmd =~ s/date/\n\t date [mm-dd-yyyy]/;
    $cmd =~ s/autopower/\n\t autopower [enable|disable]/;
    $cmd =~ s/iocap/\n\t iocap [enable|disable]/;
    $cmd =~ s/decfg/\n\t decfg [enable|disable policy,...]/;
    $cmd =~ s/memdecfg/\n\t memdecfg [$option unit=id (unit|bank)=all|id,...]/;
    $cmd =~ s/procdecfg/\n\t procdecfg [$option unit=id all|id,...]/;

    #############################################
    # Responds with usage statement
    #############################################
    local *usage = sub {
        return( [ $_[0],
            "rfsp -h|--help",
            "rfsp -v|--version",
            "rfsp [-V|--verbose] noderange $cmd\n",
            "    -h   writes usage information to standard output",
            "    -v   displays command version",
            "    -V   verbose output"] );
    };
    #############################################
    # Process command-line arguments
    #############################################
    if ( !defined( $args )) {
        return(usage( "No command specified" ));
    }
    #############################################
    # Checks case in GetOptions, allows opts
    # to be grouped (e.g. -vx), and terminates
    # at the first unrecognized option.
    #############################################
    @ARGV = @$args;
    $Getopt::Long::ignorecase = 0;
    Getopt::Long::Configure( "bundling" );
    $request->{method} = undef;

    if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
        return( usage() );
    }
    ####################################
    # Option -h for Help
    ####################################
    if ( exists( $opt{h} )) {
        return( usage() );
    }
    ####################################
    # Option -v for version
    ####################################
    if ( exists( $opt{v} )) {
        return( \@VERSION );
    }
    ####################################
    # Check for "-" with no option
    ####################################
    if ( grep(/^-$/, @ARGV )) {
        return(usage( "Missing option: -" ));
    }
    ####################################
    # Check for unsupported commands
    ####################################
    if ( !defined( $request->{method} )) { 
        my ($cmd) = grep(/^$ARGV[0]$/, @rsp );
        if ( !defined( $cmd )) {
            return(usage( "Invalid command: $ARGV[0]" ));
        }
        $request->{method} = $cmd;
    }
    ####################################
    # Check command arguments 
    ####################################
    if ( $request->{method} !~ /^sysdump|spdump$/ ) {
        shift @ARGV;

        if ( defined( $ARGV[0] )) {
            my $result = parse_option( $request );
            if ( $result ) {
                return( usage($result) );
            }
        }
    } 
    ####################################
    # Check for an extra argument
    ####################################
    shift @ARGV;
    if ( defined( $ARGV[0] )) {
        return(usage( "Invalid Argument: $ARGV[0]" ));
    }
    return( \%opt );
}


##########################################################################
# Parse the command line optional arguments 
##########################################################################
sub parse_option {

    my $request = shift;

    ####################################
    # Set/get time
    ####################################
    if ( $request->{method} =~ /^time$/ ) {
        if ( $ARGV[0] !~
          /^([0-1]?[0-9]|2[0-3]):(0?[0-9]|[1-5][0-9]):(0?[0-9]|[1-5][0-9])$/){
            return( "Invalid time format '$ARGV[0]'" );
        }
        $request->{op} = "$1-$2-$3";
    }
    ####################################
    # Set/get date 
    ####################################
    if ( $request->{method} =~ /^date$/ ) {
        if ( $ARGV[0] !~
          /^(0?[1-9]|1[012])-(0?[1-9]|[12][0-9]|3[01])-(20[0-9]{2})$/){
            return( "Invalid date format '$ARGV[0]'" );
        }
        $request->{op} = "$1-$2-$3";
    }
    ####################################
    # Set/get options
    ####################################
    if ( $request->{method} =~ /^autopower|iocap$/ ) {
        if ( $ARGV[0] !~ /^enable|disable$/i ) {
            return( "Invalid argument '$ARGV[0]'" );
        }
        $request->{op} = $ARGV[0];
    }
    ####################################
    # Deconfiguration policy 
    ####################################
    if ( $request->{method} =~ /^decfg$/ ) {
        if ( $ARGV[0] !~ /^enable|disable$/i ) {
            return( "Invalid argument '$ARGV[0]'" );
        }
        my $op = $ARGV[0];
        shift @ARGV;

        if ( !defined( $ARGV[0] )) {
            return( "Missing argument to '$op'" );
        }
        if ( $ARGV[0] !~ /^([\w\/,]+)$/ ) {
            return( "Invalid argument '$ARGV[0]'" );
        }
        $request->{op} = "$op $1";
    }
    ####################################
    # Deconfiguration 
    ####################################
    if ( $request->{method} =~ /^procdecfg|memdecfg$/ ) {
        if ( $ARGV[0] !~ /^configure|deconfigure$/i ) {
            return( "Invalid argument '$ARGV[0]'" );
        }
        my $op = $ARGV[0];
        shift @ARGV;

        if ( !defined( $ARGV[0] )) {
            return( "Missing argument to '$op'" );
        }
        ################################
        # Processor deconfiguration 
        ################################
        if ( $request->{method} =~ /^procdecfg$/ ) {
            if ( $ARGV[0] !~ /^(unit=\d+)$/ ) {
                return( "Invalid argument '$ARGV[0]'" );
            }
            my $unit = $1;
            shift @ARGV;

            if ( !defined( $ARGV[0] )) {
                return( "Missing argument 'id,...'" );
            }
            if ( $ARGV[0] !~ /^(all|[\d,]+)$/ ) {
                return( "Invalid argument '$ARGV[0]'" );
            }
            $request->{op} = "$op $unit:ID=$1";
        }
        ################################
        # Memory deconfiguration 
        ################################
        elsif ( $request->{method} =~ /^memdecfg$/ ) {
            if ( $ARGV[0] !~ /^(unit=\d+)$/ ) {
                return( "Invalid argument '$ARGV[0]'" );
            }
            my $unit = $1;
            shift @ARGV;

            if ( !defined( $ARGV[0] )) {
                return( "Missing argument '(unit|bank)=id,...'" );
            }
            if ( $ARGV[0] !~ /^(unit=all|unit=[\d,]+|bank=all|bank=[\d,]+)$/ ){
                return( "Invalid argument '$ARGV[0]'" );
            }
            $request->{op} = "$op $unit:$1";
        }
    }
    return undef;
}



##########################################################################
# FSP command handler through HTTP interface
##########################################################################
sub handler {

    my $server  = shift;
    my $request = shift;
    my $exp     = shift;

    ##################################
    # Process FSP command 
    ##################################
    my $result = process_cmd( $exp, $request );
    my $Rc = shift(@$result);

    my %output;
    $output{node}->[0]->{name}->[0] = $server;
    $output{node}->[0]->{data}->[0]->{contents}->[0] = @$result[0];
    $output{errorcode} = $Rc;

    ##################################
    # Disconnect from FSP 
    ##################################
    xCAT::PPCfsp::disconnect( $exp );

    return( [\%output] );

}


##########################################################################
# Logon through remote FSP HTTP-interface
##########################################################################
sub connect {

    my $request = shift;
    my $server  = shift;
    my $command = $request->{command};
    my $verbose = $request->{verbose};
    my $method  = $request->{method};
    my $lwp_log;

    ##################################
    # Check command
    ##################################
    if ( !exists( $cmds{$command}{$method} )) {
        return( "$server: Unsupported command" );
    }
    ##################################
    # Get userid/password 
    ##################################
    my @cred = xCAT::PPCdb::credentials( $server, "fsp" );

    ##################################
    # Redirect STDERR to variable 
    ##################################
    if ( $verbose ) {
        close STDERR;
        if ( !open( STDERR, '>', \$lwp_log )) {
             return( "Unable to redirect STDERR: $!" );
        }
    }
    ##################################
    # Turn on tracing
    ##################################
    if ( $verbose ) {
        LWP::Debug::level( '+' );
    }
    ##################################
    # Create cookie
    ##################################
    my $cookie = HTTP::Cookies->new();
    $cookie->set_cookie( 0,'asm_session','0','cgi-bin','','443',0,0,3600,0 );

    ##################################
    # Create UserAgent
    ##################################
    my $ua = LWP::UserAgent->new();

    ##################################
    # Set options
    ##################################
    my $url = "https://$server/cgi-bin/cgi?form=2";
    $ua->cookie_jar( $cookie );
    $ua->timeout(30);

    ##################################
    # Submit logon
    ##################################
    my $res = $ua->post( $url,
       [ user     => $cred[0],
         password => $cred[1],
         lang     => "0",
         submit   => "Log in" ]
    );

    ##################################
    # Logon failed
    ##################################
    if ( !$res->is_success() ) {
        return( $lwp_log.$res->status_line );
    }
    ##################################
    # To minimize number of GET/POSTs,
    # if we successfully logon, we should 
    # get back a valid cookie:
    #    Set-Cookie: asm_session=3038839768778613290
    #
    ##################################

    if ( $res->as_string =~ /Set-Cookie: asm_session=(\d+)/ ) {   
        ##############################
        # Successful logon....
        # Return:
        #    UserAgent 
        #    Server hostname
        #    UserId
        #    Redirected STDERR/STDOUT
        ##############################
        return( $ua,
                $server,
                $cred[0],
                \$lwp_log );
    }
    ##############################
    # Logon error 
    ##############################
    $res = $ua->get( $url );

    if ( !$res->is_success() ) {
        return( $lwp_log.$res->status_line );
    }
    ##############################
    # Check for specific failures
    ##############################
    if ( $res->content =~ /(Invalid user ID or password|Too many users)/i ) {
        return( $lwp_log.$1 );
    }
    return( $lwp_log."Logon failure" );

}


##########################################################################
# Logoff through remote FSP HTTP-interface
##########################################################################
sub disconnect {

    my $exp    = shift;
    my $ua     = @$exp[0];
    my $server = @$exp[1];
    my $uid    = @$exp[2];

    ##################################
    # POST Logoff
    ##################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi?form=1", 
                  [ submit => "Log out" ]
    );
    ##################################
    # Logoff failed
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}


##########################################################################
# Execute FSP command
##########################################################################
sub process_cmd {

    my $exp     = shift;
    my $request = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $uid     = @$exp[2];
    my $command = $request->{command};   
    my $method  = $request->{method};   
    my %menu    = ();

    ##################################
    # 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;
        }
    }
    ##################################
    # Get form id  
    ##################################
    my $form = $menu{$cmds{$command}{$method}[0]};

    if ( !defined( $form )) {
        return( [RC_ERROR,"Cannot find '$cmds{$command}{$method}[0]' menu"] );
    }
    ##################################
    # Run command 
    ##################################
    my $result = $cmds{$command}{$method}[1]($exp, $request, $form, \%menu);
    return( $result );
}


##########################################################################
# Returns current power state
##########################################################################
sub state {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##################################
    # Get current power status 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Get power state
    ##################################
    if ( $res->content =~ /Current system power state: (.*)<br>/) {
        return( [SUCCESS,$1] );
    }
    return( [RC_ERROR,"unknown"] );    
}


##########################################################################
# Powers FSP On/Off
##########################################################################
sub powercmd {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $op      = $request->{op};
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##################################
    # Get Power On/Off System URL 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Get current power state
    ##################################
    if ( $res->content !~ /Current system power state: (.*)<br>/) {
        return( [RC_ERROR,"Unable to determine current power state"] );
    }
    my $state = $1;

    ##################################
    # Already in that state
    ##################################
    if ( $op =~ /^$state$/i ) {
        return( [SUCCESS,"Success"] );
    }
    ##################################
    # Get "Power On/Off System" form 
    ##################################
    my $form = HTML::Form->parse( $res->content, $res->base );

    ##################################
    # Return error
    ##################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Power On/Off System' form not found"] );
    }
    ##################################
    # Get "Save and Submit" button
    ##################################
    my $button = ($op eq "on") ? "on" : "of"; 
    my @inputs = $form->inputs();

    if ( !grep( $_->{name} eq $button, @inputs )) {
        return( [RC_ERROR,"Unable to power $op from state: $state"] );
    } 
    ##################################
    # Send command 
    ##################################
    my $request = $form->click( $button );
    $res = $ua->request( $request );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(not allowed.*\.)/ ) {
        return( [RC_ERROR,$1] );
    }
    ##################################
    # Success 
    ##################################
    if ( $res->content =~ /(Operation completed successfully)/ ) {
        return( [SUCCESS,"Success"] );
    }
    return( [RC_ERROR,"Unknown error"] );
}


##########################################################################
# Reset FSP
##########################################################################
sub reset {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##################################
    # Send Reset command 
    ##################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form   => $id,
           submit => "Continue" ]
    );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success()) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(This feature is only available.*)/ ) { 
        return( [RC_ERROR,$1] );
    }
    ##################################
    # Success
    ##################################
    if ( $res->content =~ /(Operation completed successfully)/ ) {
        return( [SUCCESS,"Success"] );
    }
    return( [RC_ERROR,"Unknown error"] );
}


##########################################################################
# Boots FSP (Off->On, On->Reset)
##########################################################################
sub boot {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $menu    = shift;
    my $command = $request->{command};

    ##################################
    # Check current power state
    ##################################
    my $state = xCAT::PPCfsp::state( 
                             $exp, 
                             $request, 
                             $menu->{$cmds{$command}{state}[0]},
                             $menu );
    my $Rc = shift(@$state);

    ##################################
    # Return error 
    ##################################
    if ( $Rc != SUCCESS ) {
        return( [$Rc,@$state[0]] );
    }
    if ( @$state[0] !~ /^on|off$/i ) {
        return( [RC_ERROR,"Unable to boot in state: '@$state[0]'"] );
    }
    ##################################
    # Get command 
    ##################################
    $request->{op} = "on"; 
    my $method = ( $state =~ /^on$/i ) ? "reset" : "powercmd"; 
  
    ##################################
    # Get command form id
    ##################################
    $id = $menu->{$cmds{$command}{$method}[0]};

    ##################################
    # Run command
    ##################################
    my $result = $cmds{$command}{$method}[1]( $exp, $request, $id );
    return( $result );    
}


##########################################################################
# Clears Error/Event Logs         
##########################################################################
sub clear {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
 
    ##################################
    # Get Error/Event Logs URL 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Clear all error/event log entries:
    # Are you sure? (OK/Cancel)
    ##################################
    my $form = HTML::Form->parse( $res->content, $res->base );

    ##################################
    # Return error
    ##################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Error/Event Logs' form not found"] );
    }
    ##################################
    # Send Clear to JavaScript 
    ##################################
    my $request = $form->click( 'clear' );
    $res = $ua->request( $request );

    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}


##########################################################################
# Gets the number of Error/Event Logs entries specified
##########################################################################
sub entries {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $opt     = $request->{opt};
    my $count   = (exists($opt->{e})) ? $opt->{e} : -1; 
    my $result;
    my $i = 1;

    ##################################
    # Get log entries
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
  
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    my @entries = split /\n/, $res->content;

    ##################################
    # Prepend header
    ##################################
    $result = (@entries) ?
        "\n#Log ID   Time                 Failing subsystem           Severity             SRC\n" :
        "No entries";
     
    ##################################
    # Parse log entries 
    ##################################
    foreach ( @entries ) {
        if ( /tabindex=\d+><\/td><td>(.*)<\/td><td / ) {
            my $values = $1;
            $values =~ s/<\/td><td>/  /g;
            $result.= "$values\n";

            if ( $i++ == $count ) {
                last;
            }
        }
    }
    return( [SUCCESS,$result] );
}


##########################################################################
# Gets/Sets system time of day 
##########################################################################
sub time {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##############################
    # Send command 
    ##############################
    my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id ); 
    my $Rc = shift(@$result);

    ##############################
    # Return error
    ##############################
    if ( $Rc != SUCCESS ) {
        return( [$Rc,@$result[0]] );
    }
    ##############################
    # Get time
    ##############################
    if ( !defined( $request->{op} )) {
        @$result[0] =~ /(\d+) (\d+) (\d+) $/; 
        return( [SUCCESS,sprintf( "%02d:%02d:%02d UTC",$1,$2,$3 )] );
    }
    ##############################
    # Set time 
    ##############################
    my @t   = split / /, @$result[0];
    my @new = split /-/, $request->{op};
    splice( @t,3,3,@new );

    ##############################
    # Send command 
    ##############################
    my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t ); 
    my $Rc = shift(@$result);

    return( [$Rc,@$result[0]] );
}


##########################################################################
# Gets/Sets system date 
##########################################################################
sub date {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##############################
    # Send command 
    ##############################
    my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id ); 
    my $Rc = shift(@$result);

    ##############################
    # Return error
    ##############################
    if ( $Rc != SUCCESS ) {
        return( [$Rc,@$result[0]] );
    }
    ##############################
    # Get date
    ##############################
    if ( !defined( $request->{op} )) {
       @$result[0] =~ /^(\d+) (\d+) (\d+)/; 
       return( [SUCCESS,sprintf( "%2d-%02d-%4d",$1,$2,$3 )] );
    }
    ##############################
    # Set date
    ##############################
    my @t   = split / /, @$result[0];
    my @new = split /-/, $request->{op};
    splice( @t,0,3,@new ); 

    ##############################
    # Send command
    ##############################
    my $result = xCAT::PPCfsp::timeofday( $exp, $request, $id, \@t );
    my $Rc = shift(@$result);

    return( [$Rc,@$result[0]] );
}


##########################################################################
# Gets/Sets system time/date 
##########################################################################
sub timeofday {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $d       = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ######################################
    # Get time/date 
    ######################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(only when the system is powered off)/ ) {
        return( [RC_ERROR,$1] );
    }
    ##################################
    # Get "Power On/Off System" form
    ##################################
    my $form = HTML::Form->parse( $res->content, $res->base );

    ##################################
    # Return error
    ##################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Power On/Off System' form not found"] );
    }
    ######################################
    # Get time/date fields  
    ######################################
    my $result;
    my @option = qw(omo od oy oh omi os);
   
    foreach ( @option ) {
        if ( $res->content !~ /name='$_' value='(\d+)'/ ) {
            return( [RC_ERROR,"Error getting time of day"] );
        }
        $result.= "$1 ";
    }
    ######################################
    # Return time/date 
    ######################################
    if ( !defined( $d )) {
        return( [SUCCESS,$result] );
    }
    ######################################
    # Set time/date 
    ######################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi",
        [ form   => $id,
          mo     => @$d[0],
          d      => @$d[1],
          y      => @$d[2],
          h      => @$d[3],
          mi     => @$d[4],
          s      => @$d[5],
          submit => "Save settings" ]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(not allowed.*\.|Invalid entry)/ ) {
        return( [RC_ERROR,$1] );
    } 
    return( [SUCCESS,"Success"] );
}



##########################################################################
# Gets/Sets I/O Adapter Enlarged Capacity
##########################################################################
sub iocap {
    return( option( @_,"pe" ));
}


##########################################################################
# Gets/Sets Auto Power Restart 
##########################################################
sub autopower {
    return( option( @_,"apor" ));
}


##########################################################################
# Gets/Sets options 
##########################################################################
sub option {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $menu    = shift;
    my $option  = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $op      = $request->{op};

    ######################################
    # Get option URL
    ######################################
    if ( !defined( $op )) {
        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 => ($op eq "disable") ? "0" : "1",
          submit  => "Save settings" ]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content !~ /Operation completed successfully/ ) {
        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];

    ##################################
    # Get settings
    ##################################
    if ( !defined( $request->{op} )) {
        return( readdecfg( $exp, $request, $id ));
    }
    ##################################
    # Set settings
    ##################################
    return( writedecfg( $exp, $request, $id ));
}


##########################################################################
# Gets/Sets Processor Deconfiguration
##########################################################################
sub procdecfg {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ##################################
    # Get settings
    ##################################
    if ( !defined( $request->{op} )) {
        return( readdecfg( $exp, $request, $id ));
    }
    ##################################
    # Set settings
    ##################################
    return( writedecfg( $exp, $request, $id ));
}



##########################################################################
# Sets Deconfiguration settings
##########################################################################
sub writedecfg {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ######################################
    # Command-line parameter specified 
    ######################################
    $request->{op} =~ /^(\w+) unit=(\d+):(.*)=(all|[\d,]+)$/; 
    my $state  = $1;
    my $unit   = $2;
    my $type   = $3;
    my @ids    = split /,/, $4;
    my $select = ($state =~ /^configure$/i) ? 0 : 1; 

    ######################################
    # 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] );
    }
    ######################################
    # 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,"unit=$unit not found"] );
    }
    ######################################
    # Get current settings
    ######################################
    my $form = HTML::Form->parse( $res->content, $res->base );
    my @inputs = $form->inputs();

    ######################################
    # Return error
    ######################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Deconfiguration' form not found"] );
    }
    ######################################
    # Find radio button
    ######################################
    my ($radio) = grep($_->{type} eq "radio", @inputs );
    if ( !defined( $radio )) {
        return( [RC_ERROR,"Radio button not found"] );
    }
    ######################################
    # Select radio button
    ######################################
    $radio->value( $value );

    ######################################
    # Send command
    ######################################
    my $request = $form->click( "submit" );
    $res = $ua->request( $request );

    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Get current settings
    ######################################
    $form = HTML::Form->parse( $res->content, $res->base );
    @inputs = $form->inputs();

    ######################################
    # Return error
    ######################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Deconfiguration' form not found"] );
    }
    ######################################
    # Get options 
    ######################################
    my %options = ();
    my %key     = ();
    my $setall  = 0;

    foreach ( @inputs ) {
        if ( $_->type eq "option" ) {
            push @{$options{$_->name}}, $_->value;
        }
    }
    my @units = split /<thead align=left><tr><th>/, $res->content;
    shift(@units);
    my $html;

    ######################################
    # Break into unit types 
    ######################################
    foreach ( @units ) {
        /([\w\s]+)<\/th><th>/;
        if ( $1 =~ /$type/i ) {
            $html = $_;
            last;
        }
    }
    ######################################
    # Look for unit type 
    ######################################
    if ( !defined( $html )) {
        return( [RC_ERROR,"unit=$unit '$type' not found"] );
    }
    ######################################
    # Set all IDs 
    ######################################
    if ( $ids[0] eq "all" ) {
       @ids = ();
       $setall = 1;
    }
    ######################################
    # Associate 'option' name with ID 
    ######################################
    foreach ( keys %options ) {
        if ( $html =~ /\n<tr><td>(\d+)<\/td><td>.*name='$_'/ ) {
            if ( $setall ) {
                push @ids, $1;
            }
            push @{$options{$_}}, $1;
        }
    }
    ######################################
    # Check if each specified ID exist 
    ######################################
    foreach ( @ids ) {
        foreach my $name ( keys %options ) {
            my $id = @{$options{$name}}[1];
            
            if ( $_ eq $id ) {
                my $value = @{$options{$name}}[0];
                $key{$id} = [$value,$name];
            }
        }
    }
    ######################################
    # Check if ID exists 
    ######################################
    foreach ( @ids ) {
        if ( !exists( $key{$_} )) {
            return( [RC_ERROR,"unit=$unit $type=$_ not found"] );
        }
        my $value = @{$key{$_}}[0];
        if ( $value == $select ) {
           delete $key{$_};
        }
    }
    ######################################
    # Check in already in that state 
    ######################################
    if ( !scalar( keys %key )) {
        return( [RC_ERROR,"All $type(s) specified already in '$state' state"] ); 
    } 
    ######################################
    # Make changes to form  
    ######################################
    foreach ( keys %key ) {
        my $name = @{$key{$_}}[1];
        my ($button) = grep($_->{name} eq $name, @inputs );
        if ( !defined( $button )) {
            return( [RC_ERROR,"Option=$name not found"] );
        }
        $button->value( $select );
    }
    ##################################
    # Send command
    ##################################
    my $request = $form->click( "submit" );
    $res = $ua->request( $request );

    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /\n(.*Operation not allowed.*\.)/ ) {
        my $result = $1;
        $result =~ s/<br><br>/\n/g;
        return( [RC_ERROR,$result] ); 
    }
    return( [SUCCESS,"Success"] );       
}


##########################################################################
# Gets Deconfiguration settings
##########################################################################
sub readdecfg {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $result  = "\n";

    ######################################
    # Get Deconfiguration URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );

    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Get current settings
    ######################################
    my $form = HTML::Form->parse( $res->content, $res->base );
    my @inputs = $form->inputs();
    my $html   = $res->content;
    my $unit;

    ######################################
    # Return error
    ######################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Deconfiguration' form not found"] );
    }
    ######################################
    # Find radio button
    ######################################
    my ($radio) = grep($_->{type} eq "radio", @inputs );
    if ( !defined( $radio )) {
        return( [RC_ERROR,"Radio button not found"] ); 
    }
    ######################################
    # Find unit identifier
    ######################################
    if ( $html =~ /<thead align=left><tr><th><\/th><th>([\w\s]+)</ ) {
        $unit = $1;
    }
    foreach ( @{$radio->{menu}} ) {
        ##################################
        # Select radio button
        ##################################
        my $value = ( ref($_) eq 'HASH' ) ? %$_->{value} : $_;
        $radio->value( $value );

        ##################################
        # Send command
        ##################################
        my $request = $form->click( "submit" );
        $res = $ua->request( $request );

        ##################################
        # Return error
        ##################################
        if ( !$res->is_success() ) {
            return( [RC_ERROR,$res->status_line] );
        }
        $html = $res->content;

        ##################################
        # Find unit identifier
        ##################################
        if ( $html =~ /<p>([\w\s:]+)</ ) {
            $result.= "$1\n";
        }   
        my @group = split /<thead align=left><tr><th>/, $res->content;
        shift(@group);

        foreach ( @group ) {
            my @maxlen = ();
            my @values = ();

            ##############################
            # Entry heading
            ##############################
            /(.*)<\/th><\/tr><\/thead>/;
            my @heading = split /<\/th><th>/, $1;
            pop(@heading);
            pop(@heading);

            foreach ( @heading ) {
                push @maxlen, length($_);
            }
            ##############################
            # Entry values
            ##############################
            foreach ( split /\n/ ) {
                if ( s/^<tr><td>// ) {
                    s/<br>/ /g;

                    my $i = 0;
                    my @d = split /<\/td><td>/;
                    pop(@d);
                    pop(@d);

                    ######################
                    # Length formatting
                    ######################
                    foreach ( @d ) {
                        if ( length($_) > $maxlen[$i] ) {
                            $maxlen[$i] = length($_);
                        }
                        $i++;
                    }
                    push @values, [@d];
                }
            }
            ##############################
            # Output header
            ##############################
            my $i = 0;
            foreach ( @heading ) {
                my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
                $result.= sprintf( $format, $_ );
            }
            $result.= "\n";

            ##############################
            # Output values
            ##############################
            foreach ( @values ) {
                $i = 0;
                foreach ( @$_ ) {
                    my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
                    $result.= sprintf( $format, $_ );
                }
                $result.= "\n";
            }
            $result.= "\n";
        }
    }
    return( [SUCCESS,$result] );
}


##########################################################################
# Gets/sets Deconfiguration Policies
##########################################################################
sub decfg {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ######################################
    # 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( $request->{op} )) {
        my $fmt = sprintf( "\n%%-%ds %%s",$len );

        foreach ( keys %d ) {
            $result.= sprintf( $fmt,$_,$d{$_}[0] );
        }
        return( [SUCCESS,$result] );
    }
    ######################################
    # Set Deconfiguration Policy
    ######################################
    my ($op,$decfg) = split / /, $request->{op};
    my @policy      = split /,/, $decfg;
    my $state       = ($op =~ /^enable$/i) ? 0 : 1;

    ######################################
    # Check for duplicate policies
    ######################################
    foreach my $name ( @policy ) {
        if ( grep( /^$name$/, @policy ) > 1 ) {
            return( [RC_ERROR,"Duplicate policy specified: $name"] );
        }
    }
    ######################################
    # Get Deconfiguration Policy form 
    ######################################
    my $form = HTML::Form->parse( $res->content, $res->base );

    ######################################
    # Return error
    ######################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Deconfiguration Policies' form not found"] );
    }
    ######################################
    # Get hidden inputs 
    ######################################
    my @inputs = $form->inputs();

    my (@hidden) = grep( $_->{type} eq "hidden", @inputs );
    if ( !defined( @hidden )) {
        return( [RC_ERROR,"<input type='hidden'> not found"] );
    }
    ######################################
    # Check for invalid policies
    ######################################
    foreach my $name ( @policy ) {
        my @p = grep( $_->{value_name}=~/\b$name\b/i, @hidden );

        if ( @p > 1 ) {
            return( [RC_ERROR,"Ambiguous policy: $name"] );
        } elsif ( !@p ) {
            return( [RC_ERROR,"Invalid policy: $name"] );
        }
        my $value_name = $p[0]->{value_name};
        $policy[$i++] = @{$d{$value_name}}[1]; 
    }
    ######################################
    # Select option 
    ######################################
    foreach my $name ( @policy ) {
        my ($in) = grep( $_->{name} eq $name, @inputs );
        $in->value( $state );
    }
    ######################################
    # Send command
    ######################################
    my $request = $form->click( "submit" );
    $res = $ua->request( $request );

    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}


##########################################################################
# Performs a System Dump
##########################################################################
sub sysdump {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];

    ######################################
    # Get Dump URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );

    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Possible errors: 
    # not allowed when a dump of this type exists.
    # not allowed when system is powered off.
    ######################################
    if ( $res->content =~ /(not allowed.*\.)/ ) {
        return( [RC_ERROR,$1] );
    }
    my @d;
    my $html = $res->content;

    ######################################
    # Get current dump settings 
    ######################################
    foreach ( my $i=0; $i<3; $i++ ) {
        if ( $html !~ s/selected value='(\d+)'// ) {
            return( [RC_ERROR,"Error getting dump settings"] );
        }
        push @d, $1;
    }
    ######################################
    # Send dump command
    ######################################
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form     => $id,
           policy   => $d[0],
           content  => $d[1],
           phyp     => $d[2],
           page     => "1",
           takedump => "Save settings and initiate dump" ]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Continue ? 
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form     => $id,
           policy   => $d[0],
           content  => $d[1],
           phyp     => $d[2],
           page     => "2",
           takedump => "Save settings and initiate dump",
           submit   => "Continue"]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}


##########################################################################
# Performs a Service Processor Dump
##########################################################################
sub spdump {

    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $button  = "Save settings and initiate dump";
    my $dump_setting = 1;

    ######################################
    # Get Dump URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );

    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Dump disabled - enable it 
    ######################################
    if ( $res->content =~ /selected value='0'>Disabled/ ) {
        $res = $ua->post( "https://$server/cgi-bin/cgi",
            [ form  => $id,
              bdmp  => "1",
              save  => "Save settings" ]
        );
        ##################################
        # Return error
        ##################################
        if ( !$res->is_success() ) {
            return( [RC_ERROR,$res->status_line] );
        }
        if ( $res->content !~ /Operation completed successfully/ ) {
            return( [RC_ERROR,"Error enabling dump setting"] );
        }
        ##################################
        # Get Dump URL again
        ##################################
        $res = $ua->get( $url );

        if ( !$res->is_success() ) {
            return( [RC_ERROR,$res->status_line] );
        }
        ##################################
        # Restore setting after dump 
        ##################################
        $dump_setting = 0;
    }
    if ( $res->content !~ /$button/ ) {
        return( [RC_ERROR,"'$button' button not found"] );
    }
    ######################################
    # We will lose conection after dump 
    ######################################
    $ua->timeout(5);

    ######################################
    # Send dump command 
    ######################################
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form => $id,
           bdmp => $dump_setting,
           dump => "Save settings and initiate dump" ]
    );
    ######################################
    # Will lose connection on success -500 
    ######################################
    if ( !$res->is_success() ) {
        if ( $res->code ne "500" ) {
            return( [RC_ERROR,$res->status_line] );
        }
    }
    return( [SUCCESS,"Success"] );
}


##########################################################################
# Gets all Error/Event Logs entries
##########################################################################
sub all {
    return( entries(@_) );
}


##########################################################################
# Gets all Error/Event Logs entries then clears the logs
##########################################################################
sub all_clear {

    my $result = entries( @_ );
    clear( @_);
    return( $result );
}


1;