@rem = '--*-Perl-*--
@echo off
SETLOCAL

set PERL32ONWIN64=0
set TEST_ARCH=x86

:: test if run with administrator privilege
set TEST_DIR="%PROGRAMFILES%\rtm-%RANDOM%"
mkdir %TEST_DIR% > nul 2> nul
if %ERRORLEVEL% == 0 (
  rmdir /q %TEST_DIR% > nul 2> nul
) else (
  rmdir /q %TEST_DIR% > nul 2> nul
  echo You do not have administrator privileges
  echo If you are running under Windows 2008, under file explorer click the right mouse button on %0 and select 'Run as administrator'
  msg %USERNAME% "You do not have administrator privileges. If you are running under Windows 2008, under file explorer click the right mouse button on %0 and select 'Run as administrator'"
  exit /b 1
)

:: test if Perl is available on the system
perl -v > nul 2> nul
if %ERRORLEVEL% == 9009 (
  echo You do not have Perl in your PATH.
  if "%PROCESSOR_ARCHITECTURE%" == "x86" (
    echo Please install ActivePerl for Windows x86 from http://www.activestate.com/activeperl/
    msg %USERNAME% "Please install ActivePerl for Windows x86 from http://www.activestate.com/activeperl/"
  ) else (
    echo Please install ActivePerl for Windows x64 from http://www.activestate.com/activeperl/
    msg %USERNAME% "Please install ActivePerl for Windows x64 from http://www.activestate.com/activeperl/"
  )
  exit /b 1
)

:: test for Perl and OS architecture
For /f "delims=" %%A in (
  'perl -V:archname'
) Do set "FOO=%%~A"
call set _endbit=%%FOO:*%TEST_ARCH%=%TEST_ARCH%%%
set PERL_ARCH=%_endbit:~0,3%
if "%PERL_ARCH%" == "%TEST_ARCH%" (
  if not "%PROCESSOR_ARCHITECTURE%" == "%TEST_ARCH%" (
    set PERL32ONWIN64=1
  )
)

:: in case when Perl x86 is installed on Windows x64,
:: we have to copy diskpart.exe built for x64 since we will
:: not have access to it later
set TEMPDISKPART="%TMP%\rtm-diskpart.exe_copy"
if "%PERL32ONWIN64%" == "1" (
  if not exist "%SYSTEMROOT%\SysWOW64\diskpart.exe" (
    copy /B /Y "%SYSTEMROOT%\system32\diskpart.exe" %TEMPDISKPART% > nul 2> nul
    if not "%ERRORLEVEL%" == "0" (
      echo "Cannot copy diskpart.exe"
      msg %USERNAME% "Cannot copy diskpart.exe"
      exit /b 1
    )
  )
)

:: run installer
if "%OS%" == "Windows_NT" goto WinNT
if "%PERL32ONWIN64%" == "1" (
  perl -x -S "%0" "--os-arch %PROCESSOR_ARCHITECTURE%" "--diskpart %TEMPDISKPART%" %1 %2 %3 %4 %5 %6 %7 %8 %9
) else (
  perl -x -S "%0" "--os-arch %PROCESSOR_ARCHITECTURE%" %1 %2 %3 %4 %5 %6 %7 %8 %9
)
goto endofperl
:WinNT
if "%PERL32ONWIN64%" == "1" (
  perl -x -S %0 --os-arch %PROCESSOR_ARCHITECTURE% --diskpart %TEMPDISKPART% %*
) else (
  perl -x -S %0 --os-arch %PROCESSOR_ARCHITECTURE% %*
)
goto endofperl
@rem ';
#!perl


use strict;
use File::Spec;
use File::Path qw/ mkpath rmtree /;
use File::Copy qw/ move /;
use Win32::OLE;
Win32::OLE->Option(Warn => 0);
use Win32::TieRegistry(qw/KEY_READ/);
use Win32::Shortcut;
use Win32;
use Config;
use Getopt::Long;

my $VERSION='0.9.6-2';
my $RELEASE_DATE='2012-01-04';

$ENV{LC_ALL} = 'POSIX';

my $PERL_ARCH = (split /-/, $Config{archname})[1];
my $ARCH;
my $DISKPART_PATH;
my $UNINSTALL_RTM = 0;
my $NO_POPUP = 0;
GetOptions(
  "os-arch=s"  => \$ARCH,
  "diskpart=s" => \$DISKPART_PATH,
  "u|uninstall" => \$UNINSTALL_RTM,
  "n|nopopup" => \$NO_POPUP,
) or die "Unrecognized options";

defined $ARCH && $ARCH ne ''
  or dieMsg("Architecture is not specified (use --os-arch option)");

# check for program files directory
-e $ENV{PROGRAMFILES} && -d $ENV{PROGRAMFILES}
  or dieMsg("Cannot determine 'Program Files' location");

my $DIR               = catfile($ENV{PROGRAMFILES}, 'ovh', 'rtm');
my $DIR_SCRIPTS_DAILY = catfile($DIR, 'scripts', 'daily');
my $DIR_SCRIPTS_MIN   = catfile($DIR, 'scripts', 'min');
my $DIR_SCRIPTS_HOUR  = catfile($DIR, 'scripts', 'hour');
my $DIR_BIN           = catfile($DIR, 'bin');
my $DIR_ETC           = catfile($DIR, 'etc');
my $DIR_LIB           = catfile($DIR, 'lib');
my $DIR_LIB_OVH       = catfile($DIR_LIB, 'OVH');
my $DIR_TMP           = catfile($DIR, 'tmp');

my $LOCK_FILE         = catfile($DIR_TMP, 'rtm.lock');

my $LSIUTIL_LINK       = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/LSIUtil.exe";
my $LSIUTIL_IA64_LINK  = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/LSIUtil_ia64.exe";
my $LSIUTIL_AMD64_LINK = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/LSIUtil_amd64.exe";
my $TWCLI_LINK         = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/tw_cli.exe";
my $TWCLI_64_LINK      = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/tw_cli_64.exe";
my $SMARTCTL_LINK      = "ftp://ftp.ovh.net/made-in-ovh/rtm/utils/windows/smartctl.exe";

my $DNSSERVER = "213.186.33.99";
my @SCRIPTS_TO_INSTALL = qw( kernel release usage usage_root hwinfo hwinfo_root hddinfo smart raid raid_daily listen_ports );

my $RTM_PL        = catfile($DIR_BIN, "rtm-${VERSION}.pl");
my $RTM_SH        = catfile($DIR_BIN, 'rtm.cmd');
my $RTM_UPDATE_IP = catfile($DIR_BIN, 'rtm-update-ip.pl');
#my $RTM_UNINSTALL = catfile($DIR_BIN, 'rtm-uninstall.pl');
my $RTM_UNINSTALL = catfile($DIR, '..', 'rtm-uninstall.cmd');
my $COMMON_LIB    = catfile($DIR_LIB_OVH, 'Common.pm');
my $TW_CLI_BIN    = catfile($DIR_BIN, 'tw_cli.exe');
my $LSIUTIL_BIN   = catfile($DIR_BIN, 'LSIUtil.exe');
my $SMARTCTL_BIN  = catfile($DIR_BIN, 'smartctl.exe');
my $GET_PROCESSES_OWNER_BIN = catfile($DIR_BIN, 'getProcessesOwner.vbs');
my $ELEVATE_VBS   = catfile($DIR_BIN, 'elevate.vbs');
my $ELEVATE_CMD   = catfile($DIR_BIN, 'elevate.cmd');
my $DISKPART_BIN  = 'diskpart.exe';

my $COMPUTERNAME = $ENV{COMPUTERNAME};
my $DEVNULL      = File::Spec->devnull;


print "OS architecture is $ARCH\n";
print "Perl is built for $PERL_ARCH\n";

# create tmp dir since we will need it soon
createDirectoryPath($DIR_TMP) unless -e $DIR_TMP;

# remove rtm from task scheduler
my @schedule_params_remove = (
  '/delete',
  '/f',                   # force deletion
  '/tn' => 'rtm',         # task name
);
print "Removing any previous rtm copies from task-scheduler...\n";
system("schtasks @schedule_params_remove >$DEVNULL 2>$DEVNULL");
dieMsg("Cannot remove rtm from task-scheduler") unless ($? >> 8 == 0 || $? >> 8 == 1);

until(lockProcess($LOCK_FILE)) {
  print "rtm is currently running, waiting till it's finished...\n";
  sleep 1;
}

# if -u option is specified -- uninstall
if ($UNINSTALL_RTM) {
  print "Uninstalling rtm...\n";
  unlockProcess($LOCK_FILE);
  removeDirectoryPath($DIR);
  print "\nRTM has been successfully uninstalled\n";
  exit 0;
}

# remove old script dirs
print "Removing old scripts directory structure...\n";
for my $dir ($DIR_SCRIPTS_DAILY, $DIR_SCRIPTS_MIN, $DIR_SCRIPTS_HOUR) {
  next unless -e $dir;
  removeDirectoryPath($dir);
}

# create required directories
print "Creating directory structure...\n";
for my $dir ($DIR, $DIR_SCRIPTS_DAILY, $DIR_SCRIPTS_MIN, $DIR_SCRIPTS_HOUR, $DIR_BIN, $DIR_ETC, $DIR_LIB, $DIR_LIB_OVH, $DIR_TMP) {
  createDirectoryPath($dir);
}

# this only applies when running 32bit Perl on 64bit Windows
# copy diskpart.exe to self bin dir
if (($ARCH eq 'AMD64' or $ARCH eq 'IA64') and $PERL_ARCH ne 'x64' and -e $DISKPART_PATH) {
  $DISKPART_BIN = catfile($DIR_BIN, 'diskpart.exe');
  dieMsg("Cannot get a copy of diskpart.exe")
    unless -e $DISKPART_PATH;
  move($DISKPART_PATH, $DISKPART_BIN)
    or dieMsg("Cannot copy '$DISKPART_PATH' to '$DISKPART_BIN': $!");
}

# get lsiutil for LSI RAID
print "Fetching LSIutil.exe from ftp...\n";
if ($ARCH eq 'AMD64') {
  getFromFtp($LSIUTIL_AMD64_LINK, $LSIUTIL_BIN);
} elsif ($ARCH eq 'x86') {
  getFromFtp($LSIUTIL_LINK, $LSIUTIL_BIN);
} else {
  getFromFtp($LSIUTIL_IA64_LINK, $LSIUTIL_BIN);
}

# get tw_cli for 3ware RAID
print "Fetching tw_cli.exe from ftp...\n";
if ($ARCH eq 'x86') {
  getFromFtp($TWCLI_LINK, $TW_CLI_BIN);
} else {
  getFromFtp($TWCLI_64_LINK, $TW_CLI_BIN);
}

# get smartctl for SMART and disk temperature
print "Fetching smartctl.exe from ftp...\n";
getFromFtp($SMARTCTL_LINK, $SMARTCTL_BIN);

# check all binaries if they are running
for my $bin ("\"$SMARTCTL_BIN\" -h", "\"$LSIUTIL_BIN\" -b", "\"$TW_CLI_BIN\" info") {
  print "Testing \'$bin\'...\n";
  system("$bin > $DEVNULL 2>&1");
  dieMsg("Received non-zero exit status for $bin")
    unless $? >> 8 == 0;
}

# check for raid controllers and leave only required binaries
print "Checking for LSI RAID controller...";
unless (_has_LSI()) {
  print "not detected\n";
  unlink $LSIUTIL_BIN
    or dieMsg("Cannot delete $LSIUTIL_BIN");
} else {
  print "detected\n";
}
print "Checking for 3ware RAID controller...";
unless (_has_3ware()) {
  print "not detected\n";
  unlink $TW_CLI_BIN
    or dieMsg("Cannot delete $TW_CLI_BIN");
} else {
  print "detected\n";
}

my $user = '"NT AUTHORITY\SYSTEM"';

# install all scripts
no strict 'refs';
for my $script (@SCRIPTS_TO_INSTALL) {
  my $function = "generate_$script";
  eval { &$function() };
  dieMsg("Cannot generate $script: $@") if $@;
}
use strict 'refs';

