#!/usr/local/bin/perl
###########################################################################
##
## Simplified perl version of CPQLOCFG
## Version 3.00
##
## (C) Copyright 2002-2010 Hewlett Packard Development Company, L.P.
##
## To use this program, you must have Net::SSLeay and IO::Socket::SSL
## installed.  You may obtain these modules from http://www.cpan.org/
##
## You may use and modify this program to suit your needs.
##
###########################################################################

use Sys::Hostname;
#use IO::Socket::SSL qw(debug2);
use IO::Socket::SSL;
use Getopt::Long;
#use HTTP::Request::Common;

STDOUT->autoflush(1);      # Flush printf output

$Net::SSLeay::slowly = 5; # Add sleep so broken servers can keep up

###########################################################################
##
## Process options
##
###########################################################################

my $client;
my $host, $logfile, $file, $verbose, $help, $uname, $pword, $ilo2, $ilo3;
my $firmware, $firmwarelen, $firmwarebuf;
my $cookie;

$verbose = 0;

$r = GetOptions("server|s=s" => \$host,
                "logfile|l=s" => \$logfile,
                "input|f=s" => \$file,
                "u=s" => \$uname,
                "p=s" => \$pword,
                "verbose" => \$verbose,
                "help|?" => \$help,
                "ilo2" => \$ilo2,
                "ilo3" => \$ilo3
                );
#print "GetOptions returns = $r\n";

if (!$r) {
   # Unknown or ambiguous option(s)
   exit 1;
}

if ($help || !$host || !$file) {
    usage();
}

# Username and Password must be entered together
if( ($uname && !($pword)) || (!($uname) && $pword) ) {
    usage_err();
}

if ($ilo2 && $ilo3) {
    usage_err1();
}

if ($logfile) {
    # If a logfile is specified, open it and select it as the default
    # filehandle
    open(L, ">$logfile") || die "ERROR: Can't create logfile \"$logfile\"\n\n";
    select(L);
}

open(F, "<$file") || die "ERROR: Can't open inputfile \"$file\"\n\n";
my $filesize = -s $file;
print "\n----- Size of $file is $filesize\n" if ($verbose);

if ($ilo3) {
    # Size must be <= 10239 bytes for HTTP POST request
    if ($filesize >= 10240) {
        print "ERROR: Size of $file ($filesize bytes) is greater than 10239.\n\n";
        exit 1;
    }
}

# Set the default SSL port number if no port is specified
$host .= ":443" unless ($host =~ m/:/);

my $localhost = hostname() || 'localhost';
print "\n----- Localhost name is \"$localhost\".\n" if ($verbose);

if (!$ilo2 && !$ilo3) {
    # Detect whether $host is iLO 2 or iLO 3
    my ($sec,$min,$hour) = localtime(time);
    print "\n----- Start detecting iLO2/iLO3 at $hour:$min:$sec\n" if ($verbose);
    $client = new IO::Socket::SSL->new(PeerAddr => $host);
    if (!$client) {
        print "ERROR: Failed to establish SSL connection with $host.\n\n";
        exit 1;
    }

    print $client 'POST /ribcl HTTP/1.1' . "\r\n";
    print $client "HOST: $localhost" . "\r\n";      # Mandatory for http 1.1
    print $client "Content-length: 30" . "\r\n";    # Mandatory for http 1.1
    print $client 'Connection: Close' . "\r\n";     # Required
    print $client "\r\n";                           # End of http header
    #print $client "\r\n";
    print $client "<RIBCL VERSION=\"2.0\"></RIBCL>\r\n"; # Used by Content-length
    $ln=<$client>;    # Read first line of response
    if ($ln =~ m/HTTP.1.1 200 OK/) {
        print "\n----- Found iLO3\n" if ($verbose);
        $ilo3 = 1;                                  # It is iLO 3
    }
    else {
        print "\n----- Found iLO2 or iLO\n" if ($verbose);
        $ilo2 = 1;
    }
    while($ln=<$client> && length($ln)!=0) {};         # Empty responses
    $client->close();
    my ($sec,$min,$hour) = localtime(time);
    print "\n----- Finish detecting iLO2/iLO3 at $hour:$min:$sec\n" if ($verbose);
}

# Open the SSL connection and the input file
$client = new IO::Socket::SSL->new(PeerAddr => $host);
if (!$client) {
    print "ERROR: Failed to establish SSL connection with $host.\n\n";
    exit 1;
}

print "\n----- Cipher '" . $client->get_cipher() . "'\n" if ($verbose);

