Commit 0600d172 authored by Leigh B. Stoller's avatar Leigh B. 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'; ...@@ -20,6 +20,7 @@ use lib '@prefix@/lib';
use libdb; use libdb;
use libtestbed; use libtestbed;
use libtblog; use libtblog;
use libArchive;
use Experiment; use Experiment;
use English; use English;
use HTML::Entities; use HTML::Entities;
...@@ -28,6 +29,7 @@ use overload ('""' => 'Stringify'); ...@@ -28,6 +29,7 @@ use overload ('""' => 'Stringify');
# Configure variables # Configure variables
my $TB = "@prefix@"; my $TB = "@prefix@";
my $CONTROL = "@USERNODE@"; my $CONTROL = "@USERNODE@";
my $STAMPS = @STAMPS@;
my $MD5 = "/sbin/md5"; my $MD5 = "/sbin/md5";
my $MKDIR = "/bin/mkdir"; my $MKDIR = "/bin/mkdir";
my $RMDIR = "/bin/rmdir"; my $RMDIR = "/bin/rmdir";
...@@ -1640,6 +1642,47 @@ sub CreateDirectory($) ...@@ -1640,6 +1642,47 @@ sub CreateDirectory($)
return 0; 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; package Template::Instance;
...@@ -3225,6 +3268,48 @@ sub InitializeEnvVariables($;$) ...@@ -3225,6 +3268,48 @@ sub InitializeEnvVariables($;$)
return 0; 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; package Template::Instance::Run;
......
...@@ -49,6 +49,7 @@ my $REALPATH = "/bin/realpath"; ...@@ -49,6 +49,7 @@ my $REALPATH = "/bin/realpath";
my $SVN = "/usr/local/bin/svn"; my $SVN = "/usr/local/bin/svn";
my $SVNADMIN = "/usr/local/bin/svnadmin"; my $SVNADMIN = "/usr/local/bin/svnadmin";
my $IMPORTER = "$TB/sbin/svn_load_dirs.pl"; my $IMPORTER = "$TB/sbin/svn_load_dirs.pl";
my $DU = "/usr/bin/du";
my $inittag = 'root'; my $inittag = 'root';
my $defaultview = 'head'; my $defaultview = 'head';
my $debug = 0; my $debug = 0;
...@@ -2358,5 +2359,59 @@ sub TBListExperimentArchive($$$;$$) ...@@ -2358,5 +2359,59 @@ sub TBListExperimentArchive($$$;$$)
return 0; 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... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
...@@ -26,7 +26,7 @@ use Errno qw(EDQUOT); ...@@ -26,7 +26,7 @@ use Errno qw(EDQUOT);
sub usage() sub usage()
{ {
print(STDERR 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". " [-m guid/vers] [-g gid] <pid> <tid> <input file>\n".
"switches and arguments:\n". "switches and arguments:\n".
"-w - wait for template to be created.\n". "-w - wait for template to be created.\n".
...@@ -63,6 +63,7 @@ my $TBLOGS = "@TBLOGSEMAIL@"; ...@@ -63,6 +63,7 @@ my $TBLOGS = "@TBLOGSEMAIL@";
my $TBDOCBASE = "@TBDOCBASE@"; my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@"; my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@"; my $CONTROL = "@USERNODE@";
my $STAMPS = @STAMPS@;
# Locals # Locals
my $template; my $template;
...@@ -204,6 +205,10 @@ if (! ($template = Template->Create(\%args))) { ...@@ -204,6 +205,10 @@ if (! ($template = Template->Create(\%args))) {
tbdie("Could not create a new template record!"); 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. # At this point, we need to force a cleanup no matter how we exit.
# See the END block below. # See the END block below.
...@@ -218,7 +223,8 @@ $eid = $template->eid(); ...@@ -218,7 +223,8 @@ $eid = $template->eid();
# #
# Use the logonly option to audit so that we get a record mailed. # 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 # Parent exits normally, unless in waitmode. We have to set
# justexit to make sure the END block below does not run. # justexit to make sure the END block below does not run.
...@@ -320,6 +326,10 @@ fatal($? >> 8, "Oops") ...@@ -320,6 +326,10 @@ fatal($? >> 8, "Oops")
# Need to kill the experiment if we fail after this point. # Need to kill the experiment if we fail after this point.
$exptcreated = 1; $exptcreated = 1;
if ($STAMPS) {
$template->Stamp("template_create", "batchexp");
}
# Input files are kept in the DB, with the template. # Input files are kept in the DB, with the template.
fatal(-1, "Could not add NS file to template store") fatal(-1, "Could not add NS file to template store")
if ($template->AddInputFile($inputfile) < 0); if ($template->AddInputFile($inputfile) < 0);
...@@ -421,7 +431,9 @@ if ($modify) { ...@@ -421,7 +431,9 @@ if ($modify) {
$parent_template->Update(\%args) == 0 $parent_template->Update(\%args) == 0
or fatal(-1, "Could not update parent template record!"); or fatal(-1, "Could not update parent template record!");
} }
if ($STAMPS) {
$template->Stamp("template_create", "created");
}
exit(0); exit(0);
# #
......
...@@ -78,6 +78,7 @@ my $TBDOCBASE = "@TBDOCBASE@"; ...@@ -78,6 +78,7 @@ my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@"; my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@"; my $CONTROL = "@USERNODE@";
my $PARAMS = "parameters.xml"; my $PARAMS = "parameters.xml";
my $STAMPS = @STAMPS@;
# Locals # Locals
my $user_name; my $user_name;
...@@ -269,6 +270,10 @@ elsif ($action eq "start" && !defined($runid)) { ...@@ -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 # 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 # them in the DB for this experiment. Note that these override existing
...@@ -426,11 +431,18 @@ if (defined($instance->runidx())) { ...@@ -426,11 +431,18 @@ if (defined($instance->runidx())) {
tbdie("Cannot get current run object for $instance!"); 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"; print "Asking program agents to stop ... this will take a moment.\n";
SignalProgAgents("HALT") == 0 SignalProgAgents("HALT") == 0
or $ignoreerrors or $ignoreerrors
or CheckForDeadNodes($thisrun); or CheckForDeadNodes($thisrun);
if ($STAMPS) {
$instance->Stamp("template_exprun", "agents stopped");
}
# This sets the stop time. # This sets the stop time.
$instance->StopCurrentRun() == 0 $instance->StopCurrentRun() == 0
or fatal(-1, "Could not stop experiment run for $instance!"); or fatal(-1, "Could not stop experiment run for $instance!");
...@@ -447,17 +459,31 @@ if (defined($instance->runidx())) { ...@@ -447,17 +459,31 @@ if (defined($instance->runidx())) {
goto done; goto done;
} }
if ($STAMPS) {
$instance->Stamp("template_exprun", "loghole starting");
}
# This runs loghole. # This runs loghole.
print "Asking loghole to sync the logfiles ... this will take a minute.\n"; print "Asking loghole to sync the logfiles ... this will take a minute.\n";
$instance->LogHole() == 0 $instance->LogHole() == 0
or $ignoreerrors or $ignoreerrors
or CheckForDeadNodes($thisrun); 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"; print "Dumping the instance database ... this will take a minute.\n";
$instance->DumpDB() == 0 $instance->DumpDB() == 0
or $ignoreerrors or $ignoreerrors
or fatal(-1, "Dump Database failed"); or fatal(-1, "Dump Database failed");
if ($STAMPS) {
$instance->Stamp("template_exprun", "dumpdb done");
}
# #
# Commit the archive. # Commit the archive.
# #
...@@ -478,7 +504,11 @@ if (defined($instance->runidx())) { ...@@ -478,7 +504,11 @@ if (defined($instance->runidx())) {
system("$archcontrol -d -u -s runs/$this_runid tag $pid $eid stoprun") system("$archcontrol -d -u -s runs/$this_runid tag $pid $eid stoprun")
== 0 or fatal(-1, "Could not tag archive!"); == 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") { if ($action eq "stop") {
...@@ -500,6 +530,10 @@ if ($clean) { ...@@ -500,6 +530,10 @@ if ($clean) {
print "Cleaning the instance database ... this will take a moment.\n"; print "Cleaning the instance database ... this will take a moment.\n";
$instance->CleanDB() == 0 $instance->CleanDB() == 0
or fatal(-1, "Dump Database failed"); or fatal(-1, "Dump Database failed");
if ($STAMPS) {
$instance->Stamp("template_exprun", "cleaned");
}
} }
# #
...@@ -591,6 +625,9 @@ system("$eventcontrol replay $pid $eid") == 0 ...@@ -591,6 +625,9 @@ system("$eventcontrol replay $pid $eid") == 0
$experiment->CopyLogFiles() $experiment->CopyLogFiles()
if (defined($logname)); if (defined($logname));
if ($STAMPS) {
$instance->Stamp("template_exprun", "starting commit");
}
system("$archcontrol -d -t startrun_${runid} commit $pid $eid"); system("$archcontrol -d -t startrun_${runid} commit $pid $eid");
# #
...@@ -601,6 +638,9 @@ 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"); 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"; print "Experiment run '$runid' has been started.\n";
done: done:
......
...@@ -74,11 +74,9 @@ my $TBBASE = "@TBBASE@"; ...@@ -74,11 +74,9 @@ my $TBBASE = "@TBBASE@";
my $CONTROL = "@USERNODE@"; my $CONTROL = "@USERNODE@";
my $BOSSNODE = "@BOSSNODE@"; my $BOSSNODE = "@BOSSNODE@";
my $OPSDBSUPPORT= @OPSDBSUPPORT@; my $OPSDBSUPPORT= @OPSDBSUPPORT@;
my $STAMPS = @STAMPS@;
# Locals # Locals
my $user_name;
my $user_email;
my $dbuid;
my $EVhandle; my $EVhandle;
my $exptidx; my $exptidx;
my $template; my $template;
...@@ -195,6 +193,10 @@ if (! TBProjAccessCheck($user_uid, ...@@ -195,6 +193,10 @@ if (! TBProjAccessCheck($user_uid,
exit(1); exit(1);
} }
if ($STAMPS) {
$template->Stamp("template_instantiate", "start");
}
# #
# Grab instance and/or run if this is a replay. # Grab instance and/or run if this is a replay.
# #
...@@ -286,6 +288,10 @@ if (!defined($instance)) { ...@@ -286,6 +288,10 @@ if (!defined($instance)) {
# #
$justexit = 0; $justexit = 0;
if ($STAMPS) {
$instance->Stamp("template_instantiate", "created");
}
# #
# Now insert the binding records for the instance so that the parser # Now insert the binding records for the instance so that the parser
# can get them. # can get them.
...@@ -423,6 +429,10 @@ if (! ($foreground || $batchmode)) { ...@@ -423,6 +429,10 @@ if (! ($foreground || $batchmode)) {
AddAuditInfo("success_frag", "New T. Instance Created"); 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 # 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. # escapes, hence the list argument to system instead of a long string.
...@@ -463,6 +473,10 @@ fatal($? >> 8, "Could not pre-instantiate the experiment") ...@@ -463,6 +473,10 @@ fatal($? >> 8, "Could not pre-instantiate the experiment")
# Need to kill the experiment if we fail after this point. # Need to kill the experiment if we fail after this point.
$exptcreated = 1; $exptcreated = 1;
if ($STAMPS) {
$instance->Stamp("template_instantiate", "batchexp done");
}
# #
# Now we can do this ... # Now we can do this ...
# #
...@@ -564,6 +578,10 @@ $instance->WriteProgramAgents() == 0 ...@@ -564,6 +578,10 @@ $instance->WriteProgramAgents() == 0
or fatal(-1, "Could not write program agent info"); or fatal(-1, "Could not write program agent info");
if (! $preload) { if (! $preload) {
if ($STAMPS) {
$instance->Stamp("template_instantiate", "swapin starting");
}
# #
# Now do the swapin (or it gets queued if a batch experiment). # Now do the swapin (or it gets queued if a batch experiment).
# #
...@@ -573,6 +591,10 @@ if (! $preload) { ...@@ -573,6 +591,10 @@ if (! $preload) {
} }
} }
else { else {
if ($STAMPS) {
$instance->Stamp("template_instantiate", "preload commit");
}
# #
# Lets commit the experiment archive now. The experiment might already # Lets commit the experiment archive now. The experiment might already
# be running, but thats not a big deal. # be running, but thats not a big deal.
...@@ -583,6 +605,10 @@ else { ...@@ -583,6 +605,10 @@ else {
} }
} }
if ($STAMPS) {
$instance->Stamp("template_instantiate", "done");
}
# Stop the web interface from spewing. # Stop the web interface from spewing.
TBExptCloseLogFile($pid, $eid) TBExptCloseLogFile($pid, $eid)
if (defined($logname) && !$batchmode); if (defined($logname) && !$batchmode);
......
#!/usr/bin/perl -wT #!/usr/bin/perl -wT
# #
# EMULAB-COPYRIGHT # 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. # All rights reserved.
# #
use English; use English;
...@@ -53,6 +53,7 @@ my $TBOPS = "@TBOPSEMAIL@"; ...@@ -53,6 +53,7 @@ my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@"; my $TBLOGS = "@TBLOGSEMAIL@";
my $TBDOCBASE = "@TBDOCBASE@"; my $TBDOCBASE = "@TBDOCBASE@";
my $TBBASE = "@TBBASE@"; my $TBBASE = "@TBBASE@";
my $STAMPS = @STAMPS@;
# Locals # Locals
my $user_name; my $user_name;
...@@ -188,6 +189,10 @@ if (! $batchmode) { ...@@ -188,6 +189,10 @@ if (! $batchmode) {
# #
$justexit = 0; $justexit = 0;
if ($STAMPS) {
$instance->Stamp("template_swapout", "starting");
}
# #
# Catch this so we can clean up. # Catch this so we can clean up.
# #
...@@ -267,14 +272,26 @@ if ($waitmode) { ...@@ -267,14 +272,26 @@ if ($waitmode) {
if (defined($instance->start_time())) { if (defined($instance->start_time())) {
my $opt = ($force ? "-i" : ""); my $opt = ($force ? "-i" : "");
if ($STAMPS) {
$instance->Stamp("template_swapout", "stoprun starting");
}
system("$endrun $opt -a stop -f -e $eid $guid/$version") == 0 system("$endrun $opt -a stop -f -e $eid $guid/$version") == 0
or fatal(-1, "Could not stop the current run!"); or fatal(-1, "Could not stop the current run!");
if ($STAMPS) {
$instance->Stamp("template_swapout", "stoprun done");
}
# This sets the stop time. # This sets the stop time.
$instance->Stop() == 0 $instance->Stop() == 0
or fatal(-1, "Could not stop experiment instance!"); or fatal(-1, "Could not stop experiment instance!");
} }
if ($STAMPS) {
$instance->Stamp("template_swapout", "endexp starting");
}