generate_rtm();
generate_rtm_update_ip();
generate_Common();
generate_getProcessesOwner();
generate_elevate();
generate_elevate_wrapper();

# generate wrapper executer
print "Generating wrapper for rtm...\n";
open my $wrapper_fh, '>', $RTM_SH
  or dieMsg("Cannot open $RTM_SH for writing");
print $wrapper_fh <<EOF;
\@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl "$RTM_PL" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl "$RTM_PL" %*
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
EOF
close $wrapper_fh;

# get WMI object
my $objWMI = getWMI();
my $osCol = $objWMI->ExecQuery('SELECT Version FROM Win32_OperatingSystem');
my ($version_major, $version_minor, $version_build) = (in $osCol)[0]->Version =~ /^(\d+)\.(\d+)\.(\d+)$/;

# run rtm at scheduled time
my $update_ip_min = int(rand(59)); # update ip at this minute of 'daily' hour
my @schedule_params = (
  '/create',
  '/f',                   # force creation overwriting any previous tasks
  '/s'  => $COMPUTERNAME, # system name
  '/sc' => 'minute',      # schedule (every minute)
  '/tn' => 'rtm',         # task name
  '/tr' => "\"\\\"$RTM_SH\\\" $update_ip_min\"", # executable path and params
  '/ru' => $user,         # run-as user
);

push @schedule_params, ('/rl' => 'HIGHEST')
  if $version_major >= 6;

print "Adding rtm to task-scheduler...\n";
system("schtasks @schedule_params >$DEVNULL 2>&1");
dieMsg("Cannot schedule task") if ($? >> 8);

print "Adding rtm start menu entries...\n";
# get "start_menu/programs" path
my $registry = Win32::TieRegistry->new('CUser\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\User Shell Folders\\', { Access => KEY_READ() })
  or dieMsg("Error accessing registry key 'CUser\\Software\\Microsoft\\Windows\\CurrentVersion\\Explorer\\User Shell Folders\\' : $^E");
my $PROGRAMS_DIR = $registry->GetValue('Programs');
# evaluate cmd.exe env variables
chomp($PROGRAMS_DIR = `echo $PROGRAMS_DIR`);
$PROGRAMS_DIR = catfile($PROGRAMS_DIR, 'OVH', 'rtm');

my $START_MENU_RTM = catfile($PROGRAMS_DIR, 'rtm.lnk');
my $START_MENU_UNINSTALL = catfile($PROGRAMS_DIR, 'Uninstall.lnk');

# create start menu entry dir
createDirectoryPath($PROGRAMS_DIR)
  unless -e $PROGRAMS_DIR;
if (-e $START_MENU_RTM) {
  unlink $START_MENU_RTM
    or dieMsg("Cannot remove existing schortcut menu entry");
}

# create rtm shortcut
my $rtm_shortcut = Win32::Shortcut->new();
$rtm_shortcut->{Description} = 'Run rtm';
$rtm_shortcut->{ShowCmd} = SW_SHOWNORMAL;
if ($version_major >= 6) {
  $rtm_shortcut->{Path} = $ELEVATE_CMD;
  $rtm_shortcut->{WorkingDirectory} = $DIR_BIN;
  $rtm_shortcut->{Arguments} = "\"$RTM_SH\"";
} else {
  $rtm_shortcut->{Path} = singleBackslash($RTM_SH);
  $rtm_shortcut->{WorkingDirectory} = singleBackslash($DIR_BIN);
}
$rtm_shortcut->Save($START_MENU_RTM);
$rtm_shortcut->Close();

# create uninstall shortcut
my $uninstall_shortcut = Win32::Shortcut->new();
$uninstall_shortcut->{Description} = 'Uninstall rtm';
$uninstall_shortcut->{ShowCmd} = SW_SHOWNORMAL;
if ($version_major >= 6) {
  $uninstall_shortcut->{Path} = $ELEVATE_CMD;
  $uninstall_shortcut->{Arguments} = "\"$RTM_UNINSTALL\"";
  $uninstall_shortcut->{WorkingDirectory} = File::Spec->rootdir();
} else {
  $uninstall_shortcut->{Path} = $RTM_UNINSTALL;
}
$uninstall_shortcut->Save($START_MENU_UNINSTALL);
$uninstall_shortcut->Close();

# generate uninstall script
generate_rtm_uninstall();

# update IP
print "Updating IP...\n";
system('perl', $RTM_UPDATE_IP);
dieMsg("Error while running $RTM_UPDATE_IP") if ($? >> 8);

unlockProcess($LOCK_FILE);
my $tmp_count = 0;
while (-e $LOCK_FILE) {
  print "Waiting for unlock...\n";
  dieMsg("Cannot unlock installer") if $tmp_count++ > 5;
  sleep 1;
}

# try to run rtm
print "Initial run...\n";
system($RTM_SH);
dieMsg("Error while trying to run $RTM_SH") if ($? >> 8);

 print "\nRTM has been successfully installed\n";

exit 0;

sub dieMsg {
    msg(@_) unless $NO_POPUP;
    die @_;
}

sub msg {
    my (%options, $msg);

    %options = (
        icon => MB_ICONSTOP,
        addCopyInfo => 1,
    );
    if (ref $_[0] eq 'HASH') {
        my $params = shift;
        $options{$_} = $params->{$_} for keys %$params;
    }
    $msg .= $_ for @_;

    $msg = "[To copy contents of this window press CTRL+C when it has focus].\n".$msg
        if $options{addCopyInfo};

    Win32::MsgBox($msg, $options{icon});
}

sub catfile {
  my $string = File::Spec->catfile(@_);
  $string =~ s/\\{1}/\\\\/g; # ugly hack, so that scripts get \\ in paths
  return $string;
}

sub singleBackslash {
  $_[0] =~ s/\\{2,}/\\/g;
  return $_[0];
}

