# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
package xCAT::PPCfsp;
use strict;
use Getopt::Long;
use LWP;
use HTTP::Cookies;
use HTML::Form;
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
use xCAT::Usage;
use Socket;
##########################################
# Globals
##########################################
my %cmds = ( 
  rpower => {
     state         => ["Power On/Off System",           \&state],
     powercmd      => ["Power On/Off System",           \&powercmd],
     powercmd_boot => ["Power On/Off System",           \&boot], 
     reset         => ["System Reboot",                 \&reset] }, 
  reventlog => { 
     all           => ["Error/Event Logs",              \&all],
     all_clear     => ["Error/Event Logs",              \&all_clear],
     entries       => ["Error/Event Logs",              \&entries],
     clear         => ["Error/Event Logs",              \&clear] },
  rspconfig => {
     memdecfg      => ["Memory Deconfiguration",        \&memdecfg],
     decfg         => ["Deconfiguration Policies",      \&decfg],
     procdecfg     => ["Processor Deconfiguration",     \&procdecfg],
     iocap         => ["I/O Adapter Enlarged Capacity", \&iocap],
     time          => ["Time Of Day",                   \&time], 
     date          => ["Time Of Day",                   \&date], 
     autopower     => ["Auto Power Restart",            \&autopower],
     sysdump       => ["System Dump",                   \&sysdump],
     spdump        => ["Service Processor Dump",        \&spdump],
     network       => ["Network Configuration",         \&netcfg]},
);
##########################################################################
# FSP command handler through HTTP interface
##########################################################################
sub handler {
    my $server  = shift;
    my $request = shift;
    my $exp     = shift;
    #####################################
    # Convert command to correct format
    #####################################
    if ( ref($request->{method}) ne "HASH" ) {
        $request->{method} = [{$request->{method}=>undef}]; 
    }
    #####################################
    # Process FSP command 
    #####################################
    my @outhash;
    my $result = process_cmd( $exp, $request );
    foreach ( @$result ) {
        my %output;
        $output{node}->[0]->{name}->[0] = $server;
        $output{node}->[0]->{data}->[0]->{contents}->[0] = @$_[1];
        $output{errorcode} = @$_[0];
        push @outhash, \%output;
    }
    #####################################
    # Disconnect from FSP 
    #####################################
    xCAT::PPCfsp::disconnect( $exp );
    return( \@outhash );
}
##########################################################################
# Logon through remote FSP HTTP-interface
##########################################################################
sub connect {
    my $req     = shift;
    my $server  = shift;
    my $verbose = $req->{verbose};
    my $timeout = $req->{fsptimeout};
    my $lwp_log;
    ##################################
    # Use timeout from site table 
    ##################################
    if ( !$timeout ) {
        $timeout = 30;
    }
    ##################################
    # Get userid/password 
    ##################################
    my $cred = $req->{$server}{cred};
    ##################################
    # Redirect STDERR to variable 
    ##################################
    if ( $verbose ) {
        close STDERR;
        if ( !open( STDERR, '>', \$lwp_log )) {
             return( "Unable to redirect STDERR: $!" );
        }
    }
    $IO::Socket::SSL::VERSION = undef;
    eval { require Net::SSL };
    ##################################
    # Turn on tracing
    ##################################
    if ( $verbose ) {
        LWP::Debug::level( '+' );
    }
    ##################################
    # Create cookie
    ##################################
    my $cookie = HTTP::Cookies->new();
    $cookie->set_cookie( 0,'asm_session','0','cgi-bin','','443',0,0,3600,0 );
    ##################################
    # Create UserAgent
    ##################################
    my $ua = LWP::UserAgent->new();
    ##################################
    # Set options
    ##################################
    my $hosttab  = xCAT::Table->new( 'hosts' );
    if ( $hosttab) {
        my $hostshash = $hosttab->getNodeAttribs( $server, [qw(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" );
}
##########################################################################
# Logoff through remote FSP HTTP-interface
##########################################################################
sub disconnect {
    my $exp    = shift;
    my $ua     = @$exp[0];
    my $server = @$exp[1];
    my $uid    = @$exp[2];
    ##################################
    # POST Logoff
    ##################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi?form=1", 
                  [ submit => "Log out" ]
    );
    ##################################
    # Logoff failed
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}
##########################################################################
# Execute FSP command
##########################################################################
sub process_cmd {
    my $exp     = shift;
    my $request = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $uid     = @$exp[2];
    my $command = $request->{command};   
    my $methods = $request->{method};   
    my %menu    = ();
    my @result;
    ##################################
    # We have to expand the main
    # menu since unfortunately, the
    # the forms numbers are not the
    # same across FSP models/firmware
    # versions.
    ##################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form => "2",
           e    => "1" ]
    );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Build hash of expanded menus
    ##################################
    foreach ( split /\n/, $res->content ) {
        if ( /form=(\d+).*window.status='(.*)'/ ) {
            $menu{$2} = $1;
        }
    }
    foreach ( keys %$methods ) {
        ##############################
        # Get form id  
        ##############################
        my $form = $menu{$cmds{$command}{$_}[0]};
        if ( !defined( $form )) {
            return( [RC_ERROR,"Cannot find '$cmds{$command}{$_}[0]' menu"] );
        }
        ##################################
        # Run command 
        ##################################
        my $res = $cmds{$command}{$_}[1]($exp, $request, $form, \%menu);
        push @result, $res;
    }
    return( \@result );
}
##########################################################################
# Returns current power state
##########################################################################
sub state {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    ##################################
    # Get current power status 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Get power state
    ##################################
    if ( $res->content =~ /Current system power state: (.*)
/) {
        return( [SUCCESS,$1] );
    }
    return( [RC_ERROR,"unknown"] );    
}
##########################################################################
# Powers FSP On/Off
##########################################################################
sub powercmd {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $op      = $request->{op};
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    ##################################
    # Get Power On/Off System URL 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Get current power state
    ##################################
    if ( $res->content !~ /Current system power state: (.*)
/) {
        return( [RC_ERROR,"Unable to determine current power state"] );
    }
    my $state = $1;
    ##################################
    # Already in that state
    ##################################
    if ( $op =~ /^$state$/i ) {
        return( [SUCCESS,"Success"] );
    }
    ##################################
    # Get "Power On/Off System" form 
    ##################################
    my $form = HTML::Form->parse( $res->content, $res->base );
    ##################################
    # Return error
    ##################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Power On/Off System' form not found"] );
    }
    ##################################
    # Get "Save and Submit" button
    ##################################
    my $button = ($op eq "on") ? "on" : "of"; 
    my @inputs = $form->inputs();
    if ( !grep( $_->{name} eq $button, @inputs )) {
        return( [RC_ERROR,"Unable to power $op from state: $state"] );
    } 
    ##################################
    # Send command 
    ##################################
    my $data = $form->click( $button );
    $res = $ua->request( $data );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(not allowed.*\.)/ ) {
        return( [RC_ERROR,$1] );
    }
    ##################################
    # Success 
    ##################################
    if ( $res->content =~ /(Operation completed successfully)/ ) {
        return( [SUCCESS,"Success"] );
    }
    return( [RC_ERROR,"Unknown error"] );
}
##########################################################################
# Reset FSP
##########################################################################
sub reset {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    ##################################
    # Send Reset command 
    ##################################
    my $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form   => $id,
           submit => "Continue" ]
    );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success()) {
        return( [RC_ERROR,$res->status_line] );
    }
    if ( $res->content =~ /(This feature is only available.*)/ ) { 
        return( [RC_ERROR,$1] );
    }
    ##################################
    # Success
    ##################################
    if ( $res->content =~ /(Operation completed successfully)/ ) {
        return( [SUCCESS,"Success"] );
    }
    return( [RC_ERROR,"Unknown error"] );
}
##########################################################################
# Boots FSP (Off->On, On->Reset)
##########################################################################
sub boot {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $menu    = shift;
    my $command = $request->{command};
    ##################################
    # Check current power state
    ##################################
    my $state = xCAT::PPCfsp::state( 
                             $exp, 
                             $request, 
                             $menu->{$cmds{$command}{state}[0]},
                             $menu );
    my $Rc = shift(@$state);
    ##################################
    # Return error 
    ##################################
    if ( $Rc != SUCCESS ) {
        return( [$Rc,@$state[0]] );
    }
    if ( @$state[0] !~ /^(on|off)$/i ) {
        return( [RC_ERROR,"Unable to boot in state: '@$state[0]'"] );
    }
    ##################################
    # Get command 
    ##################################
    $request->{op} = "on"; 
    my $method = ( $state =~ /^on$/i ) ? "reset" : "powercmd"; 
  
    ##################################
    # Get command form id
    ##################################
    $id = $menu->{$cmds{$command}{$method}[0]};
    ##################################
    # Run command
    ##################################
    my $result = $cmds{$command}{$method}[1]( $exp, $request, $id );
    return( $result );    
}
##########################################################################
# Clears Error/Event Logs         
##########################################################################
sub clear {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
 
    ##################################
    # Get Error/Event Logs URL 
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Clear all error/event log entries:
    # Are you sure? (OK/Cancel)
    ##################################
    my $form = HTML::Form->parse( $res->content, $res->base );
    ##################################
    # Return error
    ##################################
    if ( !defined( $form )) {
        return( [RC_ERROR,"'Error/Event Logs' form not found"] );
    }
    ##################################
    # Send Clear to JavaScript 
    ##################################
    my $data = $form->click( 'clear' );
    $res = $ua->request( $data );
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets the number of Error/Event Logs entries specified
##########################################################################
sub entries {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $opt     = $request->{opt};
    my $count   = (exists($opt->{e})) ? $opt->{e} : -1; 
    my $result;
    my $i = 1;
    ##################################
    # Get log entries
    ##################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
  
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    my @entries = split /\n/, $res->content;
    ##################################
    # Prepend header
    ##################################
    $result = (@entries) ?
        "\n#Log ID   Time                 Failing subsystem           Severity             SRC\n" :
        "No entries";
     
    ##################################
    # Parse log entries 
    ##################################
    foreach ( @entries ) {
        if ( /tabindex=(\d+)><\/td>
([\w\s:]+) ) {
            $result.= "$1\n";
        }   
        my @group = split //, $res->content;
        shift(@group);
        foreach ( @group ) {
            my @maxlen = ();
            my @values = ();
            ##############################
            # Entry heading
            ##############################
            /(.*)<\/th><\/tr><\/thead>/;
            my @heading = split /<\/th> /, $1;
            pop(@heading);
            pop(@heading);
            foreach ( @heading ) {
                push @maxlen, length($_);
            }
            ##############################
            # Entry values
            ##############################
            foreach ( split /\n/ ) {
                if ( s/^ // ) {
                    s/ 
/ /g;
                    my $i = 0;
                    my @d = split /<\/td>/;
                    pop(@d);
                    pop(@d);
                    ######################
                    # Length formatting
                    ######################
                    foreach ( @d ) {
                        if ( length($_) > $maxlen[$i] ) {
                            $maxlen[$i] = length($_);
                        }
                        $i++;
                    }
                    push @values, [@d];
                }
            }
            ##############################
            # Output header
            ##############################
            my $i = 0;
            foreach ( @heading ) {
                my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
                $result.= sprintf( $format, $_ );
            }
            $result.= "\n";
            ##############################
            # Output values
            ##############################
            foreach ( @values ) {
                $i = 0;
                foreach ( @$_ ) {
                    my $format = sprintf( "%%-%ds",$maxlen[$i++]+2 );
                    $result.= sprintf( $format, $_ );
                }
                $result.= "\n";
            }
            $result.= "\n";
        }
    }
    return( [SUCCESS,$result] );
}
##########################################################################
# Gets/sets Deconfiguration Policies
##########################################################################
sub decfg {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $value   = $request->{method}{decfg};
    ######################################
    # Get Deconfiguration Policy URL
    ######################################
    my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$id" );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    my %d    = ();
    my $len  = 0;
    my $i    = 0;
    my $html = $res->content;
    my $result;
    while ( $html =~ s/ 
(.*:)\s+/ ) {
        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," not found"] );
    }
    ######################################
    # Check for invalid policies
    ######################################
    foreach my $name ( @policy ) {
        my @p = grep( $_->{value_name}=~/\b$name\b/i, @hidden );
        if ( @p > 1 ) {
            return( [RC_ERROR,"Ambiguous policy: $name"] );
        } elsif ( !@p ) {
            return( [RC_ERROR,"Invalid policy: $name"] );
        }
        my $value_name = $p[0]->{value_name};
        $policy[$i++] = @{$d{$value_name}}[1]; 
    }
    ######################################
    # Select option 
    ######################################
    foreach my $name ( @policy ) {
        my ($in) = grep( $_->{name} eq $name, @inputs );
        $in->value( $state );
    }
    ######################################
    # Send command
    ######################################
    my $data = $form->click( "submit" );
    $res = $ua->request( $data );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}
