#!/usr/bin/env perl

# This script checks whether every build under the root archive
# directory (currently /nmi/dir) on grandcentral has been reflected in
# the Mysql database. A report of all ghost builds (present in the
# archive but not in db) is created and sent to stdout or via email.
# Optionally, the script will also remove the found ghost directories

use warnings;
use strict;
use Getopt::Long;
use DBI;
use Mail::Mailer;

use lib $ENV{'NMI_LIB'} || "/nmi/lib";
use NmiConf;

my $usage = "usage: $0 [--mailto=<addr_list>] [--verbose] [--clean][--help]\n";

my $res = GetOptions ( 'help' => \$main::opt_help,
		       'mailto=s' => \$main::opt_mailto,
		       'verbose' => \$main::opt_verbose,
		       'clean' => \$main::opt_clean
		     );

unless ($res) {
  print $usage;
  exit 1;
}

if (defined $main::opt_help) {
    print $usage;
    exit 0;
}

my $nmiconf = $NmiConf::NMICONF_DEFAULT if -f $NmiConf::NMICONF_DEFAULT;

if (defined $main::opt_nmiconf) {
  die "Config file ${main::opt_nmiconf} does not exist. Exiting...\n"
    unless -f $main::opt_nmiconf;
  $nmiconf = $main::opt_nmiconf;
}

die "FATAL: $0: No config file specified.\n" unless defined $nmiconf;
die "FATAL: $0: Config file $nmiconf is not readable.\n" unless -r $nmiconf;

my %conf;
my $fh = new IO::File $nmiconf, 'r';
die "Could not open $nmiconf: $!" unless defined $fh;
NmiConf::parse(\%conf, $fh);
$fh->close;

# database parameters
for my $key qw(database username password mysqlhost rundir) {
  die "FATAL: $0: config file $nmiconf does not contain value for $key."
    unless exists $conf{$key};
}

my $database = $conf{'database'};
my $username = $conf{'username'};
my $password = $conf{'password'};
my $mysqlhost = $conf{'mysqlhost'};
my $this_host = $conf{'this_host'};

my $DB_CONNECT_STR = "DBI:mysql:database=$database;host=$mysqlhost";
$DB_CONNECT_STR .= ";port=${conf{'mysqlport'}}"  if exists $conf{'mysqlport'}
  and defined $conf{'mysqlport'};

my $ARCHIVE_DIR=$conf{'rundir'};

my $dbh = DBI->connect($DB_CONNECT_STR, $username, $password);
die "Could not connect to mysql db '$database' on $mysqlhost: ",
    $DBI::errstr unless defined $dbh;

my $total = 0;         # total number of dir entries
my $ghost = 0;         # number of ghost builds
my $report = [];
my $verbose = (defined $main::opt_verbose)? 1 : 0;
my $clean = (defined $main::opt_clean)? 1 : 0;

opendir D, $ARCHIVE_DIR or die "Could not opendir $ARCHIVE_DIR: $!";
while (defined (my $gid = readdir D)) {
  next if $gid eq '.' or $gid eq '..';

  $total++;
  my $cmd_str = qq/SELECT finish,archived,archive_results_until FROM Run WHERE gid='$gid'/;
  my $handle = $dbh->prepare("$cmd_str") or die "Could not prepare mysql statement '$cmd_str': ",
    $DBI::errstr;
  unless ($handle->execute() ) {
    add($report, "FATAL: Could not execute statement '$cmd_str': ${DBI::errstr}");
    last;
  }
  unless ($handle->fetchrow_hashref()) {
    my $size = `du -s -B M /nmi/run/$gid`;
    chomp $size;
    add($report, $size);
    if ($clean) {
      my $cmd = "rm -rf ${ARCHIVE_DIR}/$gid";
      next unless system("$cmd");

      if ($? == -1) {
	add($report, "failed to execute '$cmd': $!");
      }
      elsif ($? & 127) {
	my $msg = sprintf "while executing '$cmd', child died with signal %d, %s coredump\n",
	  ($? & 127),  ($? & 128) ? 'with' : 'without';
	add($report, $msg);
      }
      else {
	my $msg = sprintf "while executing '$cmd', child exited with value %d\n", $? >> 8;
	add($report, $msg);
      }
    }
  }
}
closedir D;

$dbh->disconnect;

if (defined $main::opt_mailto and $ghost) {
  my @rcpts = split /,/, $main::opt_mailto;
  my $mailer = Mail::Mailer->new;
  my $user = `whoami`;
  chomp $user;
  print "Sending email report to ", join ' ', @rcpts, "\n";
  $mailer->open( {To => [@rcpts],
		  From => "$user\@cs.wisc.edu",
		  Subject => "${this_host} builds sanity check: $ghost ghosts out of $total."});
  for my $line (@{$report}) {
    print $mailer $line, "\n";
  }
  $mailer->close;
} else {
  for my $line (@{$report}) {
    print $line, "\n";
  }
  print "\nFound $ghost ghost builds out of $total.\n" if $verbose;
}

sub add {
  my ($rep, $msg) = @_;
  push @{$rep}, $msg;
  $ghost++;
}