sub generatePassword {
  my $params       = shift;
  my $length       = $params->{length} || 10;
  my $allowedChars = $params->{allowedChars} || qr/[a-zA-Z0-9_!#$%]/;
  my $username     = $params->{username};

  # windows policy requires password to match minimum 3 of the regex groups
  my @requiredRegexes = ( qr/[a-z]/, qr/[A-Z]/, qr/[0-9]/, qr/[_!#$%]/ );
  my $reqRegCount;
  my $password;

  do {
    $password = ''; 

    # generate a random string
    do {
      my $char = chr(int(rand(127)));
      $password .= $char if $char =~ $allowedChars;
    } until length $password == $length;
    
    $reqRegCount = 0;
    for my $regex (@requiredRegexes) {
      $reqRegCount++ if $password =~ $regex;
    }

    # password cannot contain username
    if ($password =~ $username) {
      $reqRegCount = 0;
    }

  } until ($reqRegCount >= 3);

  return $password;
}

sub getFromFtp {
  require File::Basename;
  require Net::FTP;
  require URI;

  my $url  = shift || dieMsg("No URL specified");
  my $path = shift || dieMsg("No destination path specified");

  die "Destination directory does not exist"
    unless -e File::Basename::dirname($path);

  $url = URI->new($url);

  my $ftp = Net::FTP->new( $url->host )
    or dieMsg("Cannot connect to $url->host: $@");
  $ftp->login('anonymous', '-anonymous@')
    or dieMsg("Cannot login to ftp: ".$ftp->message);
  $ftp->binary
    or dieMsg("Cannot set binary mode: ".$ftp->message);
  $ftp->get($url->path, $path)
    or dieMsg("Cannot download from ftp: ".$ftp->message);

  return 1;
}

sub getLocalAdministratorsGroup {
  my $objWMI = getWMI();

  my $colGroup = $objWMI->ExecQuery('SELECT Name FROM Win32_Group WHERE SID="S-1-5-32-544"');
  scalar (in $colGroup) > 0
    or return undef;
  return (in $colGroup)[0]->Name;
}

sub removeDirectoryPath {
  my $dir = shift 
    or dieMsg("No directory specified");
  return 1 unless -e $dir;
  eval { rmtree($dir, 0) };
  dieMsg("Cannot remove directory tree '$dir': $@")
    if $@;
  dieMsg("Cannot remove directory tree '$dir'")
    if -e $dir;

  return 1;
}

sub createDirectoryPath {
  my $dir = shift 
    or dieMsg("No directory specified");
  eval { mkpath($dir, 0) };
  dieMsg("Cannot create directory tree '$dir': $@")
    if $@;
  dieMsg("Cannot create directory tree '$dir'")
    unless -e $dir;

  return 1;
}

sub getWMI {
  require Win32::OLE;

  my %options = (
  	namespace => 'root\\cimv2',
  	machine   => '.',
  	warn      => 0,
  );

  my %options_override = @_;

  # override default options
  $options{$_} = $options_override{$_} for keys %options_override;

  my $objWMI = Win32::OLE->GetObject('winmgmts:\\\\' . $options{machine} . '\\' . $options{namespace})
  	or dieMsg("FATAL: ".Win32::OLE->LastError());

  return $objWMI;
}

sub lockProcess {
  my $lockFile = shift || dieMsg("No lock file specified");
  my $objWMI = getWMI();
  
  my $pid = $$;

  if (-e "$lockFile") {
    open(LOCKFILE, $lockFile) or dieMsg("Impossible to open lock file: $lockFile !!!");
    my $lockPID=<LOCKFILE> || "";
    close(LOCKFILE);

    if ($lockPID !~ m/^\d+$/ ) {
      warn("There is no PID in lock. Something is broken...");
      return undef
    }
    my $procCol = $objWMI->ExecQuery("SELECT ProcessId FROM Win32_Process WHERE ProcessId = \'$lockPID\'");

    if (scalar(in $procCol) > 0) {
      return 0;
    }
    warn("There is a lock file $lockFile, but no process for it. Overwritting lock file");
  }

  open(LOCKFILE, ">$lockFile")  or dieMsg("Impossible to open lock file for writting: $lockFile !!!");
  print LOCKFILE $pid;
  close(LOCKFILE);

  return 1;
}

sub unlockProcess {
    my $lockFile = shift || dieMsg("No lock file specified");
    unlink($lockFile)
      or warn "Cannot delete lock file: $!";
}

sub _has_LSI {
  my ($has_lsi) = (`\"$LSIUTIL_BIN\" -b` =~ /^\s*(\d+)\s+MPT Port(?:s)? found/m);
  return int($has_lsi);
}

sub _has_3ware {
  my $has_3ware = grep { /^c\d\s+/ } `\"$TW_CLI_BIN\" info`;
  return $has_3ware;
}

# 
# Generate \scripts\day\kernel.pl file
sub generate_kernel {
    print "Generating $DIR_SCRIPTS_DAILY\\kernel.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_DAILY\\kernel.pl"
        or die "Cannot open $DIR_SCRIPTS_DAILY\\kernel.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

# get WMI object
my $objWMI = getWMI();

my $osCol = $objWMI->ExecQuery('SELECT * FROM Win32_OperatingSystem');
my $objOs = (in $osCol)[0]
  or die "Cannot get Win32_OperatingSystem object from WMI";

print "dINFO_KERNEL_release|".$objOs->BuildNumber."\n";
print "dINFO_KERNEL_version|".$objOs->Version."\n";
EOF
close $fh;
}

# 
# Generate \scripts\day\release.pl file
sub generate_release {
    print "Generating $DIR_SCRIPTS_DAILY\\release.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_DAILY\\release.pl"
        or die "Cannot open $DIR_SCRIPTS_DAILY\\release.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

# get WMI object
my $objWMI = getWMI();

my $osCol = $objWMI->ExecQuery('SELECT * FROM Win32_OperatingSystem');
my $objOs = (in $osCol)[0]
	or die "Cannot get Win32_OperatingSystem object from WMI";

print "dINFO_RELEASE_os|".$objOs->Caption."\n";
EOF
close $fh;
}

# 
# Generate \scripts\day\raid-daily.pl file
sub generate_raid_daily {
    print "Generating $DIR_SCRIPTS_DAILY\\raid-daily.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_DAILY\\raid-daily.pl"
        or die "Cannot open $DIR_SCRIPTS_DAILY\\raid-daily.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;

my $MAX_FORKS = 3;

EOF
    print $fh "my \$TWCLI = '$TW_CLI_BIN';\n";
    print $fh <<'EOF';
my @twCliInfo = `\"$TWCLI\" info`;
my @controlers = ();
foreach my $line (@twCliInfo) {
  push @controlers, $1 if $line =~ /^c(\d+)\s+/;
}
foreach my $controler (@controlers) {
  my %units = ();
  @twCliInfo = `\"$TWCLI\" info c$controler`;
  foreach my $line (@twCliInfo) {
    if ( $line =~ m/^p(\d)\s+([^\s]+)\s+u([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)/) {
      push @{$units{$3}}, $1 if $2 ne "NOT-PRESENT";
    }
  }
  foreach my $unit (keys %units) {
    my $n_forked = 0;
    my @units = @{$units{$unit}};
    while (@units > 0) {
      my $phys = pop @units;
      my $pid = fork();
      die "cannot fork: $!" if $pid > 0;
      if ($pid == 0) {
        my $line = `\"$TWCLI\" info c$controler p$phys model`;
        $line =~ m/Model\s=\s(.+)/;
        print "dHW_SCSIRAID_PORT_c$controler\_u$unit\_phy$phys\_model|$1\n";
        exit();
      }

      ++$n_forked;
      if ($n_forked > $MAX_FORKS || @units == 0) {
        while (waitpid(-1, 0) > 0) {}
        $n_forked = 0;
      }
    }
  }
}
EOF
close $fh;
}

# 
# Generate \scripts\hour\raid.pl file
sub generate_raid {
    print "Generating $DIR_SCRIPTS_HOUR\\raid.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_HOUR\\raid.pl"
        or die "Cannot open $DIR_SCRIPTS_HOUR\\raid.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI normalize_number /;
use File::Temp 'tempfile';

EOF
    print $fh "my \$lsiutil_bin = '$LSIUTIL_BIN';\n";
    print $fh "my \$twcli_bin   = '$TW_CLI_BIN';\n";
    print $fh "my \$diskpart_bin = '$DISKPART_BIN';\n";
    print $fh <<'EOF';

# get WMI object
my $objWMI = getWMI();

my ($line, @mptInfo, @twCliInfo, $controler);

my $hasLSI      = _has_LSI();
my $has3ware    = _has_3ware();
my $hasSoftRaid = _has_soft_raid();

if ($hasSoftRaid) {
  my @volumes = diskpart('list volume')
    or die "Cannot get volumes from diskpart";

  # WARNING: do NOT use volume_nr, it is just an enumeration index that diskpart uses - it can differ between calls
  @volumes = parse_diskpart_output({
    input => \@volumes,
    headers => [ qw/volume_nr letter label filesystem type size status flags/ ],
  }) or die "Cannot parse diskpart output";

  # get only dynamic volumes
  @volumes = grep { $_->{type} =~ /^mirror|spanned|stripe|raid-5$/i } @volumes;
  
  my %status_map = (
    'healthy' => 'OK',
    'failed'  => 'FAILED',
    'rebuild' => 'RESYNC',
  );

  # XXX for future use
  my %type_map = (
    'raid-5'  => 'raid5',
    'mirror'  => 'raid1',
    'stripe'  => 'raid0',
    'spanned' => '',
  );

  my $logicalDiskCol = $objWMI->ExecQuery('SELECT * FROM Win32_LogicalDisk');
  my $logicalDiskToPartitionCol = $objWMI->ExecQuery('SELECT * FROM Win32_LogicalDiskToPartition');

  for my $volume (@volumes) {
    # normalize status
    $volume->{status} = $status_map{lc $volume->{status}}
      if defined $status_map{lc $volume->{status}};
    $volume->{letter} =~ s/^([a-zA-Z]):?$/$1:/;
    
    # get WMI object for logical disk
    my $objLogicalDisk = (grep { $_->DeviceID eq $volume->{letter} } (in $logicalDiskCol))[0];
 
    # get chunks spread around disks which form this volume
    my %phys;
    $volume->{chunks} = [];
    for my $mapObj (grep { $_->Dependent =~ /=\S+$volume->{letter}\S+$/ } (in $logicalDiskToPartitionCol)) {
      my ($diskId, $partitionId) = $mapObj->Antecedent =~ /Disk #(\d+), Partition #(\d+)/;
      my $phyId     = 'Disk#'.$diskId.'Partition#'.$partitionId;
      my $chunkSize = $mapObj->EndingAddress - $mapObj->StartingAddress;
      $phys{$phyId}++;
      push @{$volume->{chunks}}, {
        disk => $phyId,
        size => $chunkSize,
      };
    }
    $volume->{phys} = scalar keys %phys;

    # size from WMI is always in bytes
    $volume->{size} = $objLogicalDisk->Size;
    # diskpart cuts label when too long, so we get it from WMI
    $volume->{label} = $objLogicalDisk->VolumeName;
  }

  for my $volume (@volumes) {
    my $volumeId = ($volume->{letter} =~ /^([a-zA-Z]):$/)[0];
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_letter|%s\n"   , $volumeId , $volume->{letter};
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_label|%s\n"    , $volumeId , $volume->{label};
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_type|%s\n"     , $volumeId , uc $volume->{type};
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_status|%s\n"   , $volumeId , $volume->{status};
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_capacity|%s\n" , $volumeId , normalize_number($volume->{size}, force_unit=>'GB');
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_phys|%s\n"     , $volumeId , $volume->{phys};
    printf "hHW_SCSIRAID_UNIT_%s_vol-0_chunks|%s\n"   , $volumeId , scalar @{$volume->{chunks}};

    my $chunkCount = 0;
    for my $chunk (@{$volume->{chunks}}) {
      printf "hHW_SCSIRAID_PORT_%s_vol-0_chunk_%s_capacity|%s\n" , $volumeId , $chunkCount , normalize_number($chunk->{size}, force_unit=>'GB');
      printf "hHW_SCSIRAID_PORT_%s_vol-0_chunk_%s_disk|%s\n"     , $volumeId , $chunkCount , $chunk->{disk};
      $chunkCount++;
    }
  }
}

# 3Ware
if ($has3ware) {
  my (%units, @controlers);

  my $TWCLI = $twcli_bin;
  if ($TWCLI ne "") {
    @twCliInfo = `\"$TWCLI\" info`;
    foreach $line (@twCliInfo) {
      if ($line =~ m/Controller (\d+):/ || $line =~ /^c(\d+).*$/)  { push @controlers, $1;}
    }
    foreach $controler (@controlers) {
      @twCliInfo = `\"$TWCLI\" info c$controler`;
      foreach $line (@twCliInfo) {
        if ( $line =~ m/Unit\s(\d):\s+(RAID\s+\d+|[^\s]+)\s([^\s]+)\s([^\s]+)[^:]+:\s(.+)/) {
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_capacity|",normalize_number("$3 $4", force_unit => 'GB'),"\n";
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_type|$2\n";
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_status|$5\n";
        }
        if ( $line =~ m/Port\s(\d+):\s([^\s]+)\s([^\s]+)\s([^\s]+)\s([^\s]+)\s([^\s]+)[^:]+:\s([^\(]+)\(unit\s(\d+)/) {
          print "hHW_SCSIRAID_PORT_c$controler\_u$8_phy$1_capacity|",normalize_number("$5 $6", force_unit => 'GB'),"\n";
          print "hHW_SCSIRAID_PORT_c$controler\_u$8_phy$1_model|$2 $3\n";
          print "hHW_SCSIRAID_PORT_c$controler\_u$8_phy$1_status|$7\n";
          if (! exists $units{$controler}{$8}) {$units{$controler}{$8} = 0;}
          $units{$controler}{$8} = $units{$controler}{$8} + 1;
        }
        if (  $line =~ /^u(\d+)\s+(RAID\-\d+)\s+(\S+)\s+\S+\s+\S+\s+\S+\s+(\S+)\s.*/ )
        {
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_capacity|",normalize_number("$4 GB", force_unit => 'GB'),"\n";
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_type|$2\n";
          print "hHW_SCSIRAID_UNIT_c$controler\_u$1_status|$3\n";
        }
        if ( $line =~ /^p(\d+)\s+(\S+)\s+(\S+)\s+(\S+\s\S+)\s+(\d+)\s+(\S+)\s*$/ )
        {
          print "hHW_SCSIRAID_PORT_c$controler\_$3_phy$1_capacity|",normalize_number($4, force_unit => 'GB'),"\n";
          print "hHW_SCSIRAID_PORT_c$controler\_$3_phy$1_model|$6\n";
          print "hHW_SCSIRAID_PORT_c$controler\_$3_phy$1_status|$2\n";
          if (! exists $units{$controler}{$3}) {$units{$controler}{$3} = 0;}
          $units{$controler}{$3} = $units{$controler}{$3} + 1;
        }
      }
      foreach (keys %{$units{$controler}}) {print "hHW_SCSIRAID_UNIT_c$controler\_$_\_phys|".($units{$controler}{$_})."\n";}
    }
  }
}

if($hasLSI) {
  my (%data,@devs);
  my $LSIUTIL = $lsiutil_bin;
  my $port = 0;
  chomp(my @tmp = `\"$LSIUTIL\" -b`);

  my $portNameLength = length( ((grep { /^Port Name/ } @tmp)[0] =~ /^(\s*Port Name\s+)/)[0] );
  my $tmpCount = 0;
  while (@tmp and (shift @tmp) !~ /^\s*Port Name/i){ if($tmpCount++ > 100){ die "Error while parsing LSIUtil output"} }
  map {push @devs, $_ if $_ !~ /^\s*$/} @tmp;

  map { $_ = $1 if (substr($_, 0, $portNameLength) =~ /(.*?)\s+$/) ; $_  } @devs;  # just extract name of device from path (if exists) or lsiutil line.

  #Port Name        Seg/Bus/Dev  Board Name       Board Assembly   Board Tracer
  #/proc/mpt/ioc0    0   5   3   N/A              ASUSTek          N/A           
  # or:
  #itmpt0            0   5   1   SAS3041X         L3-01084-04B     P151344206      
  # or (Win32):
  #Scsi Port 2       0   3   5   0                0                0

  # foreach ioc device:
  foreach (@devs){                                                                                                                                                                                                                         
    my $unit = $_; 
    my $port++;         # when first time in loop port == 1; For now each dev has its different port.

    chomp(my @diskDetails = `\"$LSIUTIL\" -p$port -a 21,2,0,0`);
    chomp(my @LSIRES = `\"$LSIUTIL\" -p$port -a 21,1,0,0`);

    # each line:
    my ($vol, $bus, $target, $type);
    $vol = -1;
    foreach my $line (@LSIRES){
      #Volume 0 is Bus 0 Target 2, Type IM (Integrated Mirroring)
      if($line =~ /^Volume (\d+) is Bus (\d+) Target (\d+), Type (\w+) /) {
        ($vol, $bus, $target, $type) = ($1, $2, $3, $4);
        $data{$unit}{$port}{$vol}{$bus}{$target}{type} = $type;
        # Warning: $target is a scsi id (vol_id$target) in RTM
      }
      # skip all till Volume.. line
      next if $vol == -1;

      #  Volume State:  optimal, enabled
      if($line =~ /Volume State:  (.+?), (.*)$/) {
        $data{$unit}{$port}{$vol}{$bus}{$target}{status} = uc $1;
        $data{$unit}{$port}{$vol}{$bus}{$target}{flags} = uc $2;
      }

      #Volume Size 417708 MB, Stripe Size 64 KB, 6 Members
      if($line =~ /Volume Size (\d+ \w+), Stripe Size (\d+ \w+), (\d+) Members/){
        $data{$unit}{$port}{$vol}{$bus}{$target}{capacity} = $1;
        $data{$unit}{$port}{$vol}{$bus}{$target}{stripe} = $2; # NEW
        $data{$unit}{$port}{$vol}{$bus}{$target}{phys} = $3;
      }elsif($line =~ /Volume Size (\d+ \w+), (\d+) Members/){
        #Volume Size 417708 MB, 2 Members
        $data{$unit}{$port}{$vol}{$bus}{$target}{capacity} = $1;
        $data{$unit}{$port}{$vol}{$bus}{$target}{phys} = $2;
      }

      if($line =~ /is PhysDisk (\d+)/){
        my %disk;
        $disk{nr} = $1;                                                                                                                                                        

        # now we know which disk is here, so find it:
        my $stop = 0;
        foreach(@diskDetails) {
          $stop == 1 and next
          if(/PhysDisk $disk{nr} is Bus/);
          #PhysDisk 0 is Bus 0 Target 3

          next unless $stop;

          #PhysDisk State:  online
          if(/PhysDisk State: (.*)/){
            $disk{status} = uc $1;
            $disk{status} =~ s/^\s+|\s+$//g;
          }

          #PhysDisk Size 238475 MB, Inquiry Data:  ATA      ST3250410AS      A
          if(/PhysDisk Size (\d+ \w+), Inquiry Data:\s+(.*)/){
            $disk{capacity} = $1;
            $disk{model} = $2;
            $disk{model} =~ s/\s+/ /g;
            $disk{model} =~ s/^\s+|\s+$//g;
            $disk{model} =~ s/(\w+ \w+) \w+/$1/g; # delete rev, for backward compatibility
          }
        }
        push @{$data{$unit}{$port}{$vol}{$bus}{$target}{disks}}, \%disk;
      }
    }
  }

  #@{$data{$unit}{$port}{$vol}{$bus}{$target}{disks}}
  foreach my $unit (keys %data){
    foreach my $port (keys %{$data{$unit}}){
      foreach my $vol (keys %{$data{$unit}{$port}}){
        foreach my $bus (keys %{$data{$unit}{$port}{$vol}}){
          foreach my $target (keys %{$data{$unit}{$port}{$vol}{$bus}}){
            foreach my $key (keys %{$data{$unit}{$port}{$vol}{$bus}{$target}}){
              if($key eq 'capacity'){
                print "hHW_SCSIRAID_UNIT_$unit\_vol-id$vol\_$key|".normalize_number($data{$unit}{$port}{$vol}{$bus}{$target}{$key}, force_unit => 'GB')."\n";
              } elsif($key eq 'disks') {
                foreach my $d (@{$data{$unit}{$port}{$vol}{$bus}{$target}{$key}}){
                  next unless $d->{status};
                  print "hHW_SCSIRAID_PORT_$unit\_vol-id$vol\_phy".$d->{nr}."\_model|".$d->{model}."\n";
                  print "hHW_SCSIRAID_PORT_$unit\_vol-id$vol\_phy".$d->{nr}."\_capacity|".normalize_number($d->{capacity}, force_unit => 'GB')."\n";
                  print "hHW_SCSIRAID_PORT_$unit\_vol-id$vol\_phy".$d->{nr}."\_status|".$d->{status}."\n";
                  # TODO: no idea from where get the disk flags
                  print "hHW_SCSIRAID_PORT_$unit\_vol-id$vol\_phy".$d->{nr}."\_flags|".(($d->{flags})?$d->{flags}:"NONE")."\n";
                }
              } else {
                print "hHW_SCSIRAID_UNIT_$unit\_vol-id$vol\_$key|$data{$unit}{$port}{$vol}{$bus}{$target}{$key}\n";
              }
            }
          }
        }
      }
    }
  }
}

sub _has_LSI {
  return 0
    unless -e $lsiutil_bin;
  my ($has_lsi) = (`\"$lsiutil_bin\" -b` =~ /^\s*(\d+)\s+MPT Port(?:s)? found/m);
  return int($has_lsi);
}

sub _has_3ware {
  return 0
    unless -e $twcli_bin;
  my $has_3ware = grep { /^c\d\s+/ } `\"$twcli_bin\" info`;
  return $has_3ware;
}

sub _has_soft_raid {
  my @disks = diskpart('list disk')
    or die "Cannot get disk list from diskpart.exe";

  @disks = parse_diskpart_output({
      headers => [ qw/disk status size free dynamic gpt/ ],
      input => \@disks,
    }) or die "Cannot parse diskpart output";

  for my $disk (@disks) {
    return 1
      if ($disk->{dynamic} ne '');
  }

  return 0;
}

# Parses fixed-width, ASCII-table output data
# from diskpart.exe
# USAGE:
#   parse_diskpart_output({ 
#     headers => [ qw/foo bar baz/ ]    # keys that you want in output hashes, typically corresponding to headers (ORDER MATTERS)
#     input => \@data,                  # reference to array containing raw diskpart.exe output
#     cell_filter => sub { lc $_[0] },  # subref to an optional function which will be triggered on every cell content
#   });
sub parse_diskpart_output {
  my $params         = shift;
  my @diskpartOutput = @{ $params->{input} };
  my @headers        = @{ $params->{headers} };
  my $cellFilter     = $params->{cell_filter};

  chomp(@diskpartOutput);

  my $columnWidths;
  my $tmpCount = 0;
  for (my $i = 0 ; $i < length(@diskpartOutput) ; ) {
    if ($diskpartOutput[$i] =~ /^[- ]+$/) {
      $columnWidths = shift @diskpartOutput;
      last;
    } elsif($tmpCount++ > 100) {
        return ();
    } else {
      shift @diskpartOutput;
    } 
  }

  my $offset = 0;
  my @columnWidths = map {
    my ($space, $content) = map { length } $_ =~ /(\s+)(\S+)/;
    my $off = $offset + $space;
    $offset += $space + $content;
    [ $off, $content ];
  } $columnWidths =~ /(\s+\S+)/g;

  my @data;
  for my $line (grep { $_ ne '' } @diskpartOutput) {
    my $lineData = {};
    my $count = 0;
    for my $offset (@columnWidths) {
      my $cell = substr $line, $offset->[0], $offset->[1];
      $cell =~ s/^\s*(.*?)\s*$/$1/;
      $lineData->{$headers[$count]} = ref $cellFilter eq 'CODE' ? &$cellFilter($cell) : $cell;
      $count++;
    }

    push @data, $lineData;
  }

  return @data;
}

# Returns raw diskpart output to the set of passed in commands
# USAGE:
#   @rawoutput = diskpart('list disk', 'select disk 0', 'detail disk');
sub diskpart {
  my @commands = @_;
  my ($fh, $diskpart_cmd_filename) = tempfile();
  print $fh $_,"\r\n" for @commands;
  close $fh;
  my @diskpart_raw = `"$diskpart_bin" /s $diskpart_cmd_filename`;
  my $diskpart_status = $?;

  unlink $diskpart_cmd_filename
    or warn "Cannot delete temporary diskpart.exe script '$diskpart_cmd_filename': $!";
  return () if $diskpart_status != 0;

  return @diskpart_raw;
}
EOF
close $fh;
}

# 
# Generate \scripts\hour\smart.pl file
sub generate_smart {
    print "Generating $DIR_SCRIPTS_HOUR\\smart.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_HOUR\\smart.pl"
        or die "Cannot open $DIR_SCRIPTS_HOUR\\smart.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

EOF
    print $fh "my \$smartctl_bin = '$SMARTCTL_BIN';\n";
    print $fh <<'EOF';
# get WMI object
my $objWMI = getWMI();

sub parse_smartctl_line {
  my $line = shift;
  my $dev = shift;
  my $other_errors = 0;

  if ($line =~ /^196 Reallocated_Event_Count.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_realocated-event-count|$1\n";
  }
  if ($line =~ /^197 Current_Pending_Sector.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_current-pending-sector|$1\n";
  }
  if ($line =~ /^198 Offline_Uncorrectable.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_offline-uncorrectable|$1\n";
  }
  if ($line =~ /^199 UDMA_CRC_Error_Count.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_udma-crc-error|$1\n";
  }
  if ($line =~ /^200 Multi_Zone_Error_Rate.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_multizone-error-rate|$1\n";
  }
  if ($line =~ /^209 Offline_Seek_Performnce.*\s+(\d+)$/) {
    print "hINFO_HDD_$dev\_SMART_offline-seek-performance|$1\n";
  }
  if ($line =~ m/^194 Temperature_Celsius .*\s+(\d+)(\s+\([\w\s\/]+\))?$/) {
    print "hINFO_HDD_$dev\_SMART_temperature-celsius|$1\n";
  }

  if ($line =~ /Error \d+ (occurred )?at /){
    $other_errors = 1;
  }
}

sub check_disks {
  return if has_raid();
  my %disk_hash = _get_letters_for_disks();
  foreach my $diskId (keys %disk_hash) {
    my $diskLetter = $disk_hash{$diskId};
    my $smart_other_error = 0;
    next unless defined $diskLetter;
    my @smartctlData = `\"$smartctl_bin\" -a $diskLetter`;
    foreach my $line (@smartctlData) {
      my %ret = parse_smartctl_line($line, $diskId);
      $smart_other_error = 1 if $ret{other_errors};
    }
    print "hINFO_HDD_$diskId\_SMART_other-errors|".int($smart_other_error)."\n";
  }
}

sub _get_letters_for_disks {
  my %hdd_hash = ();
  my $diskCol = $objWMI->ExecQuery('SELECT DeviceID,Index FROM Win32_DiskDrive');
  for my $objDisk (in $diskCol) {
    my ($logicalDiskLetter, $diskId);
    $diskId = 'Disk#'.$objDisk->Index;
    $hdd_hash{$diskId} = undef;

    my $partCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskDrive.DeviceID=\''.$objDisk->DeviceID.'\'} WHERE AssocClass = Win32_DiskDriveToDiskPartition');
    my $objPart = (in $partCol)[0]
      or next; # disk has no partitions
    my $logicalDiskCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID=\''.$objPart->DeviceID.'\'} WHERE AssocClass = Win32_LogicalDiskToPartition');
    my $objLogicalDisk = (in $logicalDiskCol)[0]
      or next; # disk has no logical partitions
    $logicalDiskLetter = $objLogicalDisk->DeviceID;

    $hdd_hash{$diskId} = $logicalDiskLetter;
  }

  return %hdd_hash;
}

sub has_raid {
  my $has_raid = 0;
  my $scsiControllerCol = $objWMI->ExecQuery('SELECT * FROM Win32_SCSIController');

  # TODO; have to check if MYLEX RAID controllers appear in Win32_SCSIController
  $has_raid = scalar (in $scsiControllerCol);
# for my $objScsiController (in $scsiControllerCol) {
#   $has_raid = 1
#   if ($objScsiController->Name =~ /LSI Logic/
#     || $objScsiController->Name =~ /3ware/);
# }

  return $has_raid;
}

check_disks();
EOF
close $fh;
}

# 
# Generate \scripts\hour\listen_ports.pl file
sub generate_listen_ports {
    print "Generating $DIR_SCRIPTS_HOUR\\listen_ports.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_HOUR\\listen_ports.pl"
        or die "Cannot open $DIR_SCRIPTS_HOUR\\listen_ports.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

my $CScript_bin = 'Cscript.exe';
EOF
    print $fh "my \$getProcessOwner_vbs = '$GET_PROCESSES_OWNER_BIN';\n";
    print $fh <<'EOF';

# get WMI object
my $objWMI = getWMI();

sub send_listen_ports {
  my @listen_ports = get_listen_ports();

  for (@listen_ports) {
    my $laddr    = $_->{laddr};
    my $lport    = $_->{lport};
    my $pid      = $_->{pid};
    my $procName = $_->{procName} || '';
    my $cmdline  = $_->{cmdline}  || '';
    my $exe      = $_->{exe}      || '';
    my $username = $_->{username} || '';
    my $domain   = $_->{domain}   || '';

    $laddr =~ s/\./-/g;

    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_pid|$pid\n";
    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_procname|$procName\n";
    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_cmdline|$cmdline\n";
    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_exe|$exe\n";
    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_username|$username\n";
    print "hINFO_TCP_LISTEN_IP-${laddr}_PORT-${lport}_domain|$domain\n";
  }
}

sub get_listen_ports {
  my (@netstatOutput, @parsedOutput, $pids, $processCol, @netstatOutputRaw);

  @netstatOutputRaw = `netstat -a -o -n -p TCP`;
  chomp(@netstatOutput = grep { /^\s*TCP\s+\S+\s+0\.0\.0\.0:0.*/ } @netstatOutputRaw);

  for my $line (@netstatOutput) {
    my ($proto, $laddr, $lport, $raddr, $rport, $state, $pid) =
    $line =~ /^\s+(\S+)\s+(\S+):(\S+)\s+(\S+):(\S+)\s+(\S+)\s+(\S+)/;

    push @parsedOutput, {
      proto => $proto,
      laddr => $laddr,
      lport => $lport,
      raddr => $raddr,
      rport => $rport,
      state => $state,
      pid   => $pid,
    };
  }

  my @pids = map { $_->{pid} } grep { $_->{pid} =~ /^\d+$/ } @parsedOutput;
  $pids = join ' OR ', map { 'ProcessId = ' . $_->{pid} } grep { $_->{pid} =~ /^\d+$/ } @parsedOutput;
  $processCol = $objWMI->ExecQuery("SELECT * FROM Win32_Process WHERE $pids");
  
  # get owner and group for pids
  # have to use vbscript since $procObj->getOwner() is broken in Perl
  chomp(my @procOwnersRaw = `$CScript_bin \"$getProcessOwner_vbs\" @pids`);
  die "Cannot get process owners"
    unless @procOwnersRaw;

  my $tmpCount = 0;
  # CScript prints some crap, so we get real data after START
  until ((shift @procOwnersRaw) =~ /^START$/ or $tmpCount++ > 10) {};
  die "Cannot get process owners"
      if ($tmpCount > 10);
  my %pidOwners;
  for (@procOwnersRaw) {
      my ($pid, $domain, $username) = split /\|/;
      $pidOwners{$pid} = { username => $username, domain => $domain };
  }

  for my $hash (@parsedOutput) {
    my ($objProcess) = grep { $hash->{pid} == $_->ProcessId } in $processCol;

    $hash->{cmdline}  = $objProcess->CommandLine;
    $hash->{procName} = $objProcess->Description;
    $hash->{exe}      = $objProcess->ExecutablePath;
    if (defined $pidOwners{$hash->{pid}}) {
        $hash->{username} = $pidOwners{$hash->{pid}}->{username};
        $hash->{domain}   = $pidOwners{$hash->{pid}}->{domain};
    }
  }



  return @parsedOutput;
}

send_listen_ports();
EOF
close $fh;
}

# 
# Generate \scripts\min\usage.pl file
sub generate_usage {
    print "Generating $DIR_SCRIPTS_MIN\\usage.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_MIN\\usage.pl"
        or die "Cannot open $DIR_SCRIPTS_MIN\\usage.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

# get WMI object
my $objWMI = getWMI();

# XXX no way of getting loadavg on Win32
#sub send_loadavg {
#  my %loadavg = get_loadavg();
#  print "mINFO_LOAD_loadavg1|" . $loadavg{'loadavg1'} . "\n";
#  print "mINFO_LOAD_loadavg2|" . $loadavg{'loadavg2'} . "\n";
#  print "mINFO_LOAD_loadavg3|" . $loadavg{'loadavg3'} . "\n";
#}

sub send_mem_swap_usage {
  my %mem_swap_usage = get_mem_swap_usage();
  print "mINFO_MEM_memusage|" . $mem_swap_usage{'mem_used_pr'} . "\n";
  print "mINFO_MEM_swapusage|" . $mem_swap_usage{'swap_used_pr'} . "\n";
}

sub send_cpu_usage {
  my $cpu_usage = get_cpu_usage();
  print "mINFO_CPU_usage|" . $cpu_usage . "\n";
}

sub send_hdd_usage {
  my %hdd_usage = get_hdd_usage();
  foreach (keys %{$hdd_usage{'usage'}}) {
    print "mINFO_PART_$_\_mount|" . $hdd_usage{'mount'}{$_} . "\n";
    print "mINFO_PART_$_\_usage|" . $hdd_usage{'usage'}{$_} . "\n";
  }
}

sub get_cpu_usage {
  my ($perfCol, $objPerf, $cpu_usage);

  #$perfCol = $objWMI->InstancesOf('Win32_PerfFormattedData_PerfOS_Processor')
  $perfCol = $objWMI->ExecQuery('SELECT PercentIdleTime FROM Win32_PerfFormattedData_PerfOS_Processor');
  $objPerf = (in $perfCol)[0]
    or die "Cannot get Win32_PerfFormattedData_PerfOS_Processor from WMI";

  # calculate CPU usage as full load minus idle;
  $cpu_usage = 100 - $objPerf->PercentIdleTime;

  return $cpu_usage;
}

sub get_mem_swap_usage {
  my ($osCol, $objOS, $total_phy_mem, $free_phy_mem, $used_phy_mem, $per_used_phy_mem, $total_swap, $free_swap, $used_swap, $per_used_swap);

  $osCol = $objWMI->ExecQuery('SELECT TotalVisibleMemorySize,FreePhysicalMemory,TotalVirtualMemorySize,FreeVirtualMemory FROM Win32_OperatingSystem');
  $objOS = (in $osCol)[0]
    or die "Cannot get Win32_OperatingSystem from WMI";

  $total_phy_mem    = $objOS->TotalVisibleMemorySize;
  $free_phy_mem     = $objOS->FreePhysicalMemory;
  $used_phy_mem     = $total_phy_mem - $free_phy_mem;
  $per_used_phy_mem = sprintf('%d', $used_phy_mem/$total_phy_mem*100);

  $total_swap    = $objOS->TotalVirtualMemorySize;
  $free_swap     = $objOS->FreeVirtualMemory;
  $used_swap     = $total_swap - $free_swap;
  $per_used_swap = sprintf('%d', $used_swap/$total_swap*100);

  return (
    mem_total    => $total_phy_mem,
    mem_used     => $used_phy_mem,
    mem_free     => $free_phy_mem,
    mem_used_pr  => $per_used_phy_mem,
    swap_total   => $total_swap,
    swap_used    => $used_swap,
    swap_free    => $free_swap,
    swap_used_pr => $per_used_swap,
  );
}

sub get_hdd_usage {
  my (%hdd_usage, %letter_disk, $diskCol);

  %letter_disk = _get_map_letters_to_disks();

  $diskCol = $objWMI->ExecQuery('SELECT Size,FreeSpace,DriveType,DeviceID FROM Win32_LogicalDisk');
  foreach my $objDisk (in $diskCol) {
    # local harddrive or removable one
    if ($objDisk->DriveType == 3) {
      my $size     = $objDisk->Size || next;
      my $free     = $objDisk->FreeSpace;
      my $used     = $size - $free;
      my $per_used = sprintf('%d', $used/$size*100);

      $hdd_usage{'usage'}{$letter_disk{$objDisk->DeviceID}} = $per_used;
      $hdd_usage{'mount'}{$letter_disk{$objDisk->DeviceID}} = $objDisk->DeviceID;
    }
  }

  return %hdd_usage;
}

sub _get_map_letters_to_disks {
  my %hdd_hash = ();
  my $diskCol = $objWMI->ExecQuery('SELECT DeviceID,Index FROM Win32_DiskDrive');
  for my $objDisk (in $diskCol) {
    my $diskId = 'Disk#'.$objDisk->Index;
    my $partCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskDrive.DeviceID=\''.$objDisk->DeviceID.'\'} WHERE AssocClass = Win32_DiskDriveToDiskPartition');
    for my $objPart (in $partCol) {
      my $partId = 'Partition#'.$objPart->Index;
      my $logicalDiskCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID=\''.$objPart->DeviceID.'\'} WHERE AssocClass = Win32_LogicalDiskToPartition');
      for my $objLogicalDisk (in $logicalDiskCol) {
        my $logicalDiskLetter = $objLogicalDisk->DeviceID;
        $hdd_hash{$logicalDiskLetter} = $diskId.$partId;
      }
    }
  }

  return %hdd_hash;
}

send_hdd_usage();
send_mem_swap_usage();
send_cpu_usage();
EOF
close $fh;
}

# 
# Generate \scripts\min\usage-root.pl file
sub generate_usage_root {
    print "Generating $DIR_SCRIPTS_MIN\\usage-root.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_MIN\\usage-root.pl"
        or die "Cannot open $DIR_SCRIPTS_MIN\\usage-root.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI normalize_number /;

# get WMI object
my $objWMI = getWMI();

sub send_process {
  my %processes = get_processes();
  # XXX process state in Windows is not implemented as of 8 Jul 2009, 15:48:34 CEST
#  print "mINFO_LOAD_processesactive|" . $processes{'processesactive'} . "\n";
  print "mINFO_LOAD_processesup|" . $processes{'processesup'} . "\n";
}

sub send_top_rss {
  my $top = get_top_mem_procs();
  my $n = 1;
  foreach my $info (@$top) {
    my $vsz = $info->[0];
    my $cmd = $info->[1];
    printf "mINFO_MEM_top_mem_%02d_name|%s\n", $n, $cmd;
    printf "mINFO_MEM_top_mem_%02d_size|%s\n", $n, normalize_number($vsz, force_unit => 'B', print_unit => 0 );
    ++$n;
  }
}

sub get_processes {
  #TODO: Have to check if this actually returns rtm processes
#  my $rtmCol = $objWMI->ExecQuery('SELECT ProcessId FROM Win32_Process WHERE Description=rtm');
  my $procCol = $objWMI->ExecQuery('SELECT SessionId,CommandLine FROM Win32_Process WHERE Description<>\'rtm\'');
#  my $rtm = scalar(in $rtmCol);
  my $total = scalar(in $procCol);

  return ( processesup => $total );
}

sub get_top_mem_procs {
  my @top;
  my $procCol = $objWMI->ExecQuery('SELECT CommandLine,WorkingSetSize FROM Win32_Process');
  
  # top five
  for my $objProc ((sort { $b->WorkingSetSize <=> $a->WorkingSetSize } in $procCol)[0..4]) {
    push @top, [ $objProc->WorkingSetSize, $objProc->CommandLine ];
  }

  return \@top;
}

send_process();
send_top_rss();
EOF
close $fh;
}

# 
# Generate \scripts\hour\hwinfo.pl file
sub generate_hwinfo {
    print "Generating $DIR_SCRIPTS_HOUR\\hwinfo.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_HOUR\\hwinfo.pl"
        or die "Cannot open $DIR_SCRIPTS_HOUR\\hwinfo.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;
use Win32::TieRegistry(qw/KEY_READ/);

# tie windows registry
my $regPCI = Win32::TieRegistry->new('LMachine\\SYSTEM\\CurrentControlSet\\Enum\\', { Access => KEY_READ() })
  or die "Error accessing HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Enum\\ : $^E";

# get WMI object
my $objWMI = getWMI();

sub send_cpu_info {
  my %cpu_info = get_cpu_info();
  print "dHW_CPU_name|"   . $cpu_info{'cpu_name'}  . "\n";
  print "dHW_CPU_mhz|"    . $cpu_info{'cpu_mhz'}   . "\n";
  print "dHW_CPU_cache|"  . $cpu_info{'cpu_cache'} . "\n";
  print "dHW_CPU_number|" . $cpu_info{'cpu_no'}    . "\n";
}

sub send_lspci_info {
  my %lspci_info = get_lspci_info();

  foreach (keys %lspci_info) {
    my $tempKey = $_;
    $tempKey =~ s/\:|\.|\_/-/g;
    print "dHW_LSPCI_PCI-$tempKey|" . $lspci_info{$_} . "\n";
  }
}

sub get_cpu_info {
  my %cpu_info = ( 'cpu_no' => 0 );
  my $processorCol = $objWMI->ExecQuery('SELECT Name, MaxClockSpeed, L2CacheSize FROM Win32_Processor');

  foreach my $objProcessor (in $processorCol) {
    $cpu_info{'cpu_no'}++;
    $cpu_info{'cpu_name'}  = $objProcessor->Name;
    $cpu_info{'cpu_mhz'}   = $objProcessor->MaxClockSpeed;
    $cpu_info{'cpu_cache'} = $objProcessor->L2CacheSize . ' KB';
  }

  return %cpu_info;
}

sub get_lspci_info {
  my %lspci_info = ();

  # get all PCI buses (type 5)
  my $busCol = $objWMI->ExecQuery('SELECT * FROM Win32_Bus WHERE BusType=5');

  foreach my $objPCIbus (in $busCol) {
    # get all devices associated to this bus
    my $devCol = $objWMI->ExecQuery('Associators of {Win32_Bus.DeviceID=\''.$objPCIbus->DeviceID.'\'} WHERE AssocClass = Win32_DeviceBus');
    foreach my $objDev (in $devCol) {
        #my ($dev_vendor, $dev_id) = $objDev->PnPDeviceID =~ /^PCI\\VEN_([a-f0-9]{4})\&DEV_([a-f0-9]{4})\S+REV_[a-f0-9]{2}\S+/i;
      my ($dev_vendor, $dev_id) = $objDev->PnPDeviceID =~ /VEN_([a-f0-9]{4})\&DEV_([a-f0-9]{4})/i;
      unless (defined $dev_vendor && defined $dev_id) {
        warn "Error while retrieving device id or vendor";
        next;
      }

      # open registry for current device
      my $devKey = $regPCI->Open($objDev->PnPDeviceID)
        or warn "Cannot open device register key: $^E", next;

      # get PCI location from registry
      my $location = $devKey->GetValue('LocationInformation')
        or warn "Cannot get LocationInformation: $^E", next;
      
      my ($bus, $dev, $func);
      # pre-win2008
      if ($location =~ /^PCI bus (\d+), device (\d+), function (\d+)$/) {
        ($bus, $dev, $func) = ($1, $2, $3);
      # win2008
      } elsif ($location =~ /\((\d+),(\d+),(\d+)\)$/) {
        ($bus, $dev, $func) = ($1, $2, $3);
      }
      unless (defined $bus && defined $dev && defined $func) {
        warn "Error while parsing LocationInformation";
        next;
      }

      # convert to lspci's location format
      $location = sprintf('%02d:%02x.%01x', $bus, $dev, $func);
      $lspci_info{$location} = sprintf('%04s:%04s', $dev_vendor, $dev_id);
    }
  }
  return %lspci_info;
}

send_cpu_info();
send_lspci_info();
EOF
close $fh;
}

# 
# Generate \scripts\hour\hwinfo-root.pl file
sub generate_hwinfo_root {
    print "Generating $DIR_SCRIPTS_HOUR\\hwinfo-root.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_HOUR\\hwinfo-root.pl"
        or die "Cannot open $DIR_SCRIPTS_HOUR\\hwinfo-root.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI normalize_number /;
# return undef on error

# get WMI object
my $objWMI = getWMI();

sub send_mainboard_memory_info {
  my %mainboard_memory_info = get_mainboard_memory_info();
  print "dHW_MB_manufacture|" . $mainboard_memory_info{'mainboard'}{'manufacture'} . "\n";
  print "dHW_MB_name|" . $mainboard_memory_info{'mainboard'}{'name'} . "\n";
  foreach (keys %{$mainboard_memory_info{'memory'}}) {
    print "dHW_MEM_BANK-$_|" . normalize_number($mainboard_memory_info{'memory'}{$_}, force_unit => 'B', print_unit => 0) . "\n";
  }
  print "dHW_MEM_FREE_BANKS|" . $mainboard_memory_info{free_slots} . "\n";
}

sub send_hdd_info {
  my %hdd_info = get_hdd_info();
  foreach (keys %{$hdd_info{'model'}}) {
    print "dHW_HDD_$_\_capacity|" . normalize_number($hdd_info{'capacity'}{$_}, force_unit => 'GB') . "\n";
    print "dHW_HDD_$_\_model|" . $hdd_info{'model'}{$_} . "\n";
  }
}

sub get_mainboard_memory_info {
  my %mainboard_memory_info = ();

  my $mainboardCol = $objWMI->ExecQuery('SELECT Manufacturer, Product FROM Win32_Baseboard');

  for my $mainboard (in $mainboardCol) {
    $mainboard_memory_info{mainboard}{manufacture} = $mainboard->Manufacturer;
    $mainboard_memory_info{mainboard}{name}        = $mainboard->Product;
  }

  my $phyMemCol    = $objWMI->ExecQuery('SELECT * FROM Win32_PhysicalMemory');
  my $phyMemArrCol = $objWMI->ExecQuery('SELECT * FROM Win32_PhysicalMemoryArray');

  my $phyMemArr = (in $phyMemArrCol)[0]
    or die "Cannot get Win32_PhysicalMemoryArray object from WMI";

  my $usedMemSlots  = scalar (in $phyMemCol);
  my $countMemSlots = $phyMemArr->MemoryDevices;
  my $freeMemSlots  = $countMemSlots - $usedMemSlots;

  if ($freeMemSlots < 0) {
    warn "Incorrect number of free memory slots ($freeMemSlots)";
    $freeMemSlots = undef;
  }
  $mainboard_memory_info{free_slots} = $freeMemSlots;

  for my $phyMem (in $phyMemCol) {
    my $bank = $phyMem->BankLabel;
    my $dev  = $phyMem->DeviceLocator;
    $mainboard_memory_info{memory}{$bank . '-' . $dev} = $phyMem->Capacity;
  }

  return %mainboard_memory_info;
}

sub has_raid {
  my $has_raid = 0;
  my $scsiControllerCol = $objWMI->ExecQuery('SELECT * FROM Win32_SCSIController');

  # TODO; have to check if MYLEX RAID controllers appear in Win32_SCSIController
  $has_raid = scalar (in $scsiControllerCol);
# for my $objScsiController (in $scsiControllerCol) {
#   $has_raid = 1
#   if ($objScsiController->Name =~ /LSI Logic/
#     || $objScsiController->Name =~ /3ware/);
# }

  return $has_raid;
}

sub get_hdd_info {
  my %hdd_info = ();
  my $query = 'SELECT * FROM Win32_DiskDrive';
  $query .= " WHERE InterfaceType = 'USB'"
    if has_raid();

  my $diskCol = $objWMI->ExecQuery($query);

  for my $objDisk (in $diskCol) {
    my $diskId = 'Disk#'.$objDisk->Index;
    $hdd_info{'model'}->{$diskId}    = $objDisk->Model;
    $hdd_info{'capacity'}->{$diskId} = $objDisk->Size;
  }

  return %hdd_info;
}

send_mainboard_memory_info();
send_hdd_info();
EOF
close $fh;
}

# 
# Generate \scripts\min\hddinfo.pl file
sub generate_hddinfo {
    print "Generating $DIR_SCRIPTS_MIN\\hddinfo.pl...\n";
    open my $fh, '>', "$DIR_SCRIPTS_MIN\\hddinfo.pl"
        or die "Cannot open $DIR_SCRIPTS_MIN\\hddinfo.pl for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;

EOF
    print $fh "my \$smartctl_bin = '$SMARTCTL_BIN';\n";
    print $fh <<'EOF';
my $objWMI = getWMI();

sub send_hdd_status {
  my $diskCol = $objWMI->ExecQuery('SELECT * FROM Win32_DiskDrive');
  for my $objDisk (in $diskCol) {
    my $diskId = 'Disk#'.$objDisk->Index;
    my $status = $objDisk->Status;
    print "mHW_HDD_$diskId\_status|$status\n";
  }
}

sub send_hdd_temp {
  my %hdd_temp = get_hdd_temp();
  foreach (keys %hdd_temp) {
    print "mINFO_HDD_$_\_temperature|" . $hdd_temp{$_} . "\n";
  }
}


sub get_hdd_temp {
  my %hdd_temp = ();

  # need to get a logical disk letter for each physical drive
  # in order to read drive temperature through smartctl
  my %hdd_hash = _get_letters_for_disks();
  foreach my $diskId (keys %hdd_hash) {
    my ($diskLetter, $diskTemperature);
    $diskLetter = $hdd_hash{$diskId};
    $hdd_temp{$diskId} = '-1', next unless defined $diskLetter;

    chomp(my ($smartCtlOutput) = grep { /Temperature_Celsius/ } `\"$smartctl_bin\" -a $diskLetter`);
    if ($? == 0) {
      ($diskTemperature) = $smartCtlOutput =~ /(\d+)(?:\s+\(.*\))?$/;
    } else {
      $diskTemperature = '-2';
    }
    $hdd_temp{$diskId} = $diskTemperature;
  }

  return %hdd_temp;
}


sub _get_letters_for_disks {
  my %hdd_hash = ();
  my $diskCol = $objWMI->ExecQuery('SELECT DeviceID,Index FROM Win32_DiskDrive');
  for my $objDisk (in $diskCol) {
    my ($logicalDiskLetter, $diskId);
    $diskId = 'Disk#'.$objDisk->Index;
    $hdd_hash{$diskId} = undef;

    my $partCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskDrive.DeviceID=\''.$objDisk->DeviceID.'\'} WHERE AssocClass = Win32_DiskDriveToDiskPartition');
    my $objPart = (in $partCol)[0]
      or next; # disk has no partitions
    my $logicalDiskCol = $objWMI->ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID=\''.$objPart->DeviceID.'\'} WHERE AssocClass = Win32_LogicalDiskToPartition');
    my $objLogicalDisk = (in $logicalDiskCol)[0]
      or next; # disk has no logical partitions
    $logicalDiskLetter = $objLogicalDisk->DeviceID;

    $hdd_hash{$diskId} = $logicalDiskLetter;
  }

  return %hdd_hash;
}

send_hdd_status();
send_hdd_temp();
EOF
close $fh;
}

