#!/bin/sh
exec perl -x -S $0 ${1+"$@"} # -*-perl-*-
#!perl -w

# if ($] !~ /^5\..*/) {
#   # uh-oh. this isn't perl 5.
#   foreach (split(/:/, $ENV{PATH})) { # try to find "perl5".
#     exec("$_/perl5", "-x", "-S", $0, @ARGV) if (-x "$_/perl5");
#   }
#   # we failed. bail.
#   die "Your perl is too old; I need perl 5. See the README for what to do.\n";
# }
# 
# # load the real script. this is isolated in an 'eval' so perl4 won't
# # choke on the perl5-isms.
# eval join("\n", <DATA>);
# if ($@) { die "$@"; }
# __END__

#
# regression
#
# Author: Nat Lanza
#
#
# Copyright (c) of Carnegie Mellon University, 1997,1998,1999.
#
# Permission to reproduce, use, and prepare derivative works of
# this software for internal use is granted provided the copyright
# and "No Warranty" statements are included with all reproductions
# and derivative works. This software may also be redistributed
# without charge provided that the copyright and "No Warranty"
# statements are included in all redistributions.
#
# NO WARRANTY. THIS SOFTWARE IS FURNISHED ON AN "AS IS" BASIS.
# CARNEGIE MELLON UNIVERSITY MAKES NO WARRANTIES OF ANY KIND, EITHER
# EXPRESSED OR IMPLIED AS TO THE MATTER INCLUDING, BUT NOT LIMITED
# TO: WARRANTY OF FITNESS FOR PURPOSE OR MERCHANTABILITY, EXCLUSIVITY
# OF RESULTS OR RESULTS OBTAINED FROM USE OF THIS SOFTWARE. CARNEGIE
# MELLON UNIVERSITY DOES NOT MAKE ANY WARRANTY OF ANY KIND WITH RESPECT
# TO FREEDOM FROM PATENT, TRADEMARK, OR COPYRIGHT INFRINGEMENT.
#

$| = 1;

use strict;
use vars qw($fail $drive $password $path $seclevel $opt_s $opt_v $opt_R $opt_i $opt_p $opt_T $opt_k $opt_S $partition_size $build_name);
use Getopt::Std;

main();

