use Net::Domain qw(hostfqdn);
use strict;

################################################################################
# printHWInfo
# sub routine to print information about hardware on current host (required for
# rac provisioning) in simple xml form.
################################################################################
sub printHWInfo {
  print "<hwInfo>";
  print "<hostName name=\"".hostfqdn()."\" />";
  &printDiskInfo;
  &printNICInfo;
  &printDriveLetterInfo;
  print "</hwInfo>";
}

################################################################################
# printDiskInfo
# sub routine to print disk information in simple xml form.
################################################################################
sub printDiskInfo() {
  # get list of disks.
  my @diskpartOutput = &getDiskpartOutput ("list disk");
  return if (scalar(@diskpartOutput) < 1);

  # get output as records.
  my @disks = &getOutputRecords ($diskpartOutput[0]);
  return if (scalar(@disks) == 0);

  print "<disks>";

  # output elements are in form (Disk|Status|Size|Free|Dyn|Gpt)
  # get partition info for each disk.
  foreach (@disks) {
    # get partition list in disk.
    my @diskInfo = split /\|/;

    next if ($diskInfo[4] ne "");   # we're not interested in dynamic disks.

    # we have a non-dynamic disk here.
    my $disk = $diskInfo[0];

    # get disk details.
    @diskpartOutput =
      &getDiskpartOutput ("select $disk", "detail disk");
    next if (scalar(@diskpartOutput) < 2);

    # process output of second command.
    my $diskDetails = $diskpartOutput[1];

    # get disk id from output.
    my ($diskID) = ($diskDetails =~ /.*?\s+id\s*:(.*?)\n.*/i);
    $diskID =~ s/^\s+//;
    $diskID =~ s/\s+$//;

    # print disk info.
    my $freeSpaceInDisk = &getSizeInMB ($diskInfo[3]);
    my $diskNum = (split(/\s+/, $disk))[1];
    print "<disk"
      . " id=\"$diskID\""
      . " number=\"$diskNum\""
      . " freeSpace=\"$freeSpaceInDisk\""
      . ">";

    # get partition info.
    @diskpartOutput =
      &getDiskpartOutput ("select $disk", "list partition");
    if (scalar(@diskpartOutput) < 2) {
      print "</disk>";
      next;
    }

    # get output of second command as records.
    my @partitions = &getOutputRecords ($diskpartOutput[1]);

    # xml for partitions.
    my $partitionXML = "";
    my $decrement = 0;

    # output elements are in form (Partition|Type|Size|Offset)
    foreach (@partitions) {
      my @partitionInfo = split /\|/;

      if ($partitionInfo[1] !~ /logical/i) {  # this is not a logical partition.
        # there is ideally only one 'non-logical' partition
        # (the extended partition itself)
        $decrement++;
        next;
      }

      # ok, a logical partition. let us obtain details for this.
      my $partition = $partitionInfo[0];

      # get details.
      my $partitionSize = &getSizeInMB ($partitionInfo[2]);
      @diskpartOutput =
        &getDiskpartOutput ("select $disk",
            "select $partition",
            "detail partition");
      next if (scalar(@diskpartOutput) < 3);

      # get output of third command as records.
      my @partitionDetails = &getOutputRecords ($diskpartOutput[2]);

      # output elements are in form
      # (Volume|Ltr|Label|Fs (format)|Type (logical etc)|Size|Status|Info)
      next if (scalar (@partitionDetails) == 0);   # no detailed info available.

      # get fields.
      my @details = split (/\|/, $partitionDetails[0]);

      # correct partition number is the sequential logical-partition number
      # (extended-partition number must not be considered)
      my $partitionNum = (split(/\s+/, $partition))[1] - $decrement;
      my $driveLtr = $details[1];
      $driveLtr = "$driveLtr:" if ($driveLtr ne "");
      my $formatType = $details[3];

      # add partition info
      # (PartitionNum, Size (in MB), FormatType, DriveLtr).
      print "<partition"
        . " number=\"$partitionNum\""
        . " size=\"$partitionSize\""
        . " formatType=\"$formatType\""
        . " driveLetter=\"$driveLtr\""
        . " />";
    } # end partition loop.

    # end disk info.
    print "</disk>";

  } # end disk loop.

  print "</disks>";
}