# 
# Generate getProcessesOwner.vbs file
sub generate_getProcessesOwner {
    print "Generating getProcessesOwner.vbs...\n";
    open my $fh, '>', "$GET_PROCESSES_OWNER_BIN"
        or die "Cannot open $GET_PROCESSES_OWNER_BIN for writing";
    print $fh <<'EOF';
strComputer = "."

pids = ""
For Each arg in WScript.Arguments
    If (pids = "") Then
        pids = "ProcessId = " & arg
    Else
        pids = pids & " OR ProcessId = " & arg
    End If
Next

WScript.Echo "START"

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\cimv2")

Set colProcesses = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_Process WHERE " & pids  )
For Each objProcess in colProcesses
    If objProcess.GetOwner ( User, Domain ) = 0 Then
          Wscript.Echo objProcess.ProcessId & "|" & Domain & "|" & User
    End If
Next
EOF
close $fh;
}

# 
# Generate elevate_wrapper.cmd file
sub generate_elevate_wrapper {
    print "Generating elevate_wrapper.cmd...\n";
    open my $fh, '>', "$ELEVATE_CMD"
        or die "Cannot open $ELEVATE_CMD for writing";
    print $fh <<'EOF';
:: //***************************************************************************
:: // ***** Script Header *****
:: //
:: // File:      Elevate.cmd
:: //
:: // Additional files required:  Elevate.vbs
:: //
:: // Purpose:   To provide a command line method of launching applications that
:: //            prompt for elevation (Run as Administrator) on Windows Vista.
:: //
:: // Usage:     elevate.cmd application <application arguments>
:: //
:: // Version:   1.0.0
:: // Date :     01/02/2007
:: //
:: // History:
:: // 1.0.0   01/02/2007  Created initial version.
:: //
:: // ***** End Header *****
:: //***************************************************************************


@echo off

:: Pass raw command line agruments and first argument to Elevate.vbs
:: through environment variables.
set ELEVATE_CMDLINE=%*
set ELEVATE_APP=%1

start wscript //nologo "%~dpn0.vbs" %*

EOF
close $fh;
}