# One of $ilo2 and $ilo3 is true
if ($ilo2) {
    # Input file already opened
    # Send the XML header and begin processing the file
    print "\n----- Connected to iLO 2\n\n" if ($verbose);
    print $client '<?xml version="1.0"?>' . "\r\n";
    while($ln=<F>) {
        # Chomp of any EOL characters
        $ln =~ s/\r|\n//g;

        # Find LOGIN tag.
        if ((($ln =~m ?<[ 	]*LOGIN[ 	]?) || ($ln =~m ?<[ 	]*LOGIN$?)) && ($pword) && ($uname)) {
           while( !($ln =~ m/\>/i) ) {
              $ln = <F>;
           }
           print $client "<LOGIN USER_LOGIN=\"$uname\" PASSWORD=\"$pword\">\r\n";
           print "\n<LOGIN USER_LOGIN=\"$uname\" PASSWORD=\"$pword\">\n" if ($verbose);
           # print "\nOverriding credentials in scripts with those from command line.\n" if ($verbose);
           next;
        }

        # Special case: UPDATE_RIB_FIRMWARE violates XML.  Send the full
        # UPDATE firmware tag followed by the binary firmware image
        if ($ln =~ m/UPDATE_RIB_FIRMWARE/i) {
            if ($ln =~ m/IMAGE_LOCATION=\"(.*)\"/i) {
                $firmware = $1;
                open(G, "<$firmware") || die "ERROR: Can't open $firmware\n\n";
                $firmwarelen = (stat(G))[7];
                print $client "\r\n<UPDATE_RIB_FIRMWARE IMAGE_LOCATION=\"$firmware\" IMAGE_LENGTH=\"$firmwarelen\"/>\r\n";
                print "\r\n<UPDATE_RIB_FIRMWARE IMAGE_LOCATION=\"$firmware\" IMAGE_LENGTH=\"$firmwarelen\"/>\r\n" if ($verbose);
                $x = read(G, $firmwarebuf, $firmwarelen);
                print "Read $x bytes from $firmware\n" if ($verbose);
                $x = $client->write($firmwarebuf, $x);
                print "Wrote $x bytes\n" if ($verbose);
                close(G);
                next;
            }
            # print "\nERROR: syntax error detected in $ln\n" if ($verbose);
        }
        # Send the script to the iLO board
        print $ln . "\n" if ($verbose);
        print $client $ln . "\r\n" ;
    }
    close(F);

    print "----\n" if ($verbose);

    # Ok, now read the responses back from iLO
    while($ln=<$client>) {
        last if (length($ln) == 0);

        # This isn't really required, but it makes the output look nicer
        $ln =~ s/<\/RIBCL>/<\/RIBCL>\n/g;
        print $ln;
    }
    $client->close();

    # All done
    exit 0;
}  # end of iLO 2

# iLO 3
print "\n----- Connected to iLO 3\n\n" if ($verbose);

my $updateribfwcmd = 0;
my $boundary;
my $sendsize;

send_or_calculate(0);                                    # Calculate $sendsize

