Commit 677a9082 authored by Leigh Stoller's avatar Leigh Stoller

Script to run out of nightly crontab, to remove stale experiment

directories from the proj and groups tree.
parent a9177c3f
......@@ -20,7 +20,8 @@ sub Install($$$)
}
DoneIfEdited($CRONTAB);
my @cronlist = ("0 \t6\t*\t*\t*\troot\t$PREFIX/sbin/quotamail");
my @cronlist = ("0 \t6\t*\t*\t*\troot\t$PREFIX/sbin/quotamail",
"3 \t5\t*\t*\t*\troot\t$PREFIX/sbin/pruneexpdirs");
if ($WIKISUPPORT) {
push(@cronlist,
"*/15 \t*\t*\t*\t*\troot\t(cd $OPSWWWDIR/twiki/bin;".
......
......@@ -72,7 +72,7 @@ LIBEXEC_SCRIPTS = spewleds webcopy spewsource webcvsweb xlogin webviewvc \
CTRLSBIN_SCRIPTS= opsdb_control.proxy daemon_wrapper ec2import.proxy \
ec2import-image.pl GrubConf.rb export-template-remote.rb \
setzfsquotas
setzfsquotas pruneexpdirs
SBSBIN_SCRIPTS= daemon_wrapper subboss_cacheclean
......
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2017 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
# This file is part of the Emulab network testbed software.
#
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this file. If not, see <http://www.gnu.org/licenses/>.
#
# }}}
#
use English;
use strict;
use Getopt::Std;
use File::Basename;
use Data::Dumper;
#
# Prune dead experiment directories that could not be deleted, typically
# cause files were still open when the experiment was terminated.
#
sub usage()
{
print("Usage: pruneexpdirs [-n] [-v]\n".
"Options:\n".
" -n Impotent mode, show what would be done.\n".
" -v Verbose mode.\n");
exit(-1);
}
my $optlist = "vn";
my $verbose = 0;
my $impotent = 0;
my @deleted = ();
my @failures = ();
#
# Configure variables
#
my $TB = "@prefix@";
my $PROJROOT = "@PROJROOT_DIR@";
my $GROUPSROOT = "@GROUPSROOT_DIR@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@";
#
# Untaint the path
#
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Turn off line buffering on output
#
$| = 1;
#
# Root only please
#
if ($UID != 0) {
die("*** $0:\n".
" Must run this script as root.\n");
}
#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use libtestbed;
# Protos
sub fatal($);
sub PruneDirs($);
sub ExecQuiet($);
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (defined($options{"v"})) {
$verbose = 1;
}
if (defined($options{"n"})) {
$impotent = 1;
$verbose = 1;
}
usage()
if (@ARGV);
# Run this in the project and group directory only!
chdir($PROJROOT) or
fatal("Could not chdir($PROJROOT)");
# Be paranoid.
my $cmd = "find -E . -maxdepth 3 -type d -mmin +4320 -regex ".
"'^\\./[^\\/]+/exp/[^\\.]+\\.[0-9]{5}\$' -print";
if ($verbose) {
print "Running a find in $PROJROOT, patience please ... lots of it.\n";
}
my $dirs = ExecQuiet($cmd);
if ($?) {
fatal($dirs);
}
if ($dirs ne "") {
PruneDirs($dirs);
}
#
# Now we do in the groups directory, which requires a different command.
#
chdir($GROUPSROOT) or
fatal("Could not chdir($GROUPSROOT)");
# Be paranoid.
$cmd = "find -E . -maxdepth 4 -type d -mmin +4320 -regex ".
"'^\\./[^\\/]+/[^\\/]+/exp/[^\\.]+\\.[0-9]{5}\$' -print";
if ($verbose) {
print "Running a find in $GROUPSROOT, patience please ... lots of it.\n";
}
$dirs = ExecQuiet($cmd);
if ($?) {
fatal($dirs);
}
if ($dirs ne "") {
PruneDirs($dirs);
}
# Always send notification of success to the logs file.
if (@deleted) {
SENDMAIL($TBLOGS, "pruneexpdirs",
"Stale experiment directories deleted:\n\n".
join("\n", @deleted), $TBOPS);
}
# Then die if any failures.
if (@failures) {
fatal("Stale experiment directories could not be deleted:\n\n".
join("\n", @failures));
}
exit(0);
#
# Prune a list of directories.
#
sub PruneDirs($)
{
my ($dirs) = @_;
while ($dirs =~ /^(.*)$/gm) {
my $line = $1;
if ($verbose) {
if ($impotent) {
print "Would delete ";
}
print "$line\n";
}
next
if ($impotent);
my $output = ExecQuiet("/bin/rm -rf $line");
if ($?) {
push(@failures, "$line\n$output");
}
else {
push(@deleted, $line);
}
}
}
sub fatal($)
{
my ($mesg) = @_;
SENDMAIL($TBOPS, "pruneexpdirs failed", $mesg, $TBOPS);
die("*** $0:\n".
" $mesg\n");
}
#
# Run a command, being sure to capture all output.
#
sub ExecQuiet($)
{
#
# Use a pipe read, so that we save away the output
#
my ($command) = @_;
my $output = "";
#
# This open implicitly forks a child, which goes on to execute the
# command. The parent is going to sit in this loop and capture the
# output of the child. We do this so that we have better control
# over the descriptors.
#
my $pid = open(PIPE, "-|");
if (!defined($pid)) {
print STDERR "ExecQuiet Failure; popen failed!\n";
return -1;
}
if ($pid) {
while (<PIPE>) {
$output .= $_;
}
close(PIPE);
}
else {
open(STDERR, ">&STDOUT");
exec($command);
}
return $output;
}
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