Commit 7632e70f authored by Leigh Stoller's avatar Leigh Stoller

A bunch more logfile changes altering all the code to operate on Logfiles

instead of paths. There is a script called from database-migrate that
converts paths to logfile (db) objects.
parent 07367359
......@@ -21,6 +21,7 @@ use User;
use Project;
use Group;
use Node;
use Logfile;
use English;
use Data::Dumper;
use File::Basename;
......@@ -225,6 +226,7 @@ sub ipassign_args($) { return field($_[0], 'ipassign_args');}
sub security_level($) { return field($_[0], 'security_level');}
sub linktest_pid($) { return field($_[0], 'linktest_pid');}
sub linktest_level($) { return field($_[0], 'linktest_level');}
sub logfile($) { return field($_[0], 'logfile');}
sub archive_idx($) { return stats($_[0], 'archive_idx'); }
sub swapin_count($) { return stats($_[0], 'swapin_count'); }
sub destroyed($) { return stats($_[0], 'destroyed'); }
......@@ -580,6 +582,7 @@ sub Delete($;$)
if (defined($userdir) && system("/bin/rm -rf $userdir")) {
print "*** WARNING: Not able to remove $userdir\n";
print " Someone will need to do this by hand.\n";
# NFS errors usually the result. Sometimes its cause there is
# someone in the directory, so its being held open.
libtestbed::SENDMAIL($TBOPS,
......@@ -597,6 +600,10 @@ sub Delete($;$)
unlink($eidlink)
if (-l $eidlink);
}
my $logfile = $self->GetLogFile();
if (defined($logfile)) {
$logfile->Delete();
}
libArchive::TBDeleteExperimentArchive($pid, $eid);
DBQueryWarn("DELETE from experiments ".
......@@ -1527,20 +1534,60 @@ sub SetState($$)
#
# Open a new logfile and return its name.
#
sub CreateLogFile($$$)
sub CreateLogFile($$)
{
my ($self, $prefix, $pref) = @_;
my ($self, $prefix) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $pid = $self->pid();
my $eid = $self->eid();
my $gid_idx = $self->gid_idx();
my $logdir = $self->WorkDir();
my $linkname = "$logdir/${prefix}.log";
my $logname = `mktemp $logdir/${prefix}.XXXXXX`;
return undef
if ($?);
# Untaint to avoid silly warnings
if ($logname =~ /^([-\w\.\/]+)$/) {
$logname = $1;
}
else {
print STDERR "Bad data in filename: $logname\n";
return undef;
}
# Need to deal with errors.
$$pref = TBExptCreateLogFile($pid, $eid, $prefix);
return 0;
# Create a Logfile.
my $logfile = Logfile->Create($gid_idx, $logname);
if (!defined($logfile)) {
unlink($logname);
return undef;
}
# This is untainted.
$logname = $logfile->filename();
# So tbops people can read the files ...
if (!chmod(0664, $logname)) {
print STDERR "Could not chmod $logname to 0644: $!\n";
$logfile->Delete();
unlink($logname);
return undef;
}
# Link it to $prefix.log so that the most recent is well known.
if (-e $linkname) {
unlink($linkname);
}
if (! link($logname, $linkname)) {
print STDERR "CreateLogFile: Cannot link $logname,$linkname: $!\n";
$logfile->Delete();
unlink($logname);
return undef;
}
return $logfile;
}
#
......@@ -1578,40 +1625,49 @@ sub GetNSFile($$)
#
# Set the experiment to use the logfile. It becomes the "current" spew.
#
sub SetLogFile($$)
sub SetLogFile($$;$)
{
my ($self, $logname) = @_;
my ($self, $logfile, $oldlogref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
if (! ref($self) || !ref($logfile));
my $pid = $self->pid();
my $eid = $self->eid();
if (defined($oldlogref)) {
$$oldlogref = $self->GetLogFile();
}
else {
# Kill the old one. Eventually we will save them.
my $oldlogfile = $self->GetLogFile();
if (defined($oldlogfile)) {
$oldlogfile->Delete();
}
}
return -1
if (! $self->Update({'logfile' => $logfile->logid()}));
TBExptSetLogFile($pid, $eid, $logname);
return 0;
}
#
# Get the experiment logfile.
#
sub GetLogFile($$$)
sub GetLogFile($)
{
my ($self, $lognamep, $isopenp) = @_;
my ($self) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
# Must do this to catch updates to the logfile variables.
return undef
if ($self->Refresh());
$$lognamep = undef;
return undef
if (! $self->logfile());
TBExptGetLogFile($pid, $eid, $lognamep, $isopenp)
or return -1;
return 0;
return Logfile->Lookup($self->logfile());
}
#
......@@ -1625,11 +1681,11 @@ sub OpenLogFile($)
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
TBExptOpenLogFile($pid, $eid);
return 0;
return $logfile->Open();
}
#
......@@ -1643,11 +1699,11 @@ sub CloseLogFile($)
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
TBExptCloseLogFile($pid, $eid);
return 0;
return $logfile->Close();
}
#
......@@ -1661,11 +1717,18 @@ sub ClearLogFile($)
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
TBExptClearLogFile($pid, $eid);
return 0;
$logfile->Delete() == 0
or return -1;
my $exptidx = $self->idx();
DBQueryWarn("update experiments set logfile=NULL where idx='$exptidx'")
or return -1;
return $self->Refresh();
}
#
......
......@@ -18,6 +18,7 @@ use lib '@prefix@/lib';
use libdb;
use libtestbed;
use English;
use Group;
use Data::Dumper;
# Configure variables
......@@ -60,6 +61,7 @@ sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'LOGFILE'}->{$_[1]}); }
sub logid($) { return field($_[0], "logid"); }
sub filename($) { return field($_[0], "filename"); }
sub isopen($) { return field($_[0], "isopen"); }
sub gid_idx($) { return field($_[0], "gid_idx"); }
sub date_created($) { return field($_[0], "date_created"); }
#
......@@ -89,9 +91,9 @@ sub Refresh($)
# Create a new logfile. We are given the optional filename, otherwise
# generate one.
#
sub Create($;$)
sub Create($$;$)
{
my ($class, $filename) = @_;
my ($class, $gid_idx, $filename) = @_;
return undef
if (ref($class));
......@@ -106,6 +108,7 @@ sub Create($;$)
" logid='$logid', ".
" isopen=0, ".
" filename='$filename', ".
" gid_idx='$gid_idx', ".
" date_created=now()")) {
return undef;
}
......@@ -136,6 +139,33 @@ sub Delete($;$)
return 0;
}
#
# AccessCheck. The user needs to be a member of the group that the logfile
# was created in.
#
sub AccessCheck($$)
{
my ($self, $user) = @_;
# Must be a real reference.
return 0
if (! ref($self));
# Admins do whatever they want.
return 1
if ($user->IsAdmin());
my $group = Group->Lookup($self->gid_idx());
return 0
if (!defined($group));
# Membership in group.
return 1
if (defined($group->LookupUser($user)));
return 0;
}
#
# Mark a file open so that the web interface knows to watch it.
#
......
......@@ -170,9 +170,8 @@ use vars qw(@ISA @EXPORT);
TBResolveNextOSID TBOsidToPid TBOSIDRebootWaittime
TBOSLoadMaxOkay TBImageLoadMaxOkay TBImageID
TBdbfork TBDBDisconnect VnameToNodeid
TBIsNodeRemote TBExptSetLogFile TBExptClearLogFile TBExptGetLogFile
TBIsNodeRemote
TBIsNodeImageable TBIsNodeVirtual TBControlNetIP TBPhysNodeID
TBExptOpenLogFile TBExptCloseLogFile TBExptCreateLogFile
TBNodeUpdateAccountsByPid TBNodeUpdateAccountsByType
TBNodeUpdateAccountsByUID
TBSaveExpLogFiles TBExptWorkDir TBExptUserDir TBExptLogDir
......@@ -2392,79 +2391,6 @@ sub MarkPhysNodeDown($)
TBSetNodeHistory($pnode, TB_NODEHISTORY_OP_MOVE, $UID, $pid, $eid);
}
#
# Set/Clear the current logfile for an experiment. The idea is to provide
# a way to look at what is going on from the web interface!
#
# usage TBExptSetLogFile(char *pid, char *eid, char *logname)
#
sub TBExptSetLogFile($$$)
{
my ($pid, $eid, $logname) = @_;
DBQueryWarn("update experiments set logfile='$logname' ".
"where pid='$pid' and eid='$eid'");
}
sub TBExptClearLogFile($$)
{
my ($pid, $eid) = @_;
DBQueryWarn("update experiments set logfile=NULL,logfile_open=0 ".
"where pid='$pid' and eid='$eid'");
}
#
# Flag the logfile as either open or closed. This allows the spew code
# to determine when the log is no longer being appended to. Is there a
# system oriented way to do this?
#
# usage TBExptOpenLogFile(char *pid, char *eid)
# usage TBExptCloseLogFile(char *pid, char *eid)
#
sub TBExptOpenLogFile($$)
{
my ($pid, $eid) = @_;
DBQueryWarn("update experiments set logfile_open=1 ".
"where pid='$pid' and eid='$eid'");
}
sub TBExptCloseLogFile($$)
{
my ($pid, $eid) = @_;
DBQueryWarn("update experiments set logfile_open=0 ".
"where pid='$pid' and eid='$eid'");
}
#
# Get the current logfile for an experiment.
#
# usage TBExptGetLogFile(char *pid, char *eid, char \*logname, int \isopen)
# Return 1 if there is a valid logname, and sets logname.
# Return 0 if no logfile or error.
#
sub TBExptGetLogFile($$$$)
{
my ($pid, $eid, $logname, $isopen) = @_;
my $query_result =
DBQueryFatal("select logfile,logfile_open from experiments ".
"where pid='$pid' and eid='$eid'");
if ($query_result->numrows == 0) {
return 0;
}
my @row = $query_result->fetchrow_array();
if (defined($row[0])) {
$$logname = $row[0];
$$isopen = $row[1];
return 1;
}
return 0;
}
#
# Return the working directory name for an experiment. This is where
# the scripts work. The logs are copied over to the user's version of
......@@ -2535,46 +2461,6 @@ sub TBExptUserDir($$)
return $path;
}
#
# Create a temp logfile name for an experiment, create it, and untaint it!
# The file is created the experiment working directory and moved later
# to the user visible directory.
#
sub TBExptCreateLogFile($$$)
{
my($pid, $eid, $prefix) = @_;
my $logdir;
my $logname;
my $linkname;
$logdir = TBExptWorkDir($pid, $eid);
$linkname = "$logdir/${prefix}.log";
$logname = `mktemp $logdir/${prefix}.XXXXXX`;
if ($logname =~ /^([-\@\w\.\/]+)$/) {
$logname = $1;
}
else {
die("*** $0:\n".
" Bad data in logfile name: $logname");
}
chmod(0664, $logname) or
die("*** $0:\n".
" Could not chmod $logname to 0644: $!\n");
# Link it to $prefix.log so that the most recent is well know.
if (-e $linkname) {
unlink($linkname);
}
if (! link($logname, $linkname)) {
die("*** $0:\n".
" CreateLogFile: Cannot link $logname,$linkname: $!\n");
}
return $logname;
}
#
# Return the min/max node counts for an experiment.
#
......
......@@ -1570,6 +1570,8 @@ CREATE TABLE `logfiles` (
`logid` varchar(40) NOT NULL default '',
`filename` tinytext,
`isopen` tinyint(4) NOT NULL default '0',
`gid_idx` mediumint(8) unsigned NOT NULL default '0',
`uid_idx` mediumint(8) unsigned NOT NULL default '0',
`date_created` datetime default NULL,
PRIMARY KEY (`logid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
......
......@@ -4188,9 +4188,15 @@ last_net_act,last_cpu_act,last_ext_act);
`logid` varchar(40) NOT NULL default '',
`filename` tinytext,
`isopen` tinyint(4) NOT NULL default '0',
`gid_idx` mediumint(8) unsigned NOT NULL default '0',
`date_created` datetime default NULL,
PRIMARY KEY (`logid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
alter table experiment_template_instances add \
`logfileid` varchar(40) default NULL after uid_idx;
4.135: Change to previous revision. Run the following script.
./logfiles.pl
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use lib "/usr/testbed/lib";
use libdb;
use libtestbed;
use Experiment;
use Logfile;
#
# Untaint the path
#
$ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
my $query_result =
DBQueryFatal("select idx,logfile,gid_idx from experiments ".
"where logfile!='' and logfile is not null");
while (my ($idx, $logname, $gid_idx) = $query_result->fetchrow_array()) {
next
if (! ($logname =~ /^\//));
my $experiment = Experiment->Lookup($idx);
if (!defined($experiment)) {
print "Could not lookup experiment object for $idx\n";
next;
}
my $logfile = Logfile->Create($gid_idx, $logname);
$experiment->SetLogFile($logfile);
}
......@@ -412,6 +412,11 @@ sub Delete($)
DeleteInputFiles($self) == 0
or return -1;
my $logfile = $self->GetLogFile();
if (defined($logfile)) {
$logfile->Delete();
}
# The graph can be removed if this is the last template version.
my $query_result =
DBQueryWarn("select vers from experiment_templates ".
......@@ -449,14 +454,14 @@ sub Delete($)
#
# Logfiles. This all needs to change.
#
# Open a new logfile and return its name.
# Open a new logfile and return it.
#
sub CreateLogFile($$$)
sub CreateLogFile($$)
{
my ($self, $prefix, $ppath) = @_;
my ($self, $prefix) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
my $vers = $self->vers();
......@@ -466,31 +471,37 @@ sub CreateLogFile($$$)
my $logdir = "$projroot/$pid/templates/logs";
my $linkname = "$logdir/$prefix.${guid}-${vers}.log";
return -1
return undef
if (! -d $logdir && !mkdir($logdir, 0775));
my $logname = `mktemp $logdir/$prefix.${guid}-${vers}.XXXXXX`;
return undef
if ($?);
chomp($logname);
if ($logname =~ /^([-\@\w\.\/]+)$/) {
$logname = $1;
}
else {
return -1;
# Create a Logfile.
my $logfile = Logfile->Create($self->gid_idx(), $logname);
if (!defined($logfile)) {
unlink($logname);
return undef;
}
if (-e $linkname) {
return -1
if (! unlink($linkname));
# This is untainted.
$logname = $logfile->filename();
unlink($linkname)
if (-e $linkname);
if (Template::mysystem("touch $logname")) {
$logfile->Delete();
unlink($logname);
return undef;
}
Template::mysystem("touch $logname") == 0
or return -1;
if (! link($logname, $linkname)) {
print STDERR "*** Cannot link $logname,$linkname: $!\n";
return -1;
$logfile->Delete();
unlink($logname);
return undef;
}
$$ppath = $linkname;
return 0;
return $logfile;
}
#
......@@ -498,36 +509,39 @@ sub CreateLogFile($$$)
#
sub SetLogFile($$)
{
my ($self, $logname) = @_;
my ($self, $logfile) = @_;
# Must be a real reference.
return -1
if (! ref($self));
if (! ref($self) || !ref($logfile));
return $self->Update({'logfile' => $logname});
# Kill the old one. Eventually we will save them.
my $oldlogfile = $self->GetLogFile();
if (defined($oldlogfile)) {
$oldlogfile->Delete();
}
return $self->Update({'logfile' => $logfile->logid()});
}
#
# Get the experiment logfile.
#
sub GetLogFile($$$)
sub GetLogFile($)
{
my ($self, $lognamep, $isopenp) = @_;
my ($self) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
# Must do this to catch updates to the logfile variables.
return -1
return undef
if ($self->Refresh());
return -1
return undef
if (! $self->logfile());
$$lognamep = $self->logfile();
$$isopenp = $self->logfile_open();
return 0;
return Logfile->Lookup($self->logfile());
}
#
......@@ -541,7 +555,11 @@ sub OpenLogFile($)
return -1
if (! ref($self));
return $self->Update({'logfile_open' => 1});
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
return $logfile->Open();
}
#
......@@ -555,7 +573,11 @@ sub CloseLogFile($)
return -1
if (! ref($self));
return $self->Update({'logfile_open' => 0});
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
return $logfile->Close();
}
#
......@@ -569,11 +591,18 @@ sub ClearLogFile($)
return -1
if (! ref($self));
my $logfile = $self->GetLogFile();
return -1
if (!defined($logfile));
$logfile->Delete() == 0
or return -1;
my $guid = $self->guid();
my $vers = $self->vers();
if (!DBQueryWarn("update experiment_templates set ".
"logfile=NULL,logfile_open=0 ".
" logfile=NULL ".
"where guid='$guid' and vers='$vers'")) {
return -1;
}
......@@ -3556,7 +3585,7 @@ sub CreateLogFile($$)
Template::mysystem("touch $logname") == 0
or return undef;
my $logfile = Logfile->Create($logname);
my $logfile = Logfile->Create($self->template()->gid_idx(), $logname);
if (!defined($logfile)) {
unlink($logname);
return undef;
......
......@@ -365,13 +365,13 @@ sub dosomething($$)
# we can remove it when the child ends. The child could remove it, but
# since it is open in the child, it has the tendency to stick around.
#
$logname = TBExptCreateLogFile($pid, $eid, "${dowhat}-batch");
my $logfile = $experiment->CreateLogFile("${dowhat}-batch");
if (!defined($logfile)) {
print "Could not create logfile!\n";
return -1;
}
$logname = $logfile->filename();
#
# If this is a template instantiation, then do not set the logfile.
# We still generate the log file, but it is not available via the
# web interface. Needs more thought.
#
my $exptidx = $exphash->{'idx'};
my $instance = Template::Instance->LookupByExptidx($exptidx);
if (defined($instance)) {
......@@ -400,13 +400,15 @@ sub dosomething($$)
# The exp dir might be gone if the batch was killed/canceled.
#
if (-e $userdir) {
TBExptCloseLogFile($pid, $eid);
$experiment->CloseLogFile();
}
return $status;
}
openlog($logname);
TBExptSetLogFile($pid, $eid, $logname);
TBExptOpenLogFile($pid, $eid);
# We want it to spew to the web.
$experiment->SetLogFile($logfile);
# And mark it as spewing.
$experiment->OpenLogFile();
#
# Get some user information.
......
......@@ -111,6 +111,7 @@ my $tbbindir = "$TB/bin/";
my $RSYNC = "/usr/local/bin/rsync";
my $errorstat=-1;
my $exptidx;
my $logfile;
my $logname;
# For the END block below.
......@@ -489,12 +490,15 @@ goto skiplog
# is ready. In waitmode, we hold the parent waiting so that the user
# can script it. Must protect against async (^C) termination though.
#
if ($experiment->CreateLogFile("startexp", \$logname) != 0) {
$logfile = $experiment->CreateLogFile("startexp");
if (!defined($logfile)) {
fatal("Could not create logfile!");
}
$experiment->SetLogFile($logname);
$experiment->OpenLogFile($logname);
$logname = $logfile->filename();
# We want it to spew to the web.
$experiment->SetLogFile($logfile);
# Mark it open since we are going to start using it right away.
$logfile->Open();
if (my $childpid = TBBackGround($logname)) {
#
......
......@@ -89,6 +89,7 @@ my $tbdata = "tbdata";
my $archcontrol = "$TB/bin/archive_control";
my $nextstate;
my $logname;
my $logfile;
#