Commit 0600d172 authored by Leigh Stoller's avatar Leigh Stoller

Add some instrumentation code (STAMPS), and a DU routine to DU the

the repo for the stamping. This code is all temporary or at the very
least will change.
parent 00d1cea8
......@@ -20,6 +20,7 @@ use lib '@prefix@/lib';
use libdb;
use libtestbed;
use libtblog;
use libArchive;
use Experiment;
use English;
use HTML::Entities;
......@@ -28,6 +29,7 @@ use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $CONTROL = "@USERNODE@";
my $STAMPS = @STAMPS@;
my $MD5 = "/sbin/md5";
my $MKDIR = "/bin/mkdir";
my $RMDIR = "/bin/rmdir";
......@@ -1640,6 +1642,47 @@ sub CreateDirectory($)
return 0;
}
#
# Record a stamp event.
#
sub Stamp($$;$$$)
{
my ($self, $type, $modifier, $aux_type, $aux_data) = @_;
return 0
if (! $STAMPS);
# Must be a real reference.
return -1
if (! ref($self));
my $guid = $self->guid();
my $vers = $self->vers();
$modifier = (defined($modifier) ? "'$modifier'" : "NULL");
if (!defined($aux_type)) {
#
# Grab a du.
#
my $du;
if (libArchive::TBDUExperimentArchive($self->pid(),
$self->eid(), \$du) == 0) {
$aux_type = "du";
$aux_data = $du;
}
}
DBQueryWarn("insert into template_stamps set ".
" guid='$guid', vers='$vers', id=NULL, instance=NULL, ".
" stamp_type='$type', modifier=$modifier, ".
" stamp=UNIX_TIMESTAMP(now()) ".
(defined($aux_type) ?
",aux_type='$aux_type',aux_data='$aux_data'" : ""))
or return -1;
return 0;
}
############################################################################
package Template::Instance;
......@@ -3225,6 +3268,48 @@ sub InitializeEnvVariables($;$)
return 0;
}
#
# Record a stamp event.
#
sub Stamp($$;$$$)
{
my ($self, $type, $modifier, $aux_type, $aux_data) = @_;
return 0
if (! $STAMPS);
# Must be a real reference.
return -1
if (! ref($self));
my $guid = $self->guid();
my $vers = $self->vers();
my $exptidx = $self->exptidx();
$modifier = (defined($modifier) ? "'$modifier'" : "NULL");
if (!defined($aux_type)) {
#
# Grab a du.
#
my $du;
if (libArchive::TBDUExperimentArchive($self->pid(),
$self->eid(), \$du) == 0) {
$aux_type = "du";
$aux_data = $du;
}
}
DBQueryWarn("insert into template_stamps set ".
" guid='$guid', vers='$vers', id=NULL, instance='$exptidx', ".
" stamp_type='$type', modifier=$modifier, ".
" stamp=UNIX_TIMESTAMP(now()) ".
(defined($aux_type) ?
",aux_type='$aux_type',aux_data='$aux_data'" : ""))
or return -1;
return 0;
}
############################################################################
package Template::Instance::Run;
......
......@@ -49,6 +49,7 @@ my $REALPATH = "/bin/realpath";
my $SVN = "/usr/local/bin/svn";
my $SVNADMIN = "/usr/local/bin/svnadmin";
my $IMPORTER = "$TB/sbin/svn_load_dirs.pl";
my $DU = "/usr/bin/du";
my $inittag = 'root';
my $defaultview = 'head';
my $debug = 0;
......@@ -2358,5 +2359,59 @@ sub TBListExperimentArchive($$$;$$)
return 0;
}
#
# DU an archive.
#
sub TBDUExperimentArchive($$$)
{
my ($pid, $eid, $prval) = @_;
my ($archive_idx, $view);
$$prval = 0;
return 0
if (!doarchiving($pid));
my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
return 0
if ($rval > 0);
return -1
if ($rval < 0);
my $directory;
if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
print STDERR "DUExperimentArchive: ".
"Archive '$archive_idx' does not exist in the DB!\n";
return -1;
}
if (! -d $directory) {
print STDERR "DUExperimentArchive: $directory does not exist!\n";
return -1;
}
my $repo = "$directory/repo";
#
# Start a subprocess that does the du, and then read it back.
#
if (!open(DU, "$DU -s -k $repo |")) {
print STDERR "DUExperimentArchive: Could not start du!\n";
return -1;
}
my $line;
while (<DU>) {
chomp($_);
$line = $_;
}
return -1
if (! close(DU));
if ($line =~ /^(\d+)\s+/) {
$$prval = $1;
return 0;
}
return -1;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -26,7 +26,7 @@ use Errno qw(EDQUOT);
sub usage()
{
print(STDERR
"Usage: create_expt_template [-q] [-w] [-E description]\n".
"Usage: template_create [-q] [-w] [-E description]\n".
" [-m guid/vers] [-g gid] <pid> <tid> <input file>\n".
"switches and arguments:\n".
"-w - wait for template to be created.\n".
......@@ -63,6 +63,7 @@ my $TBLOGS = "@TBLOGSEMAIL@";
my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@";
my $STAMPS = @STAMPS@;
# Locals
my $template;
......@@ -204,6 +205,10 @@ if (! ($template = Template->Create(\%args))) {
tbdie("Could not create a new template record!");
}
if ($STAMPS && $modify) {
$parent_template->Stamp("template_create", "modified");
}
#
# At this point, we need to force a cleanup no matter how we exit.
# See the END block below.
......@@ -218,7 +223,8 @@ $eid = $template->eid();
#
# Use the logonly option to audit so that we get a record mailed.
#
if (my $childpid = AuditStart(LIBAUDIT_DAEMON, undef, LIBAUDIT_LOGONLY|LIBAUDIT_FANCY)) {
if (my $childpid =
AuditStart(LIBAUDIT_DAEMON, undef, LIBAUDIT_LOGONLY|LIBAUDIT_FANCY)) {
#
# Parent exits normally, unless in waitmode. We have to set
# justexit to make sure the END block below does not run.
......@@ -320,6 +326,10 @@ fatal($? >> 8, "Oops")
# Need to kill the experiment if we fail after this point.
$exptcreated = 1;
if ($STAMPS) {
$template->Stamp("template_create", "batchexp");
}
# Input files are kept in the DB, with the template.
fatal(-1, "Could not add NS file to template store")
if ($template->AddInputFile($inputfile) < 0);
......@@ -421,7 +431,9 @@ if ($modify) {
$parent_template->Update(\%args) == 0
or fatal(-1, "Could not update parent template record!");
}
if ($STAMPS) {
$template->Stamp("template_create", "created");
}
exit(0);
#
......
......@@ -78,6 +78,7 @@ my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@";
my $PARAMS = "parameters.xml";
my $STAMPS = @STAMPS@;
# Locals
my $user_name;
......@@ -269,6 +270,10 @@ elsif ($action eq "start" && !defined($runid)) {
}
}
if ($STAMPS) {
$instance->Stamp("template_exprun", "starting", "action", $action);
}
#
# If we have a parameter file, we need to copyin the values and store
# them in the DB for this experiment. Note that these override existing
......@@ -426,11 +431,18 @@ if (defined($instance->runidx())) {
tbdie("Cannot get current run object for $instance!");
}
if ($STAMPS) {
$instance->Stamp("template_exprun", "stopping agents");
}
print "Asking program agents to stop ... this will take a moment.\n";
SignalProgAgents("HALT") == 0
or $ignoreerrors
or CheckForDeadNodes($thisrun);
if ($STAMPS) {
$instance->Stamp("template_exprun", "agents stopped");
}
# This sets the stop time.
$instance->StopCurrentRun() == 0
or fatal(-1, "Could not stop experiment run for $instance!");
......@@ -447,17 +459,31 @@ if (defined($instance->runidx())) {
goto done;
}
if ($STAMPS) {
$instance->Stamp("template_exprun", "loghole starting");
}
# This runs loghole.
print "Asking loghole to sync the logfiles ... this will take a minute.\n";
$instance->LogHole() == 0
or $ignoreerrors
or CheckForDeadNodes($thisrun);
if ($STAMPS) {
my $du = 0;
$experiment->DU(\$du);
$instance->Stamp("template_exprun", "loghole done", "userdu", $du);
$instance->Stamp("template_exprun", "dumpdb starting");
}
print "Dumping the instance database ... this will take a minute.\n";
$instance->DumpDB() == 0
or $ignoreerrors
or fatal(-1, "Dump Database failed");
if ($STAMPS) {
$instance->Stamp("template_exprun", "dumpdb done");
}
#
# Commit the archive.
#
......@@ -478,7 +504,11 @@ if (defined($instance->runidx())) {
system("$archcontrol -d -u -s runs/$this_runid tag $pid $eid stoprun")
== 0 or fatal(-1, "Could not tag archive!");
print "Experiment run '$this_runid' has been stopped.\n";
print "Experiment run '$this_runid' has been stopped.\n";
if ($STAMPS) {
$instance->Stamp("template_exprun", "run stopped");
}
}
if ($action eq "stop") {
......@@ -500,6 +530,10 @@ if ($clean) {
print "Cleaning the instance database ... this will take a moment.\n";
$instance->CleanDB() == 0
or fatal(-1, "Dump Database failed");
if ($STAMPS) {
$instance->Stamp("template_exprun", "cleaned");
}
}
#
......@@ -591,6 +625,9 @@ system("$eventcontrol replay $pid $eid") == 0
$experiment->CopyLogFiles()
if (defined($logname));
if ($STAMPS) {
$instance->Stamp("template_exprun", "starting commit");
}
system("$archcontrol -d -t startrun_${runid} commit $pid $eid");
#
......@@ -601,6 +638,9 @@ system("$archcontrol -d -t startrun_${runid} commit $pid $eid");
#
system("$archcontrol -d -u -s runs/$runid tag $pid $eid startrun");
if ($STAMPS) {
$instance->Stamp("template_exprun", "run started");
}
print "Experiment run '$runid' has been started.\n";
done:
......
......@@ -74,11 +74,9 @@ my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@";
my $BOSSNODE = "@BOSSNODE@";
my $OPSDBSUPPORT= @OPSDBSUPPORT@;
my $STAMPS = @STAMPS@;
# Locals
my $user_name;
my $user_email;
my $dbuid;
my $EVhandle;
my $exptidx;
my $template;
......@@ -195,6 +193,10 @@ if (! TBProjAccessCheck($user_uid,
exit(1);
}
if ($STAMPS) {
$template->Stamp("template_instantiate", "start");
}
#
# Grab instance and/or run if this is a replay.
#
......@@ -286,6 +288,10 @@ if (!defined($instance)) {
#
$justexit = 0;
if ($STAMPS) {
$instance->Stamp("template_instantiate", "created");
}
#
# Now insert the binding records for the instance so that the parser
# can get them.
......@@ -423,6 +429,10 @@ if (! ($foreground || $batchmode)) {
AddAuditInfo("success_frag", "New T. Instance Created");
}
if ($STAMPS) {
$instance->Stamp("template_instantiate", "batchexp start");
}
#
# Build up arguments to batchexp. I do not want to bother with shell
# escapes, hence the list argument to system instead of a long string.
......@@ -463,6 +473,10 @@ fatal($? >> 8, "Could not pre-instantiate the experiment")
# Need to kill the experiment if we fail after this point.
$exptcreated = 1;
if ($STAMPS) {
$instance->Stamp("template_instantiate", "batchexp done");
}
#
# Now we can do this ...
#
......@@ -564,6 +578,10 @@ $instance->WriteProgramAgents() == 0
or fatal(-1, "Could not write program agent info");
if (! $preload) {
if ($STAMPS) {
$instance->Stamp("template_instantiate", "swapin starting");
}
#
# Now do the swapin (or it gets queued if a batch experiment).
#
......@@ -573,6 +591,10 @@ if (! $preload) {
}
}
else {
if ($STAMPS) {
$instance->Stamp("template_instantiate", "preload commit");
}
#
# Lets commit the experiment archive now. The experiment might already
# be running, but thats not a big deal.
......@@ -583,6 +605,10 @@ else {
}
}
if ($STAMPS) {
$instance->Stamp("template_instantiate", "done");
}
# Stop the web interface from spewing.
TBExptCloseLogFile($pid, $eid)
if (defined($logname) && !$batchmode);
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
......@@ -53,6 +53,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@";
my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@";
my $STAMPS = @STAMPS@;
# Locals
my $user_name;
......@@ -188,6 +189,10 @@ if (! $batchmode) {
#
$justexit = 0;
if ($STAMPS) {
$instance->Stamp("template_swapout", "starting");
}
#
# Catch this so we can clean up.
#
......@@ -267,14 +272,26 @@ if ($waitmode) {
if (defined($instance->start_time())) {
my $opt = ($force ? "-i" : "");
if ($STAMPS) {
$instance->Stamp("template_swapout", "stoprun starting");
}
system("$endrun $opt -a stop -f -e $eid $guid/$version") == 0
or fatal(-1, "Could not stop the current run!");
if ($STAMPS) {
$instance->Stamp("template_swapout", "stoprun done");
}
# This sets the stop time.
$instance->Stop() == 0
or fatal(-1, "Could not stop experiment instance!");
}
if ($STAMPS) {
$instance->Stamp("template_swapout", "endexp starting");
}
#
# Now do the swapout (or just the termination).
#
......@@ -290,6 +307,10 @@ system(@arguments);
fatal($? >> 8, "Could not terminate template instance")
if ($?);
if ($STAMPS) {
$instance->Stamp("template_swapout", "endexp done");
}
if (defined($instance->start_time())) {
# Reminder; instance records are not deleted.
$instance->Finalize() == 0
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment