back to AnnotatedVersionV1p2
The install.sh script appends loadconfig.pl (LoadConfigV1p2) to the end of this to build the runtime perl script "dirvish-expire".
# $Id: DirvishExpireV1p2,v 1.9 2004/12/20 17:02:41 apache Exp apache $ $Name: $
$VERSION = ('$Name: $' =~ /Dirvish/i)
? ('$Name: $' =~ m/^.*:\s+dirvish-(.*)\s*\$$/i)[0]
: '1.1.2 patch' . ('$Id: DirvishExpireV1p2,v 1.9 2004/12/20 17:02:41 apache Exp apache $'
=~ m/^.*,v(.*:\d\d)\s.*$/)[0];
$VERSION =~ s/_/./g;
#########################################################################
# #
# Copyright 2002 and $Date: 2004/12/20 17:02:41 $
# Pegasystems Technologies and J.W. Schultz #
# #
# Licensed under the Open Software License version 2.0 #
# #
# This program is free software; you can redistribute it #
# and/or modify it under the terms of the Open Software #
# License, version 2.0 by Lauwrence E. Rosen. #
# #
# This program 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 Open Software License for details. #
# #
#########################################################################
use Time::ParseDate;
use POSIX qw(strftime);
use File::Find;
use Getopt::Long;
sub loadconfig;
sub check_expire;
sub findop;
sub imsort;
sub seppuku;
sub usage
{
my $message = shift(@_);
length($message) and print STDERR $message, "\n\n";
print STDERR <<EOUSAGE;
USAGE
dirvish.expire OPTIONS
OPTIONS
--time date_expression
--[no]tree
--vault vault_name
--no-run
--quiet
EOUSAGE
exit 255;
}
$Options =
{
help => \&usage,
version => sub {
print STDERR "dirvish version $VERSION\n";
exit(0);
},
};
if ($CONFDIR =~ /dirvish$/ && -f "$CONFDIR.conf")
{
loadconfig(undef, "$CONFDIR.conf", $Options);
}
elsif (-f "$CONFDIR/master.conf")
{
loadconfig(undef, "$CONFDIR/master.conf", $Options);
}
elsif (-f "$CONFDIR/dirvish.conf")
{
seppuku 250, <<EOERR;
ERROR: no master configuration file.
An old $CONFDIR/dirvish.conf file found.
Please read the dirvish release notes.
EOERR
}
else
{
seppuku 251, "ERROR: no global configuration file";
}
GetOptions($Options, qw(
quiet!
vault=s
time=s
tree!
no-run|dry-run
version
help|?
)) or usage;
ref($$Options{vault}) and $$Options{vault} = undef;
$$Options{time} and $expire_time = parsedate($$Options{time});
$expire_time ||= time;
if ($$Options{vault})
{
my $b;
my $bank;
for $b (@{$$Options{bank}})
{
if (-d "$b/$$Options{vault}")
{
$bank = $b;
last;
}
}
$bank or seppuku 252, "Cannot find vault $$Options{vault}";
find(\&findop, join('/', $bank, $$Options{vault}));
} else {
for $bank (@{$$Options{bank}})
{
find(\&findop, $bank);
}
}
scalar(@expires) or exit 0;
if (!$$Options{quiet})
{
printf "Expiring images as of %s\n",
strftime('%Y-%m-%d %H:%M:%S', localtime($expire_time));
$$Options{vault} and printf "Restricted to vault %s\n",
$$Options{vault};
print "\n";
printf "%-15s %-15s %-16.16s %s\n",
qw(VAULT:BRANCH IMAGE CREATED EXPIRED);
}
for $expire (sort(imsort @expires))
{
my ($created, $expired);
($created = $$expire{created}) =~ s/:\d\d$//;
($expired = $$expire{expire}) =~ s/:\d\d$//;
if (!$unexpired{$$expire{vault}}{$$expire{branch}})
{
printf "cannot expire %s:%s:%s No unexpired good images\n",
$$expire{vault},
$$expire{branch},
$$expire{image};
$$expire{status} =~ /^success/
and ++$unexpired{$$expire{vault}}{$$expire{branch}};
# By virtue of the sort order this will be the newest
# image so that older ones can be expired.
next;
}
$$Options{quiet} or printf "%-15s %-15s %-16.16s %s\n",
$$expire{vault} . ':' . $$expire{branch},
$$expire{image},
$created,
$expired;
$$Options{'no-run'} and next;
system("rm -rf $$expire{path}/tree");
$$Options{tree} and next;
system("rm -rf $$expire{path}");
}
exit 0;
sub check_expire
{
my ($summary, $expire_time) = @_;
my ($expire, $etime, $path);
$expire = $$summary{Expire};
$expire =~ s/^.*==\s+//;
$expire or return 0;
$expire =~ /never/i and return 0;
$etime = parsedate($expire);
if (!$etime)
{
print STDERR "$File::Find::dir: invalid expiration time $$summary{expire}\n";
return -1;
}
$etime > $expire_time and return 0;
return 1;
}
sub findop
{
if ($_ eq 'tree')
{
$File::Find::prune = 1;
return 0;
}
if ($_ eq 'summary')
{
my $summary;
my ($etime, $path);
$path = $File::Find::dir;
$summary = loadconfig('R', $File::Find::name);
$status = check_expire($summary, $expire_time);
$status < 0 and return;
$$summary{vault} && $$summary{branch} && $$summary{Image}
or return;
if ($status == 0)
{
$$summary{Status} =~ /^success/ && -d ($path . '/tree')
If we consider rsync return code 24 as a warning then we should change this line to:
$$summary{Status} =~ /^success|^warning/ && -d ($path . '/tree')
and ++$unexpired{$$summary{vault}}{$$summary{branch}};
return;
}
-d ($path . ($$Options{tree} ? '/tree': undef)) or return;
push (@expires, {
vault => $$summary{vault},
branch => $$summary{branch},
client => $$summary{client},
tree => $$summary{tree},
image => $$summary{Image},
created => $$summary{'Backup-complete'},
expire => $$summary{Expire},
status => $$summary{Status},
path => $path,
}
);
}
}
## WARNING: don't mess with the sort order, it is needed so that if
## WARNING: all images are expired the newest will be retained.
sub imsort
{
$$a{vault} cmp $$b{vault}
|| $$a{branch} cmp $$b{branch}
|| $$a{created} cmp $$b{created};
}