#!/usr/bin/perl

use strict;

# checkXXX function synopsis:
#
# ($agent, $name) = checkXXX();
#
# Here $agent contains name of agent, ie "PleskX"
# $name contains name of the panel, ie "Plesk 7.1.5"
#
# If undef is returned from the checker, no platform was detected.
#

use IO::File;

my @checkers;

# Cgp

sub checkCgp {
}
push @checkers, \&checkCgp;

# ConfixxX

sub checkConfixxX {
  my $conf = _getConfixxMainConfigPath();
  my $installDir;

  if ($conf) {

    `cat $conf` =~ /\$installDir\s*=\s*[\'\"](.*)[\'\"]/;
    $installDir = $1;

    unless (-x "$installDir/confixx_updatescript.pl") {
      return;
    }

    my $out = `$installDir/confixx_updatescript.pl VERSION 2>/dev/null`;
    chomp $out;
    if ($out =~ /^(?:premium\s+)?(\d+)\.(\d+)\.?(\d+)?/i) {
      return ["ConfixxX", "Confixx " . $1 . "." . $2 . "." . ($3 || 0)];
    } else {
      $out = `$installDir/confixx_updatescript.pl --version 2>/dev/null`;
      chomp $out;
      if ($out =~ /^(\d+)\.(\d+)\.?(\d+)?/) {
        return ["ConfixxX", "Confixx " . $1 . "." . $2 . "." . ($3 || 0)];
      }
      }
  }
}

sub _getConfixxMainConfigPath() {
  return 
    _guessConfixxMainConfigPathFromEnv() ||
    _guessConfixxMainConfigPathFromStandardPaths() ||
    _guessConfixxMainConfigPathFromCrontab();
}

sub _guessConfixxMainConfigPathFromEnv {
  if (exists($ENV{'CONFIXX_ROOT'} ) && -d $ENV{'CONFIXX_ROOT'}) {
    my $path = $ENV{'CONFIXX_ROOT'} . '/confixx_main.conf';
    return $path if -r $path;
  }

  return undef;
}

sub _guessConfixxMainConfigPathFromStandardPaths {
  foreach my $prefix ('./','/root/confixx/','/usr/local/confixx/','/confixx/') {
    my $path = $prefix . 'confixx_main.conf';
    return $path if -r $path;
  }

  return undef;
}

sub _guessConfixxMainConfigPathFromCrontab {
  return 
    _guessConfixxMainConfigPathFromCrontabCommand(findBin('grep') . ' -hr confixx /etc/crontab /etc/cron.d') ||
    _guessConfixxMainConfigPathFromCrontabCommand(findBin('crontab') . ' -l');
}

sub _guessConfixxMainConfigPathFromCrontabCommand {

  my ($crontabLinesCommand) = @_;

  foreach my $line (`$crontabLinesCommand`) {
    chomp $line;
    next if ( $line =~ /^\s*#/ ); # skip comment line

    my @lineParts = split(' ', $line);
    my $command = $lineParts[scalar(@lineParts) - 1]; # we assume that the last part of a line is a command
    if ($command =~ /^(.*)\/[^\/]*$/) {
      my $commandBaseDir = $1;
      my $path = $commandBaseDir. '/confixx_main.conf';

      return $path if -r $path;
    }
  }

  return undef;
}

push @checkers, \&checkConfixxX;


# cPanel9

sub checkcPanel9 {
  my $confFile = '/var/cpanel/cpanel.config';

  my ($cf, $line) = (new IO::File);
  if ((-T $confFile) && $cf->open("<$confFile")) {
    while ($line = $cf->getline()) {
      chomp $line;
      next unless $line;
      next if ($line =~ /^#/);
      my ($key, $value) = split(/\s*=\s*/, $line, 2);
      $key =~ s/^\s+//;

      if ($key =~ /engineroot/) {
        my ($cpanelTool, @res) = ("$value/cpanel");
        if (-x $cpanelTool && (@res = `$cpanelTool 2>/dev/null`)) {
          foreach my $line (@res) {
            if ($line =~ /cPanel\s+\[(\d+)\.(\d+)/) {
              if ($1 eq '9' or $1 eq '10' or $1 eq '11') {
                return ["cPanel9", "cPanel $1.$2"];
              }
            }
          }
        }
      }
    }
    return ["cPanel9", "cPanel 9"];
  }
}
push @checkers, \&checkcPanel9;

# PPCPL

sub checkPPCPL {
  if (-e '/usr/bin/getapplversion') {
    my $ppcplVersion = `/usr/bin/getapplversion`;
    if ($ppcplVersion =~ /(\d+\.\d+\.\d+)-.*/) {
      return ["PPCPL", "PPCPL ".$1];
    }
  }
}
push @checkers, \&checkPPCPL;

# PleskX

sub moreThanVersion {
  my ($pmajor, $pminor, $pminorMinor, $major, $minor, $minorMinor) = @_;

  if ($pmajor > $major) {
    return 1;
  }
  if ($pmajor == $major && $pminor > $minor) {
    return 1;
  }
  if ($pmajor == $major && $pminor == $minor && $pminorMinor > $minorMinor) {
    return 1;
  }

  return 0;
}

sub getPleskVersion {
  my $confFile = "/etc/psa/psa.conf";

  my ($cf, $productRoot) = (new IO::File, "/usr/local/psa");
  if ((-T $confFile) && $cf->open("<$confFile")) {
    while (my $line = $cf->getline()) {
      chomp $line;
      next if ($line =~ /^#/);
      my ($param, $val) = split /\s+/, $line;
      if ($param =~ /PRODUCT_ROOT_D/) {
        $productRoot = $val;
        last;
      }
    }

    if (-T $productRoot . "/version" && $cf->open("<$productRoot/version")) {
      my ($version, $major, $minor, $minorMinor) = $cf->getline();
      chomp $version;

      if ($version =~ /^(\d+)\.(\d+)(.*)$/) {
        $major = $1;
        $minor = $2;

        if ($3 =~ /^\.(\d+)/) {
          $minorMinor = $1;
        }
        else {
          $minorMinor = 0;
        }
      }
      return [$major,$minor,$minorMinor];
    }
  }
  return;
}

sub checkPleskX {
  my $version = getPleskVersion();
  if (!defined $version) {
    return;
  }
  my ($major, $minor, $minorMinor) = @{$version};
  if ($major < 2 || ($major == 2 && $minor < 5)) {
    return;
  }

  if (moreThanVersion($major, $minor, $minorMinor, 10, 3, 1)) {
    return;
  }

  return ["PleskX", "Plesk $major.$minor.$minorMinor"];
}
push @checkers, \&checkPleskX;

# RaQ2

sub checkRaQ2 {
  my $buildFile = "/etc/build";

  my ($bf, $line) = (new IO::File);
  if ((-T $buildFile) && $bf->open("<$buildFile")) {
	while ($line = $bf->getline()) {
	  return ["RaQ2", "RaQ2"] if $line =~ /2799/ or $line =~ /2800/;
	}
  }
}
push @checkers, \&checkRaQ2;

# RaQ3

sub checkRaQ3 {
  my $buildFile = "/etc/build";

  my ($bf, $line) = (new IO::File);
  if ((-T $buildFile) && $bf->open("<$buildFile")) {
	while ($line = $bf->getline()) {
	  return ["RaQ3", "RaQ3"] if $line =~ /3000/;
	}
  }
}
push @checkers, \&checkRaQ3;

# RaQ550

sub checkRaQ550 {
  my $cce;
  if (eval 'use lib "/usr/sausalito/perl"; require CCE' and $cce = new CCE) {
	return ["RaQ550", "RaQ550"];
  }
}
push @checkers, \&checkRaQ550;



# RaQ4

sub checkRaQ4 {
  my $buildFile = "/etc/build";

  my ($bf, $line) = (new IO::File);
  if ((-T $buildFile) && $bf->open("<$buildFile")) {
	while ($line = $bf->getline()) {
	  return ["RaQ4", "RaQ4"] if $line =~ /3\d\d\d/;
	}
  }
}
push @checkers, \&checkRaQ4;


# Slash

sub checkSlash {
  my $confFile = '/usr/local/slash/admin/conf/admin.conf';

  if (-T $confFile) {
	return ["Slash", "Slash"];
  }
}
push @checkers, \&checkSlash;

# Plesk 1.3.x

sub checkPlesk13 {
  my $confFile = '/usr/local/plesk/admin/conf/admin.conf';

  if (-T $confFile) {
	return ["Plesk13", "Plesk13"];
  }
}
push @checkers, \&checkPlesk13;

# Hsphere

sub checkHsphere {
  my $propFile = '/home/hsphere/local/home/cpanel/shiva/psoft_config/hsphere.properties';

  if (-T $propFile) {
  	return ["HsphereX","HsphereX"];
  }
}
push @checkers, \&checkHsphere;

sub checkAlabanza {
  my $mainConfigFile = '/usr/local/account/config/cp.cfg';
  if (-T $mainConfigFile) {
    return ["AlabanzaX","AlabanzaX"];
  }
}
push @checkers, \&checkAlabanza;
# ------------------------------------------------------------------------------

# Normalization according to the XML 1.0 (Third Edition),
# clauses 2.3 "Common Syntactic Constructs"
# and 3.3.3 "Attribute-value normalization"

sub normalizeAttr {
  $_ = $_[0];
  s/\&/&amp;/g;
  s/\r/&#xD;/g;
  s/\n/&#xA;/g;
  s/\t/&#x9;/g;
  s/\</&lt;/g;
  s/\"/&quot;/g;
  s/\'/&#39;/g;
  return $_;
}

sub trim {
  my $string = shift;
  $string =~ s/^\s+//;
  $string =~ s/\s+$//;
  return $string;
}

sub readLine {
  my $filename = shift;
  return unless (-f $filename);
  open FILE, $filename or return;
  my $line = trim(<FILE>);
  close FILE;
  return $line;
}

sub getBitness {
  my $bitness = `uname -m`;
  return trim($bitness);
}

sub getFreeBSDVersion {
  my $release = `uname -rs`;
  return trim($release);
}

sub getVersionFromLsbRelease {
  my $lsb_release_file = shift;
  return unless (-f $lsb_release_file);
  open LSB_RELEASE, $lsb_release_file or return;
  my ($id, $release);
  while(<LSB_RELEASE>) {
    if(/^DISTRIB_ID=(.*)/){
      $id=$1;
    }
    elsif(/^DISTRIB_RELEASE=(.*)/) {
      $release=$1;
    }
  }
  close LSB_RELEASE;
  return unless ( defined $id && defined $release);
  return "$id $release"
}

sub getVersionFromIssue {
  my $release = readLine('/etc/issue.net');
  unless (defined $release) {
    $release = readLine('/etc/issue')
  }
  return $release;
}

my %distros = (
  '/etc/arch-release' => 'Arch Linux ',
  '/etc/debian_version' => 'Debian ',
  '/etc/gentoo-release' => 'Gentoo ',
  '/etc/mandrake-release' => 'Mandriva ',
  '/etc/redhat-release' => '',
  '/etc/sabayon-release' => 'Sabayon ',
  '/etc/slackware-version' => 'Slackware ',
  '/etc/SuSE-release' => '',
  '/etc/release' => ''
);

sub getLinuxVersion {
  my $release = getVersionFromLsbRelease('/etc/lsb-release');
  return $release if defined $release;

  my ($release_file,$distro);
  while ( ($release_file, $distro) = each %distros ){
    my $value = readLine($release_file);
    if( defined $value ) {
      $release = "$distro$value";
      return $release;
    }
  }
  $release = getVersionFromIssue();
  return $release if defined $release;

  return 'Linux';
}

sub printOsInfo {
  my $osname = `uname -s`;
  chomp $osname;

  my $release = $osname;
  if ($osname =~/FreeBSD/) {
    $release = getFreeBSDVersion();
  }
  else {
    $release = getLinuxVersion();
  }

  $release = $osname unless defined $release;
  my $osfullname = $release . " " . getBitness();

  my $loadavg;
  my $uptime = `uptime`;
  chomp $uptime;
  if ($uptime =~ /(\d+\.\d+),\s+(\d+\.\d+),\s+(\d+\.\d+)/) {
    $loadavg = "$1 $2 $3";
  }
  elsif ($uptime =~ /(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/) {
    $loadavg = "$1 $2 $3";
  } 
  else {
    my $rawloadavg = `cat /proc/loadavg`;
    chomp $rawloadavg;
    if ($rawloadavg =~ /(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/) {
      $loadavg = "$1 $2 $3";
    }
  }

  print '<os-info os="' . normalizeAttr($osfullname) .
        '" loadavg="' . normalizeAttr($loadavg) . '">' .
        printSoft() . '</os-info>';

}

sub printDetectedPanel {
  my $checker;
  foreach $checker (@checkers) {
	my $res = &{$checker}();
	if ($res) {
	  print '<detected-panel agent="' . normalizeAttr($res->[0]) . '"'
        . ' name="' . normalizeAttr($res->[1]) . '"';
      print '/>';
	}
  }
}

sub isPseudoFs {
  my ($type) = @_;

  my %pseudofs = (
				  'autofs' => 1,
				  'binfmt_misc' => 1,
				  'cd9660' => 1,
				  'devfs' => 1,
				  'devpts' => 1,
				  'fdescfs' => 1,
				  'iso9660' => 1,
				  'linprocfs' => 1,
				  'proc' => 1,
				  'procfs' => 1,
				  'romfs' => 1,
				  'sysfs' => 1,
				  'tmpfs' => 1,
				  'usbdevfs' => 1,
				  'usbfs' => 1,
				  'rpc_pipefs' => 1,
				  'fdesc' => 1,
				  'none' => 1
				 );

  return 1 if defined($pseudofs{$type});
  # MacOS pseudofs, such as <volfs>
  return 1 if $type =~ /^<.*>$/;
}

sub printDetectedFs {
  my ($fsOnly) = @_;

  my %mounts;

  my $osname = `uname -s`;
  chomp $osname;

  if ($osname eq 'FreeBSD') {
	foreach my $mountinfo (`mount -p`) {
	  chomp $mountinfo;
	  my ($device, $mountpoint, $type, $options) = split /\s+/, $mountinfo;
	  my $mode = 'rw';
	  $mode = 'ro' if ($options =~ /(^|,)ro(,|$)/);

	  unless (isPseudoFs($type)) {
		$mounts{$mountpoint} = ();
		$mounts{$mountpoint}->{'device'} = $device;
		$mounts{$mountpoint}->{'mode'} = $mode;
		$mounts{$mountpoint}->{'type'} = $type;
	  }
	}
  } elsif ($osname eq 'Linux') {
	foreach my $mountinfo (`mount`) {
	  chomp $mountinfo;
	  #unable to use 'undef' here - perl 5.004 compatibility
	  my ($device, $undef, $mountpoint, $undef, $type, $options) = split /\s+/, $mountinfo;
	  my $mode = 'rw';
	  $mode = 'ro' if ($options =~ /[(,]ro[,)]/);

          my ($fs, $opts) = split /,/, $type, 2;

	  unless (isPseudoFs($fs)) {
		$mounts{$mountpoint} = ();
		$mounts{$mountpoint}->{'device'} = $device;
		$mounts{$mountpoint}->{'mode'} = $mode;
		$mounts{$mountpoint}->{'type'} = $fs;
	  }
	}
  } elsif ($osname eq 'Darwin') {
    foreach my $mountinfo (`mount`) {
      chomp $mountinfo;
      my ($device, $mountpoint, $options) = ($mountinfo =~ /^(.*)\son\s(.*?)(?:\s(\(.*\)))?$/);
      my $mode = 'rw';
      $mode = 'ro' if ($options =~ /[( ]read-only[,)]/);

      unless(isPseudoFs($device)) {
        $mounts{$mountpoint} = ();
        $mounts{$mountpoint}->{'device'} = $device;
        $mounts{$mountpoint}->{'mode'} = $mode;
        $mounts{$mountpoint}->{'type'} = 'unknown';
      }
    }
  } else {
	die "Unknown OS type";
  }

  my %partitions;

  my $header = `LANG=C POSIXLY_CORRECT= df -Pl | head -n 1`;
  unless ($header =~ /\s(\d+)-/) {
	die "Unable to determine block size in df output. First line looks like '$header'";
  }
  my $blocksize = $1;

  foreach my $dfinfo (`LANG=C POSIXLY_CORRECT= df -Pl | tail -n +2`) {
    chomp $dfinfo;

    my ($undef, $size, $undef, $free, $undef, $mountpoint) =
        ($dfinfo =~ m|^(.*)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+%)\s+(/.*)$|);

    if (exists $mounts{$mountpoint}) {
      # for brain-dead NFS shares:
      $free = $size if $free > $size;

      $size *= $blocksize;
      $free *= $blocksize;

      next if $free =~ /[eE]\+/ or $size =~ /[eE]\+/;

      $partitions{$mountpoint} = $mounts{$mountpoint};
      $partitions{$mountpoint}->{'size'} = $size;
      $partitions{$mountpoint}->{'free'} = $free;
    }
  }

  if ($fsOnly) {
    print "<fs-detection>";
  } else {
    print "<remote-fs>";
  }

  foreach my $partition (keys %partitions) {
	print '<fs mountpoint="' . normalizeAttr($partition) . '" '.
	  'device="' . normalizeAttr($partitions{$partition}->{'device'}) . '" ' .
	  'mode="' . normalizeAttr($partitions{$partition}->{'mode'}) . '" ' .
	  'size="' . normalizeAttr($partitions{$partition}->{'size'}) . '" ' .
	  'free="' . normalizeAttr($partitions{$partition}->{'free'}) . '" ' .
	  'type="' . normalizeAttr($partitions{$partition}->{'type'}) . '"/>';
  }

  if ($fsOnly) {
    print "</fs-detection>";
  } else {
    print "</remote-fs>";
  }
}

sub findBin {
  my ($bin) = @_;
  my @paths = split /:/, $ENV{'PATH'};
  push @paths, '/var/qmail/bin/';
  for my $i (@paths) {
    if (-X "$i/$bin") {
      return "$i/$bin";
    }
  }
}

sub printPackage {
  my ($name, $version) = @_;

  my $package = "<package-installed name=\"" . $name . "\"";
  if ( defined $version ) {
    $package .= " version=\"" . $version . "\"";
  }
  $package .= "/>";
  return $package;
}

sub printSoft {
  my ($soft, $version);

  if (findBin('mysql')) {
    my $mysql = findBin('mysql').' --version';
    $version = `$mysql`;
    if($version=~/Distrib (\d+\.\d+)\./) {
      $soft = printPackage('mysql', $1);
    }
  }

  if (findBin('psql')) {
    my $psql = findBin('psql')." --version | awk '{print \$3}'";
    $version = `$psql`;
    chomp $version;
    if ($version=~/(\d+\.\d+\.\d+).*/){
      $soft .= printPackage('postgresql', $1);
    }
  }

  my $apache;
  if (findBin('apache2ctl')) {
    $apache = findBin('apache2ctl')." -v";
  }elsif(findBin('apachectl')) {
    $apache = findBin('apachectl')." -v";
  }

  $version = `$apache`;
  chomp $version;
  if ($version =~ /Server\s+version:\s+([^\/]*)\/(\d+\.\d+\.\d+)/) {
    $soft .= printPackage('apache', $2);
  }

  if (findBin('tcp-env')) {
    $soft .= printPackage('qmail');
  }

  if (findBin('sendmail')) {
    $soft .= printPackage('sendmail');
  }

  if (findBin('rsync')) {
    my $rsync = findBin('rsync').' --version';
    $version = `$rsync`;
    if($version=~/rsync  version (\d+\.\d+\.\d+)/) {
      $soft .= printPackage('rsync', $1);
    }
  }

  my $plesk = getPleskVersion();
  if (defined $plesk) {
    my ($major, $minor, $minorMinor) = @{$plesk};
    $soft .= printPackage('plesk', "$major.$minor.$minorMinor");
  }

  return $soft;
}


if (scalar(@ARGV) > 1 || (scalar(@ARGV) == 1 && $ARGV[0] ne '--fs-only')) {
  die "Usage: scout.pl [--fs-only]";
}

print '<?xml version="1.0"?>';

if (scalar(@ARGV) == 1) {
  printDetectedFs(1);
} else {
  print '<scout-result>';
  printDetectedPanel();
  printOsInfo();
  printDetectedFs();
  print "</scout-result>";
}