if (!$updateribfwcmd) {
    # Send the HTTP header and begin processing the file
    send_to_client(0, "POST /ribcl HTTP/1.1\r\n");
    send_to_client(0, "HOST: $localhost\r\n");           # Mandatory for http 1.1
    send_to_client(0, "TE: chunked\r\n");
    send_to_client(0, "Connection: Close\r\n");          # Required
    send_to_client(0, "Content-length: $sendsize\r\n");  # Mandatory for http 1.1
    send_to_client(0, "\r\n");
    send_or_calculate(1);  #Send it to iLO
}
else {
    # Send multipart
    # Send the firmware image file first
    my $body1, $body1size;                                  # multipart body
    my $body2, $body2size;                                  # multipart body
    my $body3, $body3size;                                  # multipart body
    my $sendsize_saved = $sendsize;

    $body1 = "--$boundary\r\n" .
             "Content-Disposition: form-data; name=\"fileType\"\r\n" . 
             "\r\n";
    $body1size = length($body1);
    $body2 = "\r\n--$boundary\r\n" .
             "Content-Disposition: form-data; name=\"fwimgfile\"; filename=\"$firmware\"\r\n" .
             "Content-Type: application/octet-stream\r\n" .
             "\r\n";
    $body2size = length($body2) + $firmwarelen;
    $body3 = "\r\n--$boundary--\r\n";                    # last boundary
    $body3size = length($body3);

    $sendsize=$body1size+$body2size+$body3size;

    send_to_client(0, "POST /cgi-bin/uploadRibclFiles HTTP/1.1\r\n");
    send_to_client(0, "HOST: $localhost\r\n");           # Mandatory for http 1.1
    send_to_client(0, "TE: chunked\r\n");
    send_to_client(0, "Connection: close\r\n");          # Required
    #send_to_client(0, "Connection: keep-alive\r\n");          # Required
    send_to_client(0, "Content-Length: $sendsize\r\n");
    send_to_client(0, "Content-Type: multipart/form-data; boundary=$boundary\r\n");
    send_to_client(0, "\r\n");                           # End of request header 

    send_to_client(1, $body1);

    send_to_client(1, $body2);
    # Send firmware
    $sentbytes = 0;
    #$sentblocksize = 1024*1024;
    $sentblocksize = 4*1024;
    printf "\nStart sending iLO 3 firmware (size: $firmwarelen bytes).\n";
    while ($sentbytes < $firmwarelen) {
       if (($firmwarelen - $sentbytes) >= $sentblocksize) {
           send_to_client(1, substr($firmwarebuf, $sentbytes, $sentblocksize));
           $sentbytes += $sentblocksize;
       }
       else {
           send_to_client(1, substr ($firmwarebuf, $sentbytes));
           $sentbytes += $firmwarelen - $sendbytes;           # done
       }
       printf "\r%10u bytes of firmware sent. (%3.2f%%)", $sentbytes, $sentbytes*100/$firmwarelen;
    }
    printf "\n\n";
    #send_to_client(1, $firmwarebuf);                    # send firmware
    #print "Wrote ". length($firmwarebuf) . " bytes of firmware.\n" if ($verbose);

    send_to_client(1, $body3);                    # last boundary

    if ($sendsize) {                              # should be zero
       print "Warning: Remaining sendsize = $sendsize\n";
    }
    while ($sendsize > 0) {
      print $client " "; print "~" if ($verbose);
      $sendsize--;
    }
    print "----- Responses -----\n" if ($verbose);

    $cookie = "";
    while($ln=<$client>) {                        # Empty responses
        last if (length($ln) == 0);
        if ($ln =~ m/^Set-Cookie: *RibclFlash=/i) {
            $cookie = $ln;
            $cookie =~ s/^Set-//;
            print "Found cookie = $cookie" if ($verbose);
        }
        print "----- $ln" if ($verbose);
    }
    print "\n----- End of responses -----\n" if ($verbose);
    $client->close();

    # Send XML script
    $client = new IO::Socket::SSL->new(PeerAddr => $host);
    if (!$client) {
        print "ERROR: Failed to establish SSL connection with $host for sending XML script.\n";
        exit 1;
    }
    $sendsize = $sendsize_saved;
    # Send the HTTP header and begin processing the file
    send_to_client(0, "POST /ribcl HTTP/1.1\r\n");
    send_to_client(0, "HOST: $localhost\r\n");           # Mandatory for http 1.1
    send_to_client(0, "TE: chunked\r\n");
    if ($cookie) {
        send_to_client(0, $cookie);
        $cookie = "";
    }
    send_to_client(0, "Connection: Close\r\n");          # Required
    send_to_client(0, "Content-length: $sendsize\r\n");  # Mandatory for http 1.1
    send_to_client(0, "\r\n");
    send_or_calculate(1);  #Send it to iLO
}

close(F);

print "\n----- Responses -----\n" if ($verbose);

# Ok, now read the responses from iLO
read_chunked_reply();

$client->close();

# All done
exit 0;

###########################
# subroutines starts here
###########################
sub usage
{
    print "Usage:\n";
    print "  locfg -s server [-l logfile] -f inputfile [-u username -p password] [-ilo2|-ilo3]\n";
    print "  Note: Use -u and -p with caution as command line options are\n";
    print "        visible on Linux.\n";
    exit 1;
}

sub usage_err
{
    print "Note:\n";
    print "  Both username and password must be specified with the -u and -p switches.\n";
    print "  Use -u and -p with caution as command line options are visible on Linux.\n";
    exit 1;
}

sub usage_err1
{
    print "Note:\n";
    print "  Both -ilo2 and -ilo3 can not be specified at same time.\n";
    exit 1;
}

sub send_to_client
{
    print $client $_[1]; if ($verbose && length($_[1]) < 1024) { print $_[1]; }
    if ($_[0]) {
        $sendsize -= length($_[1]);
    }
}

