#!/usr/bin/perl
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
#  
#  
# Licensed Materials - Property of IBM 
#  
# (C) COPYRIGHT International Business Machines Corp. 2005,2007 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 
#
#####################################################################
#                                                                   #
# Module: licutil                                                   #
#                                                                   #
# Description: Executes Licensed Internal Code commands on an HMC.  #
#              Commands are build based on the stanza file that is  #
#              copied from the CSM management server.               #
#                                                                   #
# Inputs:                                                           #
#                                                                   #
#       Stanza file name                                            #
#                                                                   #
##################################################################### 
#
#
# "@(#)70   1.8   src/csm/hw/cmds/licutil.perl, csm.hardware, csm_rfish, rfishs001b 6/3/07 22:10:11"
#

#-------------------------------------------------------------------------#
# dprint                                                                  #
#-------------------------------------------------------------------------#
sub dprint {
    my ($dstring) = @_;

    if ( $::debug == 1 ) {
        ($sec, $min, $hour, $mday, $month, $year) = (localtime)[0,1,2,3,4,5];
        $month += 1;
        $year += 1900;

        $timestamp = sprintf( "%02d/%02d/%d %02d:%02d:%02d", $month, $mday, $year, $hour, $min, $sec );

        print DEBUGFILE "$timestamp $dstring";
    }
}


#-------------------------------------------------------------------------#
# subroutine to print usage statement                                     #
#-------------------------------------------------------------------------#
sub usage {
    MessageUtils->message('I', 'IMsgCsmlicutilUsage');
    exit (scalar(@_) ? $_[0] : 1);
}


#-------------------------------------------------------------------------#
# subroutine to validate input file                                       #
#-------------------------------------------------------------------------#
sub validate_file {
    
    # This routine analyzes the given file to ensure:
    # - it exists in the /tmp directory
    # - it is not a symbolic link to another file
    # - it is owned by "hscroot" user.
    #
    # The file must have all of these properties to be considered valid by this
    # script.  Otherwise, a message is returned and the script exits.
    #
    $in_file = $_[ 0 ];
    dprint "validate_file: file name is $in_file\n";
    
    ( $dummy1, $dir_path, $dummy2 ) = File::Spec->splitpath( $in_file, $::FALSE );
    dprint "validate_file: directory portion is $dir_path\n";
    
    # Does the file reside in /tmp?
    #
    if( ( $dir_path ne $::TMP_PATH_1 ) && ( $dir_path ne $::TMP_PATH_2  ) ) {
        dprint "validate_file: $in_file does not reside in /tmp\n";
        MessageUtils->message( 'E', 'EMsgInvalidFileLocation', $in_file );        
        exit 1;
    }
    
    dprint "validate_file: file resides in /tmp\n";
    
    ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime,
      $ctime, $blksize, $blocks ) = stat $in_file;
      
    dprint "validate_file: Number of hard links = $nlink\n";
    
    # Is the file a symbolic link?
    #
    if( ( -l $in_file ) || ( $nlink > 1 ) ) {
        dprint "validate_file: file is a symbolic link\n";
        MessageUtils->message( 'E', 'EMsgNoSymLink', $in_file );        
        exit 1;    
    }
    
    dprint "validate_file: file is not a symbolic link\n";
    
    # Is the file owner hscroot?
    #
    $uname = getpwuid $uid;
    chomp( $uname );

    dprint "validate_file: file owned by uid $uid, $uname\n";
    if( $uname ne $::HMC_USER ) {
        MessageUtils->message( 'E', 'EMsgInvalidFileOwner', $in_file );
        exit 1;
    }
    
    dprint "validate_file: file is owned by hscroot\n";
    return;  
}


#-------------------------------------------------------------------------#
# MAIN Main main                                                          #
#-------------------------------------------------------------------------#

# use strict;
BEGIN { $::csmpm = $ENV{'CSM_PM'} ? $ENV{'CSM_PM'} : '/opt/csm/pm'; }   # for development use
use lib $::csmpm;
use NodeUtils;
use MessageUtils;
use File::Spec;
use IO::File;
use IO::Select;
use Getopt::Long;
use POSIX qw( geteuid );