# 
# Generate elevate.vbs file
sub generate_elevate {
    print "Generating elevate.vbs...\n";
    open my $fh, '>', "$ELEVATE_VBS"
        or die "Cannot open $ELEVATE_VBS for writing";
    print $fh <<'EOF';
' //***************************************************************************
' // ***** Script Header *****
' //
' // File:      Elevate.vbs
' //
' // Additional files required:  Elevate.cmd
' //
' // Purpose:   To provide a command line method of launching applications that
' //            prompt for elevation (Run as Administrator) on Windows Vista.
' //
' // Usage:     (Not used directly.  Launched from Elevate.cmd.)
' //
' // Version:   1.0.1
' // Date :     01/03/2007
' //
' // History:
' // 1.0.0   01/02/2007  Created initial version.
' // 1.0.1   01/03/2007  Added detailed usage output.
' //
' // ***** End Header *****
' //***************************************************************************


Set objShell = CreateObject("Shell.Application")
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objWshProcessEnv = objWshShell.Environment("PROCESS")

' Get raw command line agruments and first argument from Elevate.cmd passed
' in through environment variables.
strCommandLine = objWshProcessEnv("ELEVATE_CMDLINE")
strApplication = objWshProcessEnv("ELEVATE_APP")
strArguments = Right(strCommandLine, (Len(strCommandLine) - Len(strApplication)))

If (WScript.Arguments.Count >= 1) Then
    strFlag = WScript.Arguments(0)
    If (strFlag = "") OR (strFlag="help") OR (strFlag="/h") OR (strFlag="\h") OR (strFlag="-h") _
        OR (strFlag = "\?") OR (strFlag = "/?") OR (strFlag = "-?") OR (strFlag="h") _
        OR (strFlag = "?") Then
        DisplayUsage
        WScript.Quit
    Else
        objShell.ShellExecute strApplication, strArguments, "", "runas"
    End If
Else
    DisplayUsage
    WScript.Quit
End If


Sub DisplayUsage

    WScript.Echo "Elevate - Elevation Command Line Tool for Windows Vista" & vbCrLf & _
                 "" & vbCrLf & _
                 "Purpose:" & vbCrLf & _
                 "--------" & vbCrLf & _
                 "To launch applications that prompt for elevation (i.e. Run as Administrator)" & vbCrLf & _
                 "from the command line, a script, or the Run box." & vbCrLf & _
                 "" & vbCrLf & _
                 "Usage:   " & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate application <arguments>" & vbCrLf & _
                 "" & vbCrLf & _
                 "" & vbCrLf & _
                 "Sample usage:" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate notepad ""C:\Windows\win.ini""" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate cmd /k cd ""C:\Program Files""" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate powershell -NoExit -Command Set-Location 'C:\Windows'" & vbCrLf & _
                 "" & vbCrLf & _
                 "" & vbCrLf & _
                 "Usage with scripts: When using the elevate command with scripts such as" & vbCrLf & _
                 "Windows Script Host or Windows PowerShell scripts, you should specify" & vbCrLf & _
                 "the script host executable (i.e., wscript, cscript, powershell) as the " & vbCrLf & _
                 "application." & vbCrLf & _
                 "" & vbCrLf & _
                 "Sample usage with scripts:" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate wscript ""C:\windows\system32\slmgr.vbs"" \u2013dli" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate powershell -NoExit -Command & 'C:\Temp\Test.ps1'" & vbCrLf & _
                 "" & vbCrLf & _
                 "" & vbCrLf & _
                 "The elevate command consists of the following files:" & vbCrLf & _
                 "" & vbCrLf & _
                 "    elevate.cmd" & vbCrLf & _
                 "    elevate.vbs" & vbCrLf

End Sub
EOF
close $fh;
}