sub send_or_calculate    # used for iLO 3 only
{
  seek(F, 0, 0);         # Point to begining of the file
  $sendsize = 0;
  while($ln=<F>) {
    $ln =~ s/\r|\n//g;   # Chomp off any EOL characters

    # Find LOGIN tag.
    if ((($ln =~ /<[ \t]*LOGIN[ \t]/) || ($ln =~ /<[ \t]*LOGIN$/)) && ($pword) && ($uname)) {
       while( !($ln =~ m/\>/i) ) {
          $ln = <F>;
       }
       $ln="<LOGIN USER_LOGIN=\"$uname\" PASSWORD=\"$pword\">\n";
       $sendsize += length($ln);
       if ($_[0]) {
         print "\n" . $ln if ($verbose);
         print $client $ln;
       }
       print "\n----- Overriding credentials in scripts with those from command line.\n\n" if ($verbose);
       next;
    }

    if ($ln =~ m/UPDATE_RIB_FIRMWARE/i) {
        $updateribfwcmd = 1;
        if ($ln =~ m/IMAGE_LOCATION=\"(.*)\"/i) {
            $firmware = $1;
            if (!($firmware =~ m/\.bin$/i)) {
               die "ERROR: Firmware ($firmware) is not a \".bin\" file\n\n";
            }
            open(G, "<$firmware") || die "ERROR: Can't open $firmware\n\n";
            $firmwarelen = (stat(G))[7];
            $ln="\r\n<UPDATE_RIB_FIRMWARE IMAGE_LOCATION=\"$firmware\" IMAGE_LENGTH=\"$firmwarelen\"/>\r\n";
            $sendsize += length($ln);
            if ($_[0]) {           # Subroutine argument #1
                print "\n----- $ln" if ($verbose);
                print $client $ln;
            }
            if (! $_[0]) {         # firmware will be sent later
                $firmwarelen = read(G, $firmwarebuf, $firmwarelen);
                print "----- Read $firmwarelen bytes from $firmware\n\n" if ($verbose);
                # find boundary for multipart form POST
                $boundary = "------hpiLO3t";
                $randomnumber = int(rand(1000000));
                $boundary .= "$randomnumber" . "z";
                while ($firmwarebuf =~ /$boundary/) {
                   $randomnumber = int(rand(1000000));
                   $boundary .= "$randomnumber" . "z";
                }
                print "----- Boundary for multipart POST is $boundary\n\n" if ($verbose);
            }
            close(G);
            next;
        }
        # print "\n----- ERROR: syntax error detected in $ln\n" if ($verbose);
    }

    # Send the script to the iLO board
    if ($_[0]) {                   # Subroutine argument #1
      print $ln . "\n" if ($verbose);
      print $client $ln . "\r\n" ;
    }
    $sendsize += length($ln) + 2;
  }
}


sub read_chunked_reply    # used for iLO 3 only
{
  my $hide=1;
  my $isSizeOfChunk=1;
  my $chunkSize;
  while(1) {
    $ln=<$client>;
    if (length($ln) == 0) {
        print "read_chunked_reply: read a zero-length line. Continue...\n" if ($verbose);
        last;
    }
    if ($hide) {
        # Skip HTTP response headers and "\r\n"s preceding chunked responses
        if (length($ln) <= 2) {
            $hide=0;
        }
        #print $ln;                      #Print HTTP headers
    }
    else {
        # Process chunked responses
        if ($isSizeOfChunk) {
            $chunkSize=hex($ln);
            $isSizeOfChunk=0;
            #print $ln;                  #Print size of chunk
            next;
        }
        if ($chunkSize == 0) {           #End of responses; Empty responses
            print "read_chunked_reply: reach end of responses.\n" if ($verbose);
            last;
        }
        if ($chunkSize == length($ln)) {
            $isSizeOfChunk=1;
            $hide=1;                     #End of chunk; Skip next line
        }
        else {
            if ($chunkSize > length($ln)) {
                $chunkSize -= length($ln);
                #$ln = substr($ln,0,length($ln));
            }
            else {
                $isSizeOfChunk=1;        #Next line is size of next chunk
                $ln = substr($ln,0,$chunkSize);
            }
        }
        # This isn't really required, but it makes the output look nicer
        $ln =~ s/<\/RIBCL>/<\/RIBCL>\n/g;
        print $ln;
    }
  }
  if ($client->error()) {
     print "Error: connection error " . $client->error() . "\n";
  }
}