$::MSGCAT="nodecmds.cat";
$::MSGMAPPATH = '/opt/csm/msgmaps';
$::MSGSET= 'licutil';

$::HMC_USER = "hscroot";
$::HMC_ROOT_USER = "root";
$::TMP_PATH_1 = "/tmp";
$::TMP_PATH_2 = "/tmp/";
$::NUM_STANZA_FIELDS = 5;

chop(my $PROGNAME = `/bin/basename $0`);

# Newer versions of the HMC (GA7 SP7 or later, eClipz GA2 or later) will ship a
# symbolic link to this script called "csmlicutil".  This link will be located
# within the HMC restricted shell and can be called directly by dsh, without the
# need to be invoked by runlpcmd.  Some minor adjustments to the script
# are required if it is run under the restricted shell, so these are done
# here, if csmlicutil was the name of the command invoked.
#
if( $PROGNAME =~ /csmlicutil/ ) {
    # Checks case in GetOptions
    # 
    $Getopt::Long::ignorecase = 0;
    
    if ( !GetOptions( 'help' => \$::opt_help ) ) { 
        &usage( 1 );
    }
    
    if( ( $::opt_help ) ||
        ( $ARGV[ 0 ] eq "" ) ) {
        &usage( 0 );
    }
    
    # get the effective user id for the user invoking the script.  If it's not hscroot, abort
    #
    my $uid = geteuid;
    chomp( $uid );
    
    my $uname = getpwuid $uid;
    chomp( $uname );
    
    if( ( $uname ne $::HMC_USER ) &&
        ( $uname ne $::HMC_ROOT_USER ) ) {
        MessageUtils->message( 'E', 'EMsgInvalidUserName', $uname );
        exit 1;
    }
    
}

$::TRACE_FILE = "/var/log/csm/HC_LICUTIL_VERBOSE";
$::TRACE_FILE_NEW = "/tmp/HC_LICUTIL_VERBOSE";

$::LSLIC = "/usr/hmcrbin/lslic";
$::UPDLIC = "/usr/hmcrbin/updlic";

$::stanza_file = $ARGV[0];
@::stanzas = ();
@::read_array = ();

%::child_mtms = ();
%::commands = ();
%::read_handles = ();
%::write_handles = ();
%::fileno_hash;
%::code_files = ();

$::debug = 0;

my $debug_file;
my $command = "";
my $buffer;
my $sel;
my $read_handle;
my $write_handle;
my $pid;
my $mtms;

my $cmd;
my $MTMS;
my $option;
my $component;
my $rpm_name = undef;
my $xml_name = undef;

my $read_object;
my $file_number;
my $rh;
my $read_buffer;

my $command_complete;
my $opt;
my $hostname;

my $command_line;
my $opt_mtms;
my $opt_comp;
my $opt_task;
my $opt_code_level;
my $opt_code_source = "-r mountpoint -d /tmp";

my $switch_command_written = 0;

# if hidden file exists, set up debug
#
if ( ( -e $::TRACE_FILE ) || 
     ( -e $::TRACE_FILE_NEW ) ) {
    $::debug = 1;
    
    if( $PROGNAME =~ /csmlicutil/ ) {
        $DEBUG = "/tmp/debug_licutil.$$";
    } else {
        $DEBUG = "/var/log/csm/debug_licutil.$$";
    }

    unless ( open DEBUGFILE, ">$DEBUG" ) {
        MessageUtils->message('E', 'EMsgErrorOpeningFile', $DEBUG);
        exit (1);
    }

    #
    # Disable buffering on the debug file, to be sure all output
    # is printed when it's generated
    #
    $debug_file = select ( DEBUGFILE );
    $| = 1;
    select ( $debug_file );

    dprint "MAIN: Standard buffering disabled on $DEBUG\n";

    dprint "MAIN: $PROGNAME invoked\n";
    dprint "MAIN: Process ID is $$\n"; 
    if ( $ARGV[0] ) {
        dprint "MAIN: Stanza filename is $ARGV[ 0 ]\n";
    }
} else {
    $::debug = 0;
}