# 
# Generate Common.pm file
sub generate_Common {
    print "Generating Common.pm...\n";
    open my $fh, '>', "$COMMON_LIB"
        or die "Cannot open $COMMON_LIB for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)



EOF
    print $fh <<'EOF';
package OVH::Common;

use vars qw/ @EXPORT_OK @EXPORT /;
use base qw/ Exporter /;

use Carp;
use strict;

@EXPORT_OK = qw/
  getWMI
  datetime_to_timestamp
  normalize_number
  lockProcess
  unlockProcess
/;

# Returns WMI object or croaks if it cannot.
# USAGE:
#   $obj = getWMI(%OPTIONS);
#
# DEFAULT OPTIONS:
#   namespace => 'root\\cimv2', # default WMI namespace with Win32_* classes
#   machine 	=> '.',							# current machine
#   warn      => 0,               # passed to Win32::OLE->Option(Warn => $warn)
#                                 # 0 - returns undef on errors
sub getWMI {
  require Win32::OLE;

  my %options = (
  	namespace => 'root\\cimv2',
  	machine   => '.',
  	warn      => 0,
  );

  my %options_override = @_;

  # override default options
  $options{$_} = $options_override{$_} for keys %options_override;
  
  Win32::OLE->Option(Warn => $options{'warn'});

  my $objWMI = Win32::OLE->GetObject('winmgmts:\\\\' . $options{machine} . '\\' . $options{namespace})
  	or croak "FATAL: ".Win32::OLE->LastError();

  return $objWMI;
}

sub datetime_to_timestamp {
  require Win32::OLE;
  require POSIX;

  my $datetime = shift || return undef;
  my $objWMI_SWbemDateTime = Win32::OLE->CreateObject('WbemScripting.SWbemDateTime')
    or die "Cannot get WbemScripting.SWbemDateTime object";
  $objWMI_SWbemDateTime->{Value} = $datetime;
  my $timestamp;
  eval {
    $timestamp = POSIX::mktime(
      $objWMI_SWbemDateTime->Seconds,
      $objWMI_SWbemDateTime->Minutes,
      $objWMI_SWbemDateTime->Hours,
      $objWMI_SWbemDateTime->Day,
      $objWMI_SWbemDateTime->Month - 1,
      $objWMI_SWbemDateTime->Year - 1900,
      0,
      0,
      -1);
  };
  return undef if $@;

  return $timestamp;
}

sub lockProcess {
  my $lockFile = shift || die "No lock file specified";
  my $objWMI = getWMI();
  
  my $pid = $$;

  if (-e "$lockFile") {
    open(LOCKFILE, $lockFile) or die "Impossible to open lock file: $lockFile !!!";
    my $lockPID=<LOCKFILE> || "";
    close(LOCKFILE);

    if ($lockPID !~ m/^\d+$/ ) {
      warn("There is no PID in lock. Something is broken...");
      exit 1;
    }
    my $procCol = $objWMI->ExecQuery("SELECT ProcessId FROM Win32_Process WHERE ProcessId = \'$lockPID\'");

    if (scalar(in $procCol) > 0) {
      exit 0;
    }
    warn("There is a lock file $lockFile, but no process for it. Overwritting lock file");
  }

  open(LOCKFILE, ">$lockFile")  or die "Impossible to open lock file for writting: $lockFile !!!";
  print LOCKFILE $pid;
  close(LOCKFILE);
}

sub unlockProcess {
    my $lockFile = shift || die "No lock file specified";
    unlink($lockFile)
      or warn "Cannot delete lock file: $!";
}

# Normalizes given number
# Returns undef on failure
#
# All options are optional and can be passed as key => value pairs
# or as a hash reference.
#
# SYNOPSIS:
#   $num = '2342.3 MB';
#   $ret = normalize_number(
#   	$num,
#  		force_unit => 'GB',
#  		decimal    => 2,
#  		print_unit => 1,
#   ); # 2.34 GB
#
# DEFAULT OPTIONS:
#  	force_unit => 0 # maximum
#  	decimal    => 1
#   print_unit => 1
#
sub normalize_number {
  my $input = shift
  	or warn 'No input', return undef;
  my %override_options;
  if (ref $_[0] eq 'HASH') {
  	%override_options = %{$_[0]};
  } elsif (defined @_) {
  	%override_options = @_;
  }

  my %options = (
  	force_unit        => 0,
  	print_unit				=> 1,
  	decimal           => 1,
  	decimal_separator => '.',
  );

  my %units = (
  	'B'  => 1,
  	'KB' => 1024,
  	'MB' => 1024**2,
  	'GB' => 1024**3,
  	'TB' => 1024**4,
  	'PB' => 1024**5,
  	'EB' => 1024**6,
  );
  my $units = join '|', keys %units;
  
  # override default options
  if (%override_options) {
  	$options{$_} = $override_options{$_} for keys %override_options;
  }
  $options{'force_unit'} = uc $options{'force_unit'};

  unless ($options{'decimal'} =~ /^\d+$/) {
  	warn 'Option \'decimal\' can only be an integer number';
  	return undef;
  }
  unless ($options{'force_unit'} =~ /^$units|0$/) {
  	warn 'Option \'force_unit\' can only be one of the following: 0, ', (join ', ', keys %units);
  	return undef;
  }

  my ($number, $decimal_separator, $unit) = $input =~ /^\s*(\d+(?:([.,])\d+)?)\s*($units)?\s*$/i;
  defined $number
  	or return undef;
  defined $unit
  	or $unit = 'B';
  $unit = uc $unit;

  $number =~ s/\D/./
  	if (defined $decimal_separator and $decimal_separator ne '.');

  # convert to bytes
  my $to_bytes = int($number * $units{$unit});

  # determine maximum unit unless force_unit is specified
  my $maximum_unit;
  if ($options{force_unit})	{
  	$maximum_unit = $options{force_unit};
  } else {
  	my $prev_unit = 'B';
  	for my $current_unit (sort { $units{$a} <=> $units{$b} } keys %units) {
  		if ($to_bytes / $units{$current_unit} < 1) {
  			$maximum_unit = $prev_unit;
  			last;
  		}
  		$prev_unit = $current_unit;
  	}
  }

  my $decimal = $options{decimal};
  $decimal = 0
  	if $maximum_unit eq 'B';

  my $output = $to_bytes / $units{$maximum_unit};

  my $ret;
  if ($options{print_unit}) {
  	$ret = sprintf('%.*f %s', $decimal, $output, $maximum_unit);
  } else {
  	$ret = sprintf('%.*f', $decimal, $output);
  }
  
  return $ret;
}

1;
EOF
close $fh;
}