sub main {
  $opt_v = 0;		# verbose
  $opt_S = 20000;	# partition size

  getopt('RipsSk');
  $fail = 0;
  $password = "password";
  $drive = shift(@ARGV) or do_usage();
  my $iters;
  my $partition_sec;
  my $systype;
  my $nasd_options_return;
  my @args;
  my $i;

  $systype = `uname -s`;
  chomp $systype;

  if ($opt_R) { $path = $opt_R; }
  else { $path = `pwd`; chomp($path); }
  print "Path = $path\n";
  $partition_size = $opt_S;

  #
  # See if we have kpdev support
  #
  @args = "$path/nasd_options";
  $nasd_options_return = `@args 2>&1`;
  if (!($nasd_options_return =~ /kpdev/)) {
      $opt_k = "1";
      print "running without kpdev support loaded; ";
  }
  if ($nasd_options_return =~ /does not have NASD support loaded/) {
    @args = "$path/nasd_options -s";
    $seclevel = `@args 2>&1`;
    chomp $seclevel;
  } else {
    $nasd_options_return =~ /Security level ([0-9]+)/;
    $seclevel = $1;
  }

  if ($opt_k) { printf "kpdev tests disabled\n"; }

  if(defined $opt_s && $opt_s != $seclevel) {
    print "warning: overriding detected security level $seclevel to $opt_s\n";
    $seclevel = $opt_s;
  }

  if ($opt_i) {
	  $iters = $opt_i;
  }
  else {
	  if ($seclevel > 0) {
		  $iters = 5;
	  }
	  else {
		  $iters = 10;
	  }
  }

  if ($opt_p) {
    if ($opt_p > 0) {
      if ($seclevel > 0) {
	$partition_sec = $opt_p;
      } else {
	printf "You must have security enabled to specify a partition\n";
	printf "security setting greater than zero.\n";
	exit(1);
      }
    } else {
      $partition_sec = 0;
    }
  } else {
    $partition_sec = 0;
  }

  printf("Starting test sequence with security %s\n",
	 $seclevel > 0 ?
	 sprintf("enabled, max. security level %d", $seclevel) :
	 "disabled");
  printf("Using drive \"%s\"\n", $drive);

  if ($opt_v) { print "Operating in verbose mode.\n\n"; }
  else { print "\n"; }

  do_simple_test("data marshalling", "marshall_tester");
  $fail = 0;

  test_noops($iters);
  if ($fail) { do_fail(); }
  
  my @pbuild_args = ("$path/pbuild", $drive, $password);
  my $pbuild_return = `@pbuild_args 2>&1`;

  if ($?) {
    print "Could not get drive build name:  Error is $pbuild_return\n";
    $build_name = "UNKNOWN"
  } else {
    $build_name = $pbuild_return;
  }
  
  print ("Communication established.  Continuing to run tests\n$build_name\n");

  test_initialization();
  if ($fail) { do_fail(); }

  test_partition_creation($partition_sec);
  if ($fail) { do_fail(); }

  test_object_manipulation($iters);
  if ($fail) { do_fail(); }

  for($i = 0; $i <= $seclevel; $i++) {
    do_regress($i, $iters);
  }
  
  if (!$fail) {
    print "\nAll tests completed successfully.\n";
    exit 0;
  } else {
    print "\nOne or more tests failed.\n";
    exit 1;
  }
}

sub do_simple_test_quiet {
  my $message = shift @_;
  my $test = shift @_;
  my @args = @_;
  my $errors;
  my $result = "";

  unshift(@args, "$path/$test");
  $errors = `@args 2>&1`;
  
  if ($?) {
    $result .= "$message failed:\n\n";
    $result .= "command line: @args\n";
    $result .= "$errors\n\n";
    $fail++;
  } else {
    $result .= ". ";
  }

  return $result;
}

sub do_simple_test {
  my $message = shift @_;
  my $test = shift @_;
  my @args = @_;
  my $errors;

  unshift(@args, "$path/$test");

  if ($opt_v) {
    print "Testing $message:\n";
  } else {
    print "Testing $message..........";
  }

  $errors = `@args 2>&1`;
  
  if ($?) {
    if ($opt_v) {
      print "Test failed: @args\n$errors\n\n";
    } else {
      print " failed:\n\n";
      print "command line: @args\n";
      print "$errors\n\n";
    }
    $fail++;

  } else {

    if ($opt_v) {
      print "Results:\n$errors";
      print "Test passed.\n";
    } else {
      print " passed\n";
    }
  }

  return "foo";
}

sub do_warning {
  print "A critical section of the test sequence has failed.\n";
  print "This is probably because the drive you're running it on\n";
  print "already has partitions. Please try the test sequence on\n";
  print "a freshly-formatted drive.\n";
  exit(1);
}

sub do_usage {
  print "usage: regression [options] drive\n";
  print "   options include\n";
  print "     -s      [ specify maximum security level to test at ]\n";
  print "     -k      [ skip kpdev tests ]\n";
  print "     -i      [ Specify the number of iterations for tests. ]\n";
  print "     -p      [ Security level for created partitions. Needs -s option. ]\n";
  print "     -R      [ specify the path to the testing utilities.\n";
  print "               If not specified, the path is assumed to be \".\". ]\n";
  print "     -T      [ skip throttled read tests ]\n";
  exit(1);
}

sub do_fail {
  print "\nA critical test failed, aborting.\n";
  exit(1);
}