if( ! -s $::stanza_file ) {
    # The stanza file passed in either does not exist or has zero size
    #
    dprint "MAIN: Can't open stanza file\n";
    MessageUtils->message( 'E', 'EMsgCannotOpenStanzaFile', $::stanza_file );
    exit 1 ;
}

# validate the stanza file
#
dprint "MAIN: Validating stanza file\n";
&validate_file( $::stanza_file );

# open and read the stanza file
#
dprint "MAIN: Opening stanza file\n";
open STANZAFILE, "<$::stanza_file";
dprint "MAIN: reading stanza file\n";
@::stanzas = <STANZAFILE>;
dprint "MAIN: closing stanza file\n";
close STANZAFILE;

# Build the commands list based on the content of the stanza file
#
foreach my $line( @::stanzas ) {
    $command_line = "";
    $command = "";
    $opt_mtms = "";
    $opt_comp = "";
    $opt_task = "";
    $opt_code_level;

    $command_complete = 0;
    $cmd_args = "";
    
    # Skip this line if it contains whitespace or begins with a comment char.
    #
    next if( $line =~ /^#|^\s*$/ );
    
    dprint "MAIN: current stanza line is $line\n";
    
    $num_fields = scalar( split /::/, $line, $::NUM_STANZA_FIELDS );
    dprint "MAIN: Line splits into $num_fields fields\n";
    
    if( $num_fields != $::NUM_STANZA_FIELDS ) {
        # A valid stanza will always have a fixed number of fields, as defined
        # in the $::NUM_STANZA_FIELDS variable
        #
        dprint "MAIN: skipping malformed stanza\n";
        next;    
    }
    
    ( $cmd, $MTMS, $option, $component, $rpm_name ) = split /::/, $line, $::NUM_STANZA_FIELDS;
    chomp( $rpm_name );
    
    # The rpm and xml files will only be specified for updlic commands
    #
    if( ( $cmd eq "updlic" ) && ( ( $option ne "commit" ) && 
                                  ( $option ne "recover" ) ) ) {
        dprint "MAIN: Validating rpm file $rpm_name\n";
        &validate_file( $rpm_name );
        
        $xml_name = $rpm_name;
        $xml_name =~ s/(.+\.)rpm/\1xml/;
        
        dprint "MAIN: Validating xml file $xml_name\n";
        &validate_file( $xml_name );
            
        if( !exists( $::code_files{ $rpm_name } ) ) {
            $::code_files{ $rpm_name } = 1;
        }

        my( $dummy1, $dummy2, $abs_update ) = File::Spec->splitpath( $rpm_name, $::FALSE );
        dprint "MAIN: absolute rpm file name is $abs_update\n";
            
        # split the update file name into it's component parts
        #
        $abs_update =~ /(\w{4})(\d{3})_(\d{3})_(\d{3})\.rpm/;
            
        my $code_level = $3;
        $opt_code_level = "-l $code_level";
            
        dprint "MAIN: code level is $code_level\n";
    }
    
    dprint "MAIN: cmd = $cmd\n";
    dprint "MAIN: MTMS = $MTMS\n";
    dprint "MAIN: option = $option\n";
    dprint "MAIN: component = $component\n";
    dprint "MAIN: rpm_name = $rpm_name\n";

    if( $cmd eq "lslic" ) {
        $command = "$::LSLIC";
    } elsif( $cmd eq "updlic" ) {
        $command = "$::UPDLIC";
    }
    dprint "MAIN: command = $command\n";

    if( $MTMS ne "" ) {
        $opt_mtms = "-m $MTMS";
    }
    dprint "MAIN: opt_mtms = $opt_mtms\n";

    if( ( $component eq "" ) || 
        ( $component eq "syspower" ) ) {
        $opt_comp = "-t syspower";
    } elsif( $component eq "system" ) {
        $opt_comp = "-t sys";
    } elsif( $component eq "power" ) {
        $opt_comp = "-t power";
    } elsif( $component eq "switch" ) {
        # The rfwflash command may send more than one switch stanza, if the
        # BPAs being updated use different code update files.  The rpm file names
        # are saved in the code_files hash so they may be removed later, but
        # we only need to write a single switch update command.
        #
        if( !$switch_command_written ) {
            $hostname = NodeUtils->runcmd( "uname -n", -2 );
            $MTMS = "SWITCH_STANZA_" . $hostname;
            $opt_code_level = "-l latest";
            $opt_comp = "-w";
            $switch_command_written = 1;
        } else {
            next;
        }
    }
    dprint "MAIN: opt_comp = $opt_comp\n";

    if( $option eq "commit" ) {
        $opt_task = "-o c";
        if( $component ne "switch" ) {
            $opt_comp = "";
        }
    } elsif( $option eq "recover" ) {
        $opt_task = "-o r";
        if( $component ne "switch" ) {
            $opt_comp = "";
        }
    } elsif( $option eq "install" ) {
        $opt_task = "-o i $opt_code_level $opt_code_source";
    } elsif( $option eq "activate" ) {
        $opt_task = "-o a $opt_code_level $opt_code_source";
    } elsif( $option eq "upgrade" ) {
        $opt_task = "-o u $opt_code_source";
        if( $component ne "switch" ) {
            $opt_comp = "";
        }
    }
    dprint "MAIN: opt_task = $opt_task\n";

    $command_line = "$command $opt_mtms $opt_comp $opt_task";

    dprint "MAIN: pushing $command_line\n";
    $::commands{ $MTMS } = $command_line;    
}

# If there are no commands in the hash, there's no work to do.  Write a message
# and exit.
#
if( scalar( keys( %::commands ) ) == 0 ) {
    dprint "MAIN: Could not parse any commands from the stanza file\n";
    MessageUtils->message( 'E', 'EMsgStanzaHasNoWork', $::stanza_file );
    exit 1;
}

$command = "";

# Instantiate the select object
#
$read_object = IO::Select->new();

# Execute the commands in the list
#
foreach $mtms( sort keys %::commands ) {
    $read_handle = "RH_$mtms";
    $write_handle = "WH_$mtms";
    
    dprint "MAIN: current read handle is $read_handle\n";
    dprint "MAIN: current write handle is $write_handle\n";
    $::read_handles{ $mtms } = $read_handle;
    $::write_handles{ $mtms } = $write_handle;
    
    dprint "MAIN: Opening pipe\n";
    pipe( $read_handle, $write_handle );

    # Get the file number for this read handle and save it in a hash.  Also
    # add it to the known read objects (used for select).
    #
    $file_number = fileno( $read_handle );
    dprint "MAIN: File number $file_number associated with $read_handle\n";
    $::fileno_hash{ $file_number } = $read_handle;
    $read_object->add( $file_number );
    
    dprint "MAIN: Forking child process\n";
    if( $pid = fork ) {
        # Parent process.  Close write handle and add the child
        # pid to the hash
        #
        dprint "MAIN: Parent: spawned pid $pid\n";
        close $write_handle;
        $::child_mtms{ $mtms } = $pid;
    } elsif( $pid < 0 ) {
        # fork failed.  No memory will be available for message catalog, so just
        # write a message and exit
        #
        dprint "MAIN: Fork failed\n";
        print STDOUT "Fork failed\n";
        exit 1;
    } else {
        # Child process.  Close the read handle, and redirect STDOUT to our write
        # handle.  Finally, exec the command.
        #
        close $read_handle;
        
        # Disable buffering to be sure all output
        # is printed when it's generated
        #
        my $temp = select ( $write_handle );
        $| = 1;
        select ( $temp );
        
        open(STDOUT, ">&$write_handle");
        
        exec $::commands{ $mtms };
        
        # Exec never returns unless there's an error
        #
        
        my $errorstr = $@;
        MessageUtils->message( 'E', 'EMsgCannotExecCommand', $::commands{ $mtms }, $errorstr );
    }
}

dprint "MAIN: disable buffering on parent STDOUT\n";

# Disable buffering on the parent process STDOUT, to be sure all output
# is sent to dsh when it's generated
#
my $temp_so = select ( STDOUT );
$| = 1;
select ( $temp_so );

# Once all the processes are forked, begin checking the read handles for data.  Continue
# to read as long as we have entries in the fileno_hash.
#
dprint "MAIN: begin reading from processes\n";

while( scalar( keys( %::fileno_hash ) ) > 0 ) {
    # The can_read method from IO::Select is a shorthand form of the select call.  This command
    # will check the registered file handles and return any that have data available to be read
    # in an array.  The argument is the number of seconds the method will wait before returning
    # an empty array (meaning none of the registered handles had read data available).
    #
    @::read_array = $read_object->can_read( 1 );

    if( scalar( @::read_array ) > 0 ) {
        # At least one file handle has data.  Loop through the array and read the data
        # from the process
        #
        foreach $file_number( @::read_array ) {
            # Get the associated handle from the hash
            #
            $read_handle = $::fileno_hash{ $file_number };

            # Get the MTMS data from the handle name
            #
            my $work_rh = $read_handle;
            $work_rh =~ /RH_(.+)$/;
            $mtms = $1;

            $read_buffer = readline *$read_handle;

            # Check the buffer variable.  If the process at the other end of the pipe terminates,
            # the can_read method will be triggered for the associated handle, but a read will
            # return undefined.
            #
            if( !defined( $read_buffer ) ) {
                dprint "MAIN: EOF reached on $read_handle (MTMS is $mtms)\n";

                # Remove this entry from the hash
                #
                dprint "MAIN: removing hash entry\n";
                delete $::fileno_hash{ $file_number };

                # Remove this handle from the registered list
                #
                dprint "MAIN: removing read handle from select list\n";
                $read_object->remove( $file_number );

                # Wait on the defunct process to remove it from the process list
                #
                dprint "MAIN: waiting on child process $::child_mtms{ $mtms }\n";
                $pid = waitpid $::child_mtms{ $mtms }, 0; 

                # Get the status of the completed process and write it out
                #
                my $child_status = $? / 256;
                print STDOUT "$mtms: LIC_RC = $child_status\n";

                # close the read handle
                #
                dprint "MAIN: closing $read_handle\n";
                close $read_handle;
            } else {
                dprint "MAIN: Data read on $read_handle:\n";
                dprint "MAIN: buffer = $read_buffer\n";
                # Write the output
                #
                print STDOUT "$mtms: $read_buffer\n";
            }
        }
    }
}

dprint "MAIN: All child processes complete\n";
dprint "MAIN: Removing stanza file $::stanza_file\n";

unlink $::stanza_file;

dprint "MAIN: stanza file removed\n";

foreach $rpm_file( sort keys %::code_files ) {
    dprint "MAIN: checking for $rpm_file\n";
    if( $rpm_file ) {
        dprint "MAIN: $rpm_file exists\n";
        if( -s $rpm_file ) {
            dprint "MAIN: $rpm_file has non-zero size\n";
            # removing the rpm from the temporary directory
            #
            dprint "MAIN: Removing $rpm_file\n";
            unlink $rpm_file;
            
            # Also remove the corresponding xml file, if it exists
            #
            $xml_file = $rpm_file;
            $xml_file =~ s/(.+\.)rpm/\1xml/;
            
            dprint "MAIN: checking for $xml_file\n";
            if( -e $xml_file ) {
                dprint "MAIN: $xml_file exists\n";
                # removing the xml from the temporary directory
                #
                dprint "MAIN: Removing $xml_file\n";
                unlink $xml_file;
            }
        }
    }
}
dprint "MAIN: Finished\n";

if( $::debug ) {
    close DEBUGFILE;
}