# 
# Generate rtm.pl file
sub generate_rtm {
    print "Generating rtm.pl...\n";
    open my $fh, '>', "$RTM_PL"
        or die "Cannot open $RTM_PL for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
use Time::localtime;
#use Symbol qw(gensym);
#use POSIX qw(mktime);
use File::Spec;
use File::Temp 'tempfile';
use Config; # for perlpath
use IO::Socket;
use Win32::Job;
#use Win32::OLE::NLS qw/:DATE/;

EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI lockProcess unlockProcess datetime_to_timestamp /;

# Version of script
EOF
    print $fh "my \$version = '$VERSION';\n";
    print $fh "my \$release_date = '$RELEASE_DATE';\n";
    print $fh <<'EOF';

# at this hour all information will be send
my $HOUR = 2;

# get WMI object
my $objWMI = getWMI();

# get uptime
my $osCol = $objWMI->ExecQuery('SELECT LastBootUpTime FROM Win32_OperatingSystem');
my $objOS = (in $osCol)[0]
  or die "Cannot get Win32_OperatingSystem object from WMI";
my $uptime = time - datetime_to_timestamp($objOS->LastBootUpTime);

my (undef, undef, $script_name) = File::Spec->splitpath($0);

EOF
    print $fh "my \$base_dir          = '$DIR';\n";
    print $fh "my \$etc_dir           = '$DIR_ETC';\n";
    print $fh "my \$tmp_dir           = '$DIR_TMP';\n";
    print $fh "my \$scripts_dir_daily = '$DIR_SCRIPTS_DAILY';\n";
    print $fh "my \$scripts_dir_hour  = '$DIR_SCRIPTS_HOUR';\n";
    print $fh "my \$scripts_dir_min   = '$DIR_SCRIPTS_MIN';\n";
    print $fh "my \$rtm_update_ip     = '$RTM_UPDATE_IP';\n";
    print $fh "my \$LOCK_FILE         = '$LOCK_FILE';\n";
    print $fh <<'EOF';

# get scripts to run
opendir my $scripts_daily_fh, $scripts_dir_daily
  or die "Cannot open $scripts_dir_daily";
chomp(my @scripts_daily = grep { $_ !~ /^\.|\.\.$/ } readdir $scripts_daily_fh);
closedir $scripts_daily_fh;
opendir my $scripts_hour_fh, $scripts_dir_hour
  or die "Cannot open $scripts_dir_hour";
chomp(my @scripts_hour = grep { $_ !~ /^\.|\.\.$/ } readdir $scripts_hour_fh);
closedir $scripts_hour_fh;
opendir my $scripts_min_fh, $scripts_dir_min
  or die "Cannot open $scripts_dir_min";
chomp(my @scripts_min = grep { $_ !~ /^\.|\.\.$/ } readdir $scripts_min_fh);
closedir $scripts_min_fh;

# FIXME
#my $env_path = $ENV{'PATH'};
#$ENV{'PATH'} = "c:\\ovh\\rtm-client\\bin\\:$env_path";

# global variable used to report errors from failed scripts
my $script_error = 0;

# determine rtm server ip from mrtg config
my $ipfile = File::Spec->catfile($etc_dir, "rtm-ip");
open FP, "$ipfile" or die("failed to open '$ipfile' for reading: $!");
chomp(my $destination_ip = <FP>);
close FP;
if ($destination_ip !~ /^\d+\.\d+\.\d+\.\d+$/) {
  die "failed to read destination ip from '$ipfile': invalid ip: $destination_ip";
}

lockProcess($LOCK_FILE);

my $TIMEOUT = 45;

my $tm = localtime(time);
my $hour = $tm->hour;
my $min = $tm->min;

my @scripts_to_run = ();

# per minute data
push @scripts_to_run, map { File::Spec->catfile($scripts_dir_min, $_) } @scripts_min;

# hourly data
if ((scalar @ARGV == 0) or (($min >= 0) && ($min <= 5)) or $uptime < 900) {
  send_info("hINFO_uptime|" . $uptime);
  push @scripts_to_run, map { File::Spec->catfile($scripts_dir_hour, $_) } @scripts_hour;
}

# daily data
if (scalar @ARGV == 0 || (($hour eq $HOUR || $uptime < 900) && $min % 10 == 0)) {
  send_info("dINFO_RTM_version|" . $version);
  push @scripts_to_run, map { File::Spec->catfile($scripts_dir_daily, $_) } @scripts_daily;
}

# update rtm-ip daily
if (@ARGV > 0 && $hour eq $HOUR && $ARGV[0] == $min) {
  system("perl $rtm_update_ip &");
}

# XXX
#$File::Temp::KEEP_ALL = 1;
#print Dumper \@scripts_to_run;

# create job object
my $job = Win32::Job->new()
  or die "Cannot create Win32::Job: $^E";

my %scripts_output = ();
foreach my $script (@scripts_to_run) {
  my (undef, undef, $script_name) = File::Spec->splitpath($script);
  # generate tmp file for stdout
  my $P_STDOUT =
  tempfile("rtm_script_${script_name}_XXXXX",
    DIR    => $tmp_dir,
    SUFFIX => '.stdout',
    UNLINK => 1,
  );
  # generate tmp file for stdout
  my $P_STDERR =
  tempfile("rtm_script_${script_name}_XXXXX",
    DIR    => $tmp_dir,
    SUFFIX => '.stderr',
    UNLINK => 1,
  );

  my $perl_exe = $Config{perlpath};
  my $pid = $job->spawn(
    $perl_exe, # executable
    "\"$perl_exe\" \"$script\"", # script
    {
      stdin => File::Spec->devnull,
      stdout => $P_STDOUT,
      stderr => $P_STDERR,
      no_window => 0,
      new_group => 1,
    }
  ) or die "Cannot spawn $script: $^E";

  $scripts_output{$pid} = {
    'script' => $script,
    'stdout' => $P_STDOUT,
    'stderr' => $P_STDERR,
    'error'  => [],
  };
}

# run all the scripts
$job->run($TIMEOUT);

# gather exit codes of scripts
my $scripts_status = $job->status;
foreach my $pid (keys %$scripts_status) {
  $scripts_output{$pid}->{status} = $scripts_status->{$pid}->{exitcode};# >> 8;
}

# read their output
foreach my $script (values %scripts_output) {
  # XXX
#  warn "Reading output of script $script->{script}\n";

  my $stdout = $script->{stdout};
  my $stderr = $script->{stderr};

  # seek to beginning of the file
  seek $_, 0, 0 for ($stdout, $stderr);

  chomp(my @stdout_lines = <$stdout>);
  chomp(my @stderr_lines = <$stderr>);
#print Dumper $script, \@stdout_lines, @stderr_lines;

  close $stdout;
  close $stderr;

  if (@stdout_lines) {
    send_info(\@stdout_lines)
  }

  if (@stderr_lines) {
    $script->{error} = \@stderr_lines;
  }
}

# find scripts which returned error
foreach my $slot (values %scripts_output) {
  next if $slot->{'status'} == 0;

  # check if script timed out
  if ($slot->{status} == 293) {
    unshift @{$slot->{error}}, 'timeout';
  }

  #print Dumper $slot;
  # get script's name
  my (undef, undef, $script_name) = File::Spec->splitpath($slot->{script});
  my $stderr = join ' ', map { chomp; $_ } @{$slot->{'error'}}; # perl sucks
  if (length $stderr > 20) {
    $stderr = substr($stderr, 0, 150);
    $stderr .= '...';
  }
  chomp($stderr);
  $script_error = "1 $script_name $stderr";
  # TODO: it currently sends errors for the first failed script
  last;
}
send_info("mINFO_RTM_status|$script_error");

unlockProcess($LOCK_FILE);
exit 0;


sub send_info {
  my $message = shift;
  my @messages;
  if (!ref $message) {
    push @messages, $message;
  } elsif (ref $message eq 'ARRAY') {
    @messages = @$message;
  } else {
    die 'send_info(): unsupported argument of type '.ref $message;
  }

  foreach my $line (@messages) {
    my $ok = eval {
      my $socket = IO::Socket::INET->new(
        Proto    => 'udp',
        PeerAddr => $destination_ip,
        PeerPort => 6100 + int(rand(100)),
#        PeerAddr => 'localhost',
#        PeerPort => 12345,
        Timeout  => 10,
      ) or die "Cannot create socket: $!";
      $socket->send("rtm $line")
        or die "Cannot send UDP message: $!";
      print "rtm $line\n";
      $socket->close();
    };
    if (!defined($ok)) {
      $script_error = "1 send_info() rtm timeout";
      warn "error: $@\n";
    }
  }
}
EOF
close $fh;
}