sub test_noops {
  my $niters = $_[0];
  my $result;
  my @pcnulls_args = ("$path/pcnulls", $drive, 100);
  my $num = 0;

  if ($opt_v) { print "Testing basic connectivity:\n"; }
  else { print "Testing basic connectivity"; }

  for (my $i = 0; $i < $niters; $i++) {
    my $j = $i + 1;
    $result = `@pcnulls_args 2>&1`;
    
    if ($?) {
      print "failed:\n\n$result\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "Iteration $j succeeded:\n$result\n";
    } else {
      print ".";
    }

    $result =~ /^([0-9.]+) ops/m;
    $num += $1;

  }

  $result = `$path/psync $drive`;

  if ($?) {
    print "failed:sync failed\n\n$result\n\n";
    $fail++;
    return;
  } 

  if ($opt_v) {
    print "Test passed.\n\n";
  } else {
    print " passed\n";

    $num /= $niters;

    print "  Drive performed $num operations per second.\n";
  }
}

sub test_initialization {
  my $result;
  my $save_result;
  my @pinit_args = ("$path/pinit", $drive, $password);

  if ($opt_v) {
    print "Testing drive initialization:\n";
  } else {
    print "Testing drive initialization..........";
  }

  $save_result = `@pinit_args 2>&1`;

  if ($? == 46) {
    print "failed\n";
    print "\tYou cannot initialize a drive that's already been initialized.\n";
    print "\tThis test series is intended to be run on a freshly-formatted disk.\n";
    print "\tPlease try again with a freshly-formatted disk.\n";
    $fail++;
    exit(1);
  } elsif ($?) {
    print "failed:\n$save_result\n\n";
    $fail++;
    exit(1);
  } 

  $result = `$path/psync $drive`;

  if ($?) {
    print "failed: init failed\n\n$result\n\n";
    $fail++;
    return;
  } 

  if ($opt_v) {
    print "Result:\n$save_result\nTest succeeded.\n\n";
  } else {
    print " passed\n";
  }

}

sub test_partition_creation {
  my $result;
  my $security = $_[0];
  my $pcrpart_return;
  my @pcrpart_args;

  if($seclevel > 0) {
      @pcrpart_args = ("$path/pcrpart", "-s", $drive, 1, $partition_size, $security, $password);
  } else {
      @pcrpart_args = ("$path/pcrpart", $drive, 1, $partition_size, $security, $password);
  }

  if ($opt_v) {
    print "Testing partition creation:\n";
  } else {
    print "Testing partition creation..........";
  }

  $pcrpart_return = `@pcrpart_args 2>&1`;

  if ($?) {
    print "failed:\ncommand line: @pcrpart_args\n\n$pcrpart_return\n\n";

    $fail++;
    do_warning();
  }

  $result = `$path/psync $drive`;

  if ($?) {
    print "failed: sync failed\n\n$result\n\n";
    $fail++;
    return;
  } 

  if ($opt_v) {
    print "Result:\n$result\nTest succeeded.\n\n";
  } else {
    print " passed\n";
  }
}