################################################################################
# printNICInfo
# sub routine to print information about NICs on current host in simple xml
# form.
################################################################################
sub printNICInfo {
  my $cmdOutput;
  {
    local $/;
    undef $/;
    my $netShExe = $ENV{'systemroot'}."\\system32\\netsh.exe";
    die "Could not find netsh executable" if (! -e $netShExe);

    open (IN, "$netShExe interface ip show address |")
     or die "Cannot read netsh output: $?";
    $cmdOutput = <IN>;
    close IN;
  }
  my @interfaces = split("\n{2,}", $cmdOutput);
  return if (scalar(@interfaces) == 0);
  
  print "<interfaces>";
  foreach (@interfaces) {
    my ($interfaceName, $ipAddr, $subnetMask) =
      (/"(.*)".*?IP.*?:(.*?)\n.*?SubnetMask.*?:(.*?)\n.*/is);

    # trim values.
    $interfaceName =~ s/^\s+//;  $interfaceName =~ s/\s+$//;
    $ipAddr =~ s/^\s+//;  $ipAddr =~ s/\s+$//;
    $subnetMask =~ s/^\s+//;  $subnetMask =~ s/\s+$//;

    # replace special characters in interface name (& < > " ').
    $interfaceName =~ s/&/&amp;/g;
    $interfaceName =~ s/</&lt;/g;
    $interfaceName =~ s/>/&gt;/g;
    $interfaceName =~ s/"/&quot;/g;
    $interfaceName =~ s/'/&apos;/g;

    # get subnet using ipaddr and subnet mask.
    my @ipAddrArr = split("\\\.", $ipAddr);
    my @subnetMaskArr = split("\\\.", $subnetMask);
    my @subnetArr;
    for (my $i = 0; $i <= $#ipAddrArr; $i++) {
      push (@subnetArr, (int($ipAddrArr[$i]) & $subnetMaskArr[$i]));
    }
    my $subnet = join(".", @subnetArr);

    print "<interface"
      . " name=\"$interfaceName\""
      . " ipAddress=\"$ipAddr\""
      . " subnet=\"$subnet\""
      . " />";
  }
  print "</interfaces>";
}

################################################################################
# printDriveLetterInfo
# sub routine to print out information about used / available drive letters on
# this host (printed as XML element with comma-separated drive letters).
################################################################################
sub printDriveLetterInfo {
  # 1. get local drive info using diskpart.
  my @diskpartOutput = &getDiskpartOutput ("list volume");
  return if (scalar(@diskpartOutput) < 1);

  # get output as records.
  my @volumes = &getOutputRecords ($diskpartOutput[0]);
  return if (scalar(@volumes) == 0);

  # output elements are in form (Volume|DriveLtr|Label|Fs|Type|Size|Status|Info)
  # retrieve used letters.
  my %count;
  foreach (@volumes) {
    # get drive letter for volume.
    my @volumeInfo = split /\|/;
    my ($driveLetter) = uc ($volumeInfo[1]);
    if ($driveLetter =~ /(.*):/i) {  # remove trailing characters, if any.
      $driveLetter = $1;
    }
    # set count for this letter.
    $count{$driveLetter} = 1 if ($driveLetter ne "");
  }

  # 2. retrieve mapped drive info using 'net use'.
  my $netExe = $ENV{'systemroot'}."\\system32\\net.exe";
  die "Could not find net executable" if (! -e $netExe);

  open (NETUSE, "$netExe use |")
    or die "Cannot parse mapped drive information.";

  # read output of above command.
  my @output;
  @output = <NETUSE>;
  close NETUSE;

  # get mapped drive letters.
  foreach (@output) {
    $count{uc($1)} = 1 if (/.*?\s*([A-Za-z]):\s*.*?/i);
  }

  # 3. assign used / available drive letters.
  my @usedDriveLetters;
  my @availableDriveLetters;
  foreach ('A'..'Z') {
    my $driveLtr = "$_:";
    if ($count{$_} == 1) { push (@usedDriveLetters, $driveLtr); }
    else { push (@availableDriveLetters, $driveLtr); }
  }

  # 4. print necessary info.
  print "<driveLetters"
    . " usedLetters=\""
        . join(",", sort(@usedDriveLetters))
    . "\" availableLetters=\""
        . join(",", sort(@availableDriveLetters))
    . "\" />";
}