# 
# Generate rtm-uninstall.cmd file
sub generate_rtm_uninstall {
    print "Generating rtm-uninstall.cmd...\n";
    open my $fh, '>', "$RTM_UNINSTALL"
        or die "Cannot open $RTM_UNINSTALL for writing";
    print $fh <<'EOF';
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
del /f %0
goto endofuninstallrtm
:WinNT
perl -x -S %0 %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofuninstallrtm
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
del /f %0
goto endofuninstallrtm
@rem ';
#!perl
use strict;
use File::Path 'rmtree';
use Win32;
use File::Spec;

EOF
    print $fh "my \$LOCK_FILE    = '$LOCK_FILE';\n";
    print $fh "my \$DIR          = '$DIR';\n";
    print $fh "my \$DEVNULL      = '$DEVNULL';\n";
    print $fh "my \$PROGRAMS_DIR = '$PROGRAMS_DIR';\n";
    print $fh <<'EOF';

chdir File::Spec->rootdir()
    or die "Cannot change directory to root";

my @schedule_params_remove = (
  '/delete',
  '/f',                   # force deletion
  '/tn' => 'rtm',         # task name
);
print "Removing any previous rtm copies from task-scheduler...\n";
system("schtasks @schedule_params_remove >$DEVNULL 2>$DEVNULL");
dieMsg("Cannot remove rtm from task-scheduler") unless ($? >> 8 == 0 || $? >> 8 == 1);

until(lockProcess($LOCK_FILE)) {
  print "rtm is currently running, waiting till it's finished...\n";
  sleep 1;
}

# if -u option is specified -- uninstall
print "Uninstalling rtm...\n";
unlockProcess($LOCK_FILE);
removeDirectoryPath($DIR);
removeDirectoryPath($PROGRAMS_DIR);
 print "\nRTM has been successfully uninstalled\n";
exit 0;

sub removeDirectoryPath {
  my $dir = shift 
    or dieMsg("No directory specified");
  return 1 unless -e $dir;
  eval { rmtree($dir, 0) };
  dieMsg("Cannot remove directory tree '$dir': $@")
    if $@;
#  dieMsg("Cannot remove directory tree '$dir'")
#    if -e $dir;

  return 1;
}

sub lockProcess {
  my $lockFile = shift || dieMsg("No lock file specified");
  my $objWMI = getWMI();
  
  my $pid = $$;

  if (-e "$lockFile") {
    open(LOCKFILE, $lockFile) or dieMsg("Impossible to open lock file: $lockFile !!!");
    my $lockPID=<LOCKFILE> || "";
    close(LOCKFILE);

    if ($lockPID !~ m/^\d+$/ ) {
      warn("There is no PID in lock. Something is broken...");
      return undef
    }
    my $procCol = $objWMI->ExecQuery("SELECT ProcessId FROM Win32_Process WHERE ProcessId = \'$lockPID\'");

    if (scalar(in $procCol) > 0) {
      return 0;
    }
    warn("There is a lock file $lockFile, but no process for it. Overwritting lock file");
  }

  open(LOCKFILE, ">$lockFile")  or dieMsg("Impossible to open lock file for writting: $lockFile !!!");
  print LOCKFILE $pid;
  close(LOCKFILE);

  return 1;
}

sub unlockProcess {
    my $lockFile = shift || dieMsg("No lock file specified");
    unlink($lockFile)
      or warn "Cannot delete lock file: $!";
}

sub getWMI {
  require Win32::OLE;

  my %options = (
  	namespace => 'root\\cimv2',
  	machine   => '.',
  	warn      => 0,
  );

  my %options_override = @_;

  # override default options
  $options{$_} = $options_override{$_} for keys %options_override;

  my $objWMI = Win32::OLE->GetObject('winmgmts:\\\\' . $options{machine} . '\\' . $options{namespace})
  	or dieMsg("FATAL: ".Win32::OLE->LastError());

  return $objWMI;
}

sub dieMsg {
    msg(@_);
    die @_;
}

sub msg {
    my (%options, $msg);

    %options = (
        icon => MB_ICONSTOP,
        addCopyInfo => 1,
    );
    if (ref $_[0] eq 'HASH') {
        my $params = shift;
        $options{$_} = $params->{$_} for keys %$params;
    }
    $msg .= $_ for @_;

    $msg = "[To copy contents of this window press CTRL+C when it has focus].\n".$msg
        if $options{addCopyInfo};

    Win32::MsgBox($msg, $options{icon});
}

__END__
:endofuninstallrtm
EOF
close $fh;
}

# 
# Generate rtm-update-ip.pl file
sub generate_rtm_update_ip {
    print "Generating rtm-update-ip.pl...\n";
    open my $fh, '>', "$RTM_UPDATE_IP"
        or die "Cannot open $RTM_UPDATE_IP for writing";
    print $fh <<EOF;
# version: $VERSION ($RELEASE_DATE)

\$ENV{"LC_ALL"} = "POSIX";

EOF
    print $fh <<'EOF';
use strict;
EOF
    print $fh "use lib '$DIR_LIB';\n";
    print $fh <<'EOF';
use OVH::Common qw/ getWMI /;
use File::Spec;

my $devnull = File::Spec->devnull;

EOF
    print $fh "my \$rtm_ip_file = File::Spec->catfile('$DIR_ETC', 'rtm-ip');\n";
    print $fh <<'EOF';
my $objWMI = getWMI();

my $objIPCol = $objWMI->ExecQuery('SELECT DefaultIPGateway from Win32_NetworkAdapterConfiguration WHERE IPEnabled = 1');
die "Cannot get default gateway IP from WMI"
  unless scalar (in $objIPCol) > 0;

my $ipArray = (in $objIPCol)[0]->DefaultIPGateway;
my ($ip) = grep { /(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ } @$ipArray;
defined $ip or die "Cannot get default gateway";

$ip =~ s/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/$3.$2.$1/;
$ip = "mrtg.$ip.in-addr.arpa";

my $dns_ip = '213.186.33.99';
my $nslookup_raw = `nslookup -type=A $ip $dns_ip 2> $devnull`;
my @addresses = grep { $_ !~ /$dns_ip/ } ($nslookup_raw =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/mg);
my $mrtg_ip = shift @addresses
    or die "Cannot get MRTG IP";

warn "WARN: Multiple IPs present, using first one\n"
    if scalar @addresses;

open my $fh, '>', $rtm_ip_file or die "Cannot write IP to $rtm_ip_file";
print $fh $mrtg_ip, "\n";
close $fh;
EOF
close $fh;
}

__END__
:endofperl
ENDLOCAL