sub test_object_manipulation {
  my $niters = $_[0];
  my @args;
  my $result;
  my $pcrobj_return;
  my $psg_return;
  my $pgetattr_return;
  my $premove_return;
  my $pcrdel_return;
  my $pcrpart_return;
  my $objid;
  my $partition = 1;
  my $partition1 = 2;

  if ($opt_v) {
    print "Testing object manipulation:\n\n";
  } else {
    print "Testing object manipulation";
  }

  if($seclevel > 0) {
      @args = "$path/pcrpart -s $drive $partition1 1000 0 $password";
  } else {
      @args = "$path/pcrpart $drive $partition1 1000 0 $password";
  }
  $pcrpart_return = `@args 2>&1`;

  if ($?) {
    if ($opt_v) { print "Failed:\n(@args)\n"; }
    else { print " failed: "; }
    print "(pcrpart test failed)\n\n$pcrpart_return\n\n";
    $fail++;
    return;
  } elsif ($opt_v) {
    print "pcrpart succeeded.\n";
  }     

  for (my $i = 1; $i <= $niters; $i++) {

    if ($opt_v) {
      print "Iteration $i beginning...\n";
    }

    @args = "$path/pcrobj -p $partition $drive $password";
    $pcrobj_return = `@args 2>&1`;
    
    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(Couldn't create object):\n\n$pcrobj_return\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "pcrobj succeeded:\n$pcrobj_return\n";
    }
    
    @args = "$path/psync $drive";
    $result = `@args 2>&1`;

    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(sync failed)\n\n$result\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "psync succeeded.\n";
    }

#    chomp($pcrobj_return);
    $pcrobj_return =~ /Succeeded, id=(0x[^ ]+)\n/;
    $objid = $1;
    chomp($objid);

    @args = "$path/psg $drive $partition $password $objid";
    $psg_return = `@args 2>&1`;

    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(Couldn't do scatter/gather)\n\n$psg_return\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "psg succeeded:\n$psg_return\n";
    }

    @args = "$path/psync $drive";
    $result = `@args 2>&1`;
    
    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(sync failed)\n\n$result\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "psync succeeded.\n";
    } 
    
    @args = "$path/pgetattr $drive $partition $objid $password";
    $pgetattr_return = `@args 2>&1`;
    
    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(Couldn't get object attributes)\n\n$pgetattr_return\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "pgetattr succeded:\n$pgetattr_return\n";
    }

    @args = "$path/psync $drive";
    $result = `@args 2>&1`;

    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(sync failed)\n\n$result\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "psync succeeded.\n";
    } 

    @args = "$path/pcreatedelete -R $drive $partition1 $password";
    $pcrdel_return = `@args 2>&1`;

    if ($?) {
	if ($opt_v) { print "Failed:\n(@args)\n"; }
	else { print " failed: "; }
	print "(pcreatedelete test failed)\n\n$result\n\n";
	$fail++;
	return;
    } elsif ($opt_v) {
	print "pcreatedelete succeeded.\n";
    } 
    
    @args = "$path/premove $drive $partition $objid $password";
    $premove_return = `@args 2>&1`;
    
    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(Couldn't remove object)\n\n$premove_return\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "premove succeded:\n$premove_return\n";
    }

    @args = "$path/psync $drive";
    $result = `@args 2>&1`;

    if ($?) {
      if ($opt_v) { print "Failed:\n(@args)\n"; }
      else { print " failed: "; }
      print "(sync failed)\n\n$result\n\n";
      $fail++;
      return;
    } elsif ($opt_v) {
      print "psync succeeded.\n";
    } 

    if ($opt_v) {
      print "Iteration $i succeeded.\n\n";
    } else {
      print ".";
    }
  }




  if ($opt_v) {
    print "Test succeeded.\n\n";
  } else {
    print " passed\n";
  }
}

sub remove_objects {
  my $partition = $_[0];
  my $plspart_return;
  my $result;
  my @objects;
  my $num;

  print '  removing objects';

  $plspart_return = `$path/plspart $drive $partition $password 2>&1`;

  if ($?) {
    print ".......... failed:\n\n$plspart_return\n\n";
    $fail++;
    return;
  }

  if ($plspart_return ne "") {
    @objects = split /\n/, $plspart_return;
    
    foreach (@objects) {
      $result = `$path/premove $drive $partition $_ $password`;
      
      if ($?) {
	print " failed:\n\n$result\n\n";
	$fail++;
	return;
      } else {
	print ".";
	$num++;
      }
    }
    
    print "\n    $num objects removed from partition $partition.\n";

  } else {
    print ".......... passed\n  No objects present on partition $partition\n";
  }

  return;
}