################################################################################
# getDiskpartOutput
# sub routine to retrieve output for a diskpart command.
# param : the diskpart command.
# return: an array representing all non-blank lines of output for the given cmd.
#         in case of multiple commands, the individual outputs are separated
#         by blank lines.
################################################################################
sub getDiskpartOutput {
  my (@diskpartCmds) = @_;
  my $tmp = $ENV{TEMP};  # temporary location.
  if ($tmp eq "") {
    $tmp = $ENV{TMP};
  }
  if ($tmp eq "") {
    $tmp = "C:\\temp";
  }
  my $tmpFile = "$tmp\\$$.out";   # for storing output.
  
  # execute diskpart.
  my $diskpartExe = $ENV{'systemroot'}."\\system32\\diskpart.exe";
  die "Could not find diskpart executable" if (! -e $diskpartExe);

  open (DISKPART, "| $diskpartExe > $tmpFile")
    or die "Cannot execute diskpart utility: $?";
  foreach my $diskpartCmd (@diskpartCmds) {
    print DISKPART "$diskpartCmd\n";
  }
  print DISKPART "exit\n";
  close DISKPART;

  # read output for the command executed.
  my $cmdOutput;
  {
    local $/;
    undef $/;
    open (IN, $tmpFile)
     or die "Cannot read diskpart output: $?";
    $cmdOutput = <IN>;
    close IN;
    unlink ($tmpFile);
  }

  my $prompt = "DISKPART>";

  # only store output between first and last prompts.
  $cmdOutput =~ s/.*?$prompt(.*)$prompt.*/$1/is;

  # trim output of blank lines.
  $cmdOutput =~ s/^\s*\n//gs;       # from start.
  $cmdOutput =~ s/\n\s*$//gs;       # from end.
  $cmdOutput =~ s/\n\s*\n/\n/gs;    # from between.

  # return output as an array (outputs are separated by prompts).
  return split(/\n\s*?$prompt\s*?\n/, $cmdOutput);
}

################################################################################
# getOutputRecords
# sub routine to retrieve records from the output of a diskpart command.
# param : the output as a string.
# return: an array, with each element representing fields in the output list.
#         the fields in the records are separated by a pipe (|).
################################################################################
sub getOutputRecords {
  my ($output) = @_;
  my @outArr = split("\n", $output);

  # get position of end of header.
  my $headerEndPos = &getHeaderEndIndex(@outArr);
  if ($headerEndPos == -1) {
    # no such output.
    @outArr = ();
    return @outArr;
  }

  # end of header represents field positions. so get field positions.
  my @fieldPosArr = &getFieldPositions($outArr[$headerEndPos]);

  # chop header from output.
  splice (@outArr, 0 , $headerEndPos + 1);
  for (my $i = 0; $i <= $#outArr; $i++) {
    my @out;      # temporary array to hold fields.

    for (my $j = 0; $j <= $#fieldPosArr; $j+=2) {
      # obtain field, trim it and add it to array.
      my $field = substr($outArr[$i], $fieldPosArr[$j], $fieldPosArr[$j+1]);
      $field =~ s/^\s+//;
      $field =~ s/\s+$//;
      push(@out, $field);
    }

    # separate fields with a pipe.
    $outArr[$i] = join("|", @out);
  }
  return @outArr;
}

################################################################################
# getHeaderEndIndex
# sub routine to retrieve end of header for a diskpart command output.
# param : the diskpart command output as an array (one element = one o/p line).
# return: the index of element representing the end of header,
#         -1 if there is no header.
################################################################################
sub getHeaderEndIndex {
  my (@disks) = @_;
  
  for (my $i = 0; $i <= $#disks; $i++) {
    return $i if ($disks[$i] =~ /^\s*(\s+\-+)*\s*$/);
  }
  return -1;
}

################################################################################
# getFieldPositions
# sub routine to compute starting positions and lengths of fields in a tabular
# diskpart output.
# param : a reference string consisting of '-'s representing fields and spaces
#         for the gaps between fields.
# return: an array of pairs of elements representing offset / length of each
#         field in the output.
################################################################################
sub getFieldPositions {
  my ($refStr) = @_;
  my @posArr;
  
  # field begins at '-' and ends before ' '.
  my $start = index($refStr, "-");
  my $end = index($refStr, " ", $start) if ($start != -1);
  while ($start != -1) {
    push(@posArr, $start);
    push(@posArr, $end - $start);
    $start = index($refStr, "-", $end);
    if ($start != -1) {
      $end = index($refStr, " ", $start);
      if ($end == -1) {
        # make 'end' point to one element after all the '-'s.
        for ($end = $start; $end <= length($refStr) && substr($refStr, $end, 1) == "-"; $end++) {}
      }
    }
  }
  return @posArr;
}

################################################################################
# getSizeInMB
# sub routine to return the size in MB, given a size string.
# param : a string in the form 'size unit'. where 'unit' is B, KB, MB or GB.
# return: the size, converted to MB.
################################################################################
sub getSizeInMB {
  my ($sizeStr) = @_;
  
  my ($size, $unit) = split (/\s+/, $sizeStr);
  return $size if ($size eq "" || $size == 0);
  
  if ($unit !~ /mb/i) {
    $size = "$size.0";
    if ($unit =~ /^b$/i) { $size = $size / 1000000; }
    elsif ($unit =~ /^kb$/i) { $size = $size / 1000; }
    elsif ($unit =~ /^gb$/i) { $size = $size * 1000; }
  }
  return $size;
}

############################# end of sub routines ##############################
&printHWInfo;