##########################################################################
# Performs a System Dump
##########################################################################
sub sysdump {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    ######################################
    # Get Dump URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Possible errors: 
    # not allowed when a dump of this type exists.
    # not allowed when system is powered off.
    ######################################
    if ( $res->content =~ /(not allowed.*\.)/ ) {
        return( [RC_ERROR,$1] );
    }
    my @d;
    my $html = $res->content;
    ######################################
    # Get current dump settings 
    ######################################
    foreach ( my $i=0; $i<3; $i++ ) {
	if ($i == 0) {
            if ($html !~ /Dump policy:\s+(\w+)/) {
                goto ERROR;
            }
        }
        if ($i != 0) {
	    if ($html !~ s/selected value='(\d+)'//) {
ERROR:
                return( [RC_ERROR,"Error getting dump settings"] );
	    }
        }
        push @d, $1;
    }
    ######################################
    # Send dump command
    ######################################
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form     => $id,
           policy   => $d[0],
           content  => $d[1],
           phyp     => $d[2],
           page     => "1",
           takedump => "Save settings and initiate dump" ]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Continue ? 
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form     => $id,
           policy   => $d[0],
           content  => $d[1],
           phyp     => $d[2],
           page     => "2",
           takedump => "Save settings and initiate dump",
           submit   => "Continue"]
    );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    return( [SUCCESS,"Success"] );
}
##########################################################################
# Performs a Service Processor Dump
##########################################################################
sub spdump {
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    my $ua      = @$exp[0];
    my $server  = @$exp[1];
    my $button  = "Save settings and initiate dump";
    my $dump_setting = 1;
    ######################################
    # Get Dump URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );
    ######################################
    # Return error
    ######################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ######################################
    # Dump disabled - enable it 
    ######################################
    if ( $res->content =~ /selected value='0'>Disabled/ ) {
        $res = $ua->post( "https://$server/cgi-bin/cgi",
            [ form  => $id,
              bdmp  => "1",
              save  => "Save settings" ]
        );
        ##################################
        # Return error
        ##################################
        if ( !$res->is_success() ) {
            return( [RC_ERROR,$res->status_line] );
        }
        if ( $res->content !~ /Operation completed successfully/ ) {
            return( [RC_ERROR,"Error enabling dump setting"] );
        }
        ##################################
        # Get Dump URL again
        ##################################
        $res = $ua->get( $url );
        if ( !$res->is_success() ) {
            return( [RC_ERROR,$res->status_line] );
        }
        ##################################
        # Restore setting after dump 
        ##################################
        $dump_setting = 0;
    }
    if ( $res->content !~ /$button/ ) {
        #################################################################
        # For some firmware levels, button is changed to "initiate dump"
        #################################################################
        $button = "Initiate dump";
        if ( $res->content !~ /$button/ ) {
            return( [RC_ERROR,"'$button' button not found"] );
        }
    }
    ######################################
    # We will lose conection after dump 
    ######################################
    $ua->timeout(10);
    ######################################
    # Send dump command 
    ######################################
    $res = $ua->post( "https://$server/cgi-bin/cgi",
         [ form => $id,
           bdmp => $dump_setting,
           dump => $button ]
    );
    ######################################
    # Will lose connection on success -500 
    ######################################
    if ( !$res->is_success() ) {
        if ( $res->code ne "500" ) {
            return( [RC_ERROR,$res->status_line] );
        }
    }
    return( [SUCCESS,"Success"] );
}
##########################################################################
# Gets all Error/Event Logs entries
##########################################################################
sub all {
    return( entries(@_) );
}
##########################################################################
# Gets all Error/Event Logs entries then clears the logs
##########################################################################
sub all_clear {
    my $result = entries( @_ );
    clear( @_);
    return( $result );
}
##########################################################################
# Gets and set network configuration
##########################################################################
sub netcfg
{
    my $exp     = shift;
    my $request = shift;
    my $id      = shift;
    
    ######################################
    # Parsing arg
    ######################################
    my $set_config = 0;
    my ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask) = ();
    my $real_inc_name = undef;
    if ( $request->{'method'}->{'network'})
    {
        $set_config = 1;
    }
    
    my $interfaces = undef;
    my $form = undef;
    
    my $res = get_netcfg( $exp, $request, $id, \$interfaces, \$form);
    return $res if ( $res->[0] == RC_ERROR);
		
    my $output = "";
    #######################################
    # Set configuration
    #######################################
    if ( $set_config)
    {
        return set_netcfg( $exp, $request, $interfaces, $form);
    }
    #######################################
    # Get configuration and format output
    #######################################
    else
    {
        return format_netcfg( $interfaces);
    }
    
}
##########################################################################
# Gets network configuration
##########################################################################
sub get_netcfg
{
    my $exp        = shift;
    my $request    = shift;
    my $id         = shift;
    my $interfaces = shift;
    my $form       = shift;
    my $ua         = @$exp[0];
    my $server     = @$exp[1];
	######################################
    # Get Network Configuration URL
    ######################################
    my $url = "https://$server/cgi-bin/cgi?form=$id";
    my $res = $ua->get( $url );
   
    ##################################
    # Return error
    ##################################
    if ( !$res->is_success() ) {
        return( [RC_ERROR,$res->status_line] );
    }
    ##################################
    # Get "Network Configuraiton" form 
    ##################################
    $$form = HTML::Form->parse( $res->content, $res->base );
    ##################################
    # Return error
    ##################################
    if ( !defined( $$form )) {
        return( [RC_ERROR,"'Network Configuration' form not found"] );
    } 
    ##################################
    # For some P6 machines
    ##################################
    if ( $$form->find_input('ip', 'radio', 1))
    {    
        my $ipv4Radio = $$form->find_input('ip', 'radio', 1);
        if (!$ipv4Radio)
        {
            print "Cannot find IPv4 option\n";
            exit;
        }
        #$ipv4Radio->check();
        my $data = $$form->click('submit');
        $res = $ua->request( $data);
        $$form = HTML::Form->parse( $res->content, $res->base );
        if ( !defined( $$form )) {
            return( [RC_ERROR,"'Network Configuration' form not found"] );
        } 
    } else {
        my $data = $$form->click('submit');
        $res = $ua->request( $data);
        $$form = HTML::Form->parse( $res->content, $res->base );
        if ( !defined( $$form )) {
            return( [RC_ERROR,"'Network Configuration' form not found' form not found"] );
        }
        if ( $$form->find_input('ip', 'radio', 1))
        {
            my $ipv4Radio = $$form->find_input('ip', 'radio', 1);
            if (!$ipv4Radio)
            {
                print "Cannot find IPv4 option\n";
                exit;
            }
            #$ipv4Radio->check();
    
            my $data = $$form->click('submit');
            $res = $ua->request( $data);
            $$form = HTML::Form->parse( $res->content, $res->base );
            if ( !defined( $$form )) {
                return( [RC_ERROR,"'Network Configuration' form not found"] );
            }
        }
     }    
    #######################################
    # Parse the form to get the inc input
    #######################################
    my $has_found_all = 0;
    my $i = 0;
    while ( not $has_found_all)
    {
        my $input = $$form->find_input( "interface$i", 'checkbox');
        if ( ! $input)
        {
            $has_found_all = 1;
        }
        else
        {
            $$interfaces->{"interface$i"}->{'selected'} = $input;
            $$interfaces->{"interface$i"}->{'type'}     = $$form->find_input("ip$i", 'option');
            $$interfaces->{"interface$i"}->{'hostname'} = $$form->find_input("host$i", 'text');
            $$interfaces->{"interface$i"}->{'ip'}       = $$form->find_input("static_ip$i", 'text');
            $$interfaces->{"interface$i"}->{'gateway'}  = $$form->find_input("gateway$i", 'text');
            $$interfaces->{"interface$i"}->{'netmask'}  = $$form->find_input("subnet$i", 'text');
            #we do not support dns yet, just in case of future support
            $$interfaces->{"interface$i"}->{'dns0'}     = $$form->find_input("dns0$i", 'text');
            $$interfaces->{"interface$i"}->{'dns1'}     = $$form->find_input("dns1$i", 'text');
            $$interfaces->{"interface$i"}->{'dns2'}     = $$form->find_input("dns2$i", 'text');
            $i++;
        }
    }
    return ( [RC_ERROR,"Cannot find any network interface on $server"]) if ( ! $$interfaces);
    
    return ( [SUCCESS, undef]);
}
##########################################################################
# Set network configuration
##########################################################################
sub set_netcfg
{
    my $exp         = shift;
    my $request     = shift;
    my $interfaces  = shift;
    my $form        = shift;
    my $ua          = @$exp[0];
    my $real_inc_name;
    my ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask) = split /,/, $request->{'method'}->{'network'};
    chomp ($inc_name, $inc_ip, $inc_host, $inc_gateway, $inc_netmask);
    if ( $inc_name =~ /^eth(\d)$/)
    {
        $real_inc_name = "interface$1";
    }
    elsif ( $inc_name =~/(\d+)\.(\d+)\.(\d+)\.(\d+)/)
    {
        for my $inc (keys %$interfaces)
        {
            if ($interfaces->{ $inc}->{'ip'}->value() eq $inc_name)
            {
                $real_inc_name = $inc;
                last;
            }
        }
    }
    else
    {
        return( [RC_ERROR, "Incorrect network interface name $inc_name"] );
    }
    return ( [RC_ERROR,"Cannot find interface $inc_name"]) if ( ! exists ($$interfaces{ $real_inc_name}));
    my $inc_type;
    my @set_entries = ();
    if ( $inc_ip eq '0.0.0.0')
    {
        $inc_type = 'Dynamic';
        push @set_entries, 'IP type to dynamic.';
    }
    elsif ( $inc_ip eq '*')
    {
        $inc_type = 'Static';
        ($inc_ip, $inc_host, $inc_gateway, $inc_netmask) = xCAT::Utils::getNodeNetworkCfg(@$exp[1]);
    }
    else
    {
        $inc_type = 'Static';
    }
