#! /usr/bin/perl -w

use strict;
use Getopt::Long;
use POSIX;

our ($PINTOSDIR) = "/usr/class/cs140/pintos/pintos";

our ($verbose) = 0;
our ($start) = -d 'pintos/src' ? 4 : 1;
our ($stop) = 7;

GetOptions ("v|verbose+" => \$verbose,
	    "h|help" => sub { usage (0) },
	    "r|replace" => sub {
		die "Can't start from step 2: pintos/src does not exist\n"
		  if ! -d 'pintos/src';
		$start = 2;
	    },
	    "x|extract" => sub { $stop = 2 },
	    "c|clean" => sub { $stop = 3 },
	    "b|build" => sub { $stop = 4 },
	    "t|test" => sub { $stop = 6 })
  or die "Malformed command line; use --help for help.\n";

die "Exactly one non-option argument required; use --help for help.\n"
  if @ARGV != 1;

my (@valid_projects) = ('threads', 'userprog', 'vm', 'filesys');
my ($project) = $ARGV[0];
$project = $valid_projects[$project - 1] if $project =~ /^[1234]$/;
die "Unknown project \"$project\"; use --help for help.\n"
  if !grep ($_ eq $project, @valid_projects);

sub usage {
    my ($exitcode) = @_;
    print <<EOF;
run-tests, runs tests for grading a single submitted project

usage: run-tests PROJECT
where PROJECT is a project name (threads, userprog, vm, filesys)
or number (1-4).

Invoke from a directory containing a student tarball named by
the submit script, e.g. username.MMM.DD.YY.hh.mm.ss.tar.gz,
or a pintos/src directory containing a student submission.

Workflow:
  1. Extracts the source tree into pintos/src.
  2. Replaces the existing pintos/src/tests directory by a pristine
     copy, which must be available in $PINTOSDIR.
  3. Cleans the source tree.
  4. Builds the source tree.
  5. Runs the tests on the source tree and grades them.
  6. Copies the grade report to tests.out.
  7. Cleans the source tree again.

Note:
  If pintos/src already exists, run-tests starts from step 4.
  To force it to start from step 1, remove the pintos directory.
  To force it to start from step 2, use --replace.

Options:
  -r, --replace      Start at step 2.
  -x, --extract      Stop after step 2.
  -c, --clean        Stop after step 3.
  -b, --build        Stop after step 4.
  -t, --test         Stop after step 6.
  -v, --verbose      Print command lines of subcommands before executing them.
  -h, --help         Print this help message.
EOF
    exit $exitcode;
}

if (do_step (1)) {
    my ($tarball) = choose_tarball ();

    print "Extracting $tarball...\n";
    xsystem ("tar xzf $tarball", DIE => "extraction failed\n");
}

if (do_step (2)) {
    print "Replacing tests with pristine copy...\n";
    xsystem ("rm -rf pintos/src/tests",
	     DIE => "removal of old tests failed\n");
    xsystem ("cp -pR $PINTOSDIR/src/tests pintos/src/tests",
	     DIE => "replacement of tests failed\n");
}

if (do_step (3)) {
    print "Cleaning...\n";
    xsystem ("cd pintos/src && make clean", DIE => "clean failed");
}

if (do_step (4)) {
    print "Building...\n";
    xsystem ("cd pintos/src/$project && make", DIE => "build failed");
}

if (do_step (5)) {
    print "Grading...\n";
    xsystem ("cd pintos/src/$project && make grade", DIE => "grade failed");
}

if (do_step (6)) {
    print "Saving grade report to tests.out...\n";
    xsystem ("cp pintos/src/$project/build/grade tests.out",
	     DIE => "copy failed");
    xsystem ("(cd pintos/src/$project/build && find tests -name '*.output' "
	     . " | xargs grep '^hd[01]:[01]: [0-9]') > hdd.stats");
}

if (do_step (7)) {
    print "Cleaning...\n";
    xsystem ("cd pintos/src && make clean", DIE => "clean failed");
}

# do_step ($N)
#
# Returns true if step $N should be executed.
sub do_step {
    my ($n) = @_;
    return $n >= $start && $n <= $stop;
}

# Returns the name of the tarball to extract.
sub choose_tarball {
    my (@tarballs)
	= grep (/^[a-z0-9]+\.[A-Za-z]+\.\d+\.\d+\.\d+\.\d+.\d+\.tar\.gz$/,
		glob ("*.tar.gz"));
    die "no pintos dir, no files matching username.MMM.DD.YY.hh.mm.ss.tar.gz\n"
	if scalar (@tarballs) == 0;

    if (@tarballs > 1) {
	# Sort tarballs in order by time.
	@tarballs = sort { ext_mdyHMS ($a) cmp ext_mdyHMS ($b) } @tarballs;

	print "Multiple tarballs:\n";
	print "\t$_ submitted ", ext_mdyHMS ($_), "\n" foreach @tarballs;
	print "Choosing $tarballs[$#tarballs]\n";
    }
    return $tarballs[$#tarballs];
}

# Extract the date within a tarball name into a string that compares
# lexicographically in chronological order.
sub ext_mdyHMS {
    my ($s) = @_;
    my ($ms, $d, $y, $H, $M, $S) =
	$s =~ /.([A-Za-z]+)\.(\d+)\.(\d+)\.(\d+)\.(\d+).(\d+)\.tar\.gz$/
	or die;
    my ($m) = index ("janfebmaraprmayjunjulaugsepoctnovdec", lc $ms) / 3
	or die;
    return sprintf "%02d-%02d-%02d %02d:%02d:%02d", $y, $m, $d, $H, $M, $S;
}

sub xsystem {
    my ($command, %options) = @_;
    print "$command\n" if $verbose || $options{VERBOSE};

    my ($log) = $options{LOG};

    my ($pid, $status);
    eval {
	local $SIG{ALRM} = sub { die "alarm\n" };
	alarm $options{TIMEOUT} if defined $options{TIMEOUT};
	$pid = fork;
	die "fork: $!\n" if !defined $pid;
	if (!$pid) {
	    if (defined $log) {
		open (STDOUT, ">output/$log.out");
		open (STDERR, ">output/$log.err");
	    }
	    exec ($command);
	    exit (-1);
	}
	waitpid ($pid, 0);
	$status = $?;
	alarm 0;
    };

    my ($result);
    if ($@) {
	die unless $@ eq "alarm\n";   # propagate unexpected errors
	my ($i);
	for ($i = 0; $i < 10; $i++) {
	    kill ('SIGTERM', $pid);
	    sleep (1);
	    my ($retval) = waitpid ($pid, WNOHANG);
	    last if $retval == $pid || $retval == -1;
	    print "Timed out - Waiting for $pid to die" if $i == 0;
	    print ".";
	}
	print "\n" if $i;
	$result = 'timeout';
    } else {
	if (WIFSIGNALED ($status)) {
	    my ($signal) = WTERMSIG ($status);
	    die "Interrupted\n" if $signal == SIGINT;
	    print "Child terminated with signal $signal\n";
	}

	my ($exp_status) = !defined ($options{EXPECT}) ? 0 : $options{EXPECT};
	$result = WIFEXITED ($status) && WEXITSTATUS ($status) == $exp_status
	    ? "ok" : "error";
    }


    if ($result eq 'error' && defined $options{DIE}) {
	my ($msg) = $options{DIE};
	if (defined ($log)) {
	    chomp ($msg);
	    $msg .= "; see output/$log.err and output/$log.out for details\n";
	}
	die $msg;
    } elsif ($result ne 'error' && defined ($log)) {
	unlink ("output/$log.err");
    }

    return $result;
}