sub do_regress {
  my $security = $_[0];
  my $iters = $_[1];
  my $partition = 1;
  my $i = 0;
  my $j = 0;
  my $failures = $fail;
  my $failincr = $fail;
  my $lastfail = $fail;
  my @args;
  my $badtests = "";

  my $do_test;
  
  if ($opt_v) {
    $do_test = \&do_simple_test;
  } else {
    $do_test = \&do_simple_test_quiet;
  }

  if ($security == 0) {
    print "Doing basic regression tests without security";
  } else {
    print "Doing basic regression tests at security level $security";
  }

  if ($opt_v) {
    print ":\n";
  } else {
    print "...\n";
  }

 REGRESS: for ($i=1; $i <= $iters; $i++) {
    my $tempresult;
    my $errorstring = "";

    if ($opt_v) {
      print "\nBeginning Iteration $i...\n";
    } else {
      printf "  Iteration %02d ", $i;
    }


    @args = ("userlevel ubench",
	     "ubench", "-s", $security,
	     $drive, $partition, $password);
    $tempresult = &$do_test(@args);


    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }


  if (!$opt_k) {
    @args = ("kernel device ubench",
	     "ubench", "-k", "-s", $security,
	     $drive, $partition, $password);
    $tempresult = &$do_test(@args);
    
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }
  }
    

    @args = ("preadwrite w/daily key",
	     "preadwrite", "-q", "-d", "-s",
	     $security, "-c", $drive, $partition,
	     $password);
    $tempresult = &$do_test(@args);

    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      } 
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }


    @args = ("preadwrite w/capability",
	     "preadwrite", "-q", "-s", $security,
	     "-c", $drive, $partition, $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }

    @args = ("premote",
	     "premote","$drive",$partition,"0x0",$password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }
    
    @args = ("psg",
	     "psg", "-c", "-s", $security, $drive, 
	     $partition, $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }


    @args = ("pdrspeed (write) default parameters",
	     "pdrspeed", "-s", $security, "-w",
	     "-n", (15 * $i), "-c",
	     "-p", $partition, $drive, $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }

    @args = ("pdrspeed (read) default parameters",
	     "pdrspeed", "-s", $security,
	     "-n", (15 * $i), "-c",
	     "-p", $partition, $drive, $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }


  if (!$opt_k) {
    @args = ("pdrspeed (write) kernel device",
	     "pdrspeed", "-k", "-s", $security,
	     "-n", (15 * $i), "-c",
	     "-w", "-p", $partition, $drive,
	     $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }
  }
    

  if (!$opt_k) {
    @args = ("pdrspeed kernel device",
	     "pdrspeed", "-k", "-s", $security,
	     "-n", (15 * $i), "-c",
	     "-p", $partition, $drive, $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }
  }

  if (!$opt_T) {
    @args = ("pdrspeed throttled to 675 (read)",
	     "pdrspeed", "-s", $security,
	     "-n", (15 * $i), "-c",
	     "-p", $partition, "-t", 675, $drive,
	     $password);
    $tempresult = &$do_test(@args);
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }


  if (!$opt_k) {
    @args = ("pdrspeed throttled to 675 in kernel device (read)",
	     "pdrspeed", "-k", "-s", $security,
	     "-p", $partition, "-t", 675, $drive, $password);
    $tempresult = &$do_test(@args);
    
    if (!$opt_v) {
      if ($tempresult eq ". ") {
	print ". ";
      } else {
	print "x ";
	$errorstring .= $tempresult;
      }
    } else {
      if ($fail > $lastfail) {
	$badtests .= "\n" . shift(@args) . ": " . "@args";
      }
      $lastfail = $fail;
    }
  }

  }

    
    #    remove_objects(1);
    
    if ($fail > $failures) {
      print "failed\nOne or more tests in the regression failed, aborting...\n\n";
      print "$errorstring\n";
      print "Failed command lines:\n$badtests\n";
      last REGRESS;
    } else {
      print "completed successfully\n";
    }
  }
}