#not work on AIX
#    $interfaces->{ $real_inc_name}->{'selected'}->check();
    my @tmp_options = $interfaces->{ $real_inc_name}->{'selected'}->possible_values();
    $interfaces->{ $real_inc_name}->{'selected'}->value(@tmp_options[1] );
    if ( $interfaces->{ $real_inc_name}->{'type'})
    {
        my @type_options = @{$interfaces->{ $real_inc_name}->{'type'}->{'menu'}};
	if (ref( $type_options[0]) eq 'HASH')
        {
            for my $typeopt ( @type_options)
            {
                if ( $typeopt->{'name'} eq $inc_type)
                {
                    $interfaces->{ $real_inc_name}->{'type'}->value($typeopt->{'value'});
                    last;
                }
            }
        }
        else #AIX made the things more complicated, it didn't ship the
             #last HTML::Form. So let's take a guess of the type value
             #Not sure if it can work for all AIX version
        {
            my @types = $interfaces->{ $real_inc_name}->{'type'}->possible_values();
            if ( $inc_type eq 'Dynamic')
            {
                $interfaces->{ $real_inc_name}->{'type'}->value(@types[0]);
            }
            else
            {
                $interfaces->{ $real_inc_name}->{'type'}->value(@types[1]);
            }
        }
#not work on AIX
#        $interfaces->{ $real_inc_name}->{'type'}->value('Static');
    }
    else
    {
        return ( [RC_ERROR,"Cannot change interface type"]);
    }
    if ( $inc_type eq 'Static')
    {
        if ( $inc_ip)
        {
            return ( [RC_ERROR,"Cannot set IP address to $inc_ip"]) if (! $interfaces->{ $real_inc_name}->{'ip'});
            $interfaces->{ $real_inc_name}->{'ip'}->value( $inc_ip);
            push @set_entries, 'IP address';
        }
        if ( $inc_host)
        {
            return ( [RC_ERROR,"Cannot set hostname to $inc_host"]) if (! $interfaces->{ $real_inc_name}->{'hostname'});
            $interfaces->{ $real_inc_name}->{'hostname'}->value( $inc_host);
            push @set_entries, 'hostname';
            if( ! $interfaces->{ $real_inc_name}->{'hostname'}->value())
            {
                $inc_host = $exp->[1];
            }
        }
        if ( $inc_gateway)
        {
            return ( [RC_ERROR,"Cannot set gateway to $inc_gateway"]) if (! $interfaces->{ $real_inc_name}->{'gateway'});
            $interfaces->{ $real_inc_name}->{'gateway'}->value( $inc_gateway);
            push @set_entries, 'gateway';
        }
        if ( $inc_netmask)
        {
            return ( [RC_ERROR,"Cannot set netmask to $inc_netmask"]) if (! $interfaces->{ $real_inc_name}->{'netmask'});
            $interfaces->{ $real_inc_name}->{'netmask'}->value( $inc_netmask);
            push @set_entries, 'netmask';
        }
    }
    #Click "Continue" button
    my $data = $form->click('save');
    my $res = $ua->request( $data);
    if (!$res->is_success())
    {
        return ( [RC_ERROR, "Failed to set " . join ',', @set_entries]);
    }
    #Go to the confirm page
    if ( $res->content !~ /\Qcontent;
        my @lines_to_print;
        for my $page_line (@page_lines)
        {
            chomp $page_line;
            if ( $page_line =~ s/
$//)
            {
                push @lines_to_print, $page_line;
            }
        }
        return ( [RC_ERROR,join "\n", @lines_to_print]);
    }
    $ua->timeout( 2 );
    $form = HTML::Form->parse( $res->content, $res->base );
    $data = $form->click('submit');
    $res = $ua->request( $data);
    ##############################################################
    # We cannot get the result of this update, since the network
    # is updated, the old URI is invalid anymore
    # Return success directory
    ##############################################################
    return ( [SUCCESS, "Success to set " . join ',', @set_entries]);
}
##########################################################################
# Format the output of network configuration
##########################################################################
sub format_netcfg
{
    my $interfaces  = shift;
    my $output      = undef;
    for my $inc ( sort keys %$interfaces)
    {
#improve needed: need to make the output consistent to MM            
        $output .= "\n\t" . $inc . ":\n";
        $output =~ s/interface(\d)/eth$1/;
        # There are 2 possible value for $type, 
        # the first means "Dynamic", 2nd means "Static"
        # Now to find the correct type name
	my $curr_type = $interfaces->{$inc}->{'type'}->value();
        my @possible_values = $interfaces->{$inc}->{'type'}->possible_values();
        my $type;
        if ($curr_type == @possible_values[0])
        {
            $type = "Dynamic";
        }
        else
        {
            $type = "Static";
        } 
#not work on AIX
        #my @possible_names  = $interfaces->{$inc}->{'type'}->value_names();
        #my %value_names = {};
        #for ( my $i = 0; $i < scalar( @possible_values); $i++)
        #{
        #    $value_names{ @possible_values[$i]} = @possible_names[$i];
        #}
        #my $type = $interfaces->{$inc}->{'type'} ? $value_names{ $interfaces->{$inc}->{'type'}->value()} : undef;;
        $type = "Static" if ( $type == 2);
        my $ip = $interfaces->{$inc}->{'ip'} ? $interfaces->{$inc}->{'ip'}->value() : undef;
        my $hostname = $interfaces->{$inc}->{'hostname'} ? $interfaces->{$inc}->{'hostname'}->value() : undef;
        my $gateway = $interfaces->{$inc}->{'gateway'} ? $interfaces->{$inc}->{'gateway'}->value() : undef;
        my $netmask = $interfaces->{$inc}->{'netmask'} ? $interfaces->{$inc}->{'netmask'}->value() : undef;
        $output .= "\t\tIP Type: "    . $type     . "\n";
        $output .= "\t\tIP Address: " . $ip       . "\n";
        $output .= "\t\tHostname: "   . $hostname . "\n";
        $output .= "\t\tGateway: "    . $gateway  . "\n";
        $output .= "\t\tNetmask: "    . $netmask  . "\n";
    }
    return( [SUCCESS,$output] );
}
1;