Dave Howorth wrote:
> I finally managed to find my bug. It'll be a couple of days whilst I
> check that it at least seems to really work in my installation and then
> I'll post it.
OK. It seems to work. On appropriate occasions, it produces messages like:
cannot expire pcx36-root:default:2011-07-13 It's the latest good image
I've attached the modified dirvish-expire to this message and here's a
diff from the previous version (caveat! The previous version may or may
not be exactly what I originally downloaded!)
Cheers, Dave
--- dirvish-expire 2011-03-17 15:31:58.000000000 +0000
+++ dirvish-expire-new 2011-07-19 11:00:08.000000000 +0100
@@ -109,6 +109,7 @@
$$Options{time} and $expire_time = parsedate($$Options{time});
$expire_time ||= time;
+my %recent;
if ($$Options{vault})
{
@@ -150,7 +151,20 @@
my ($created, $expired);
($created = $$expire{created}) =~ s/:\d\d$//;
($expired = $$expire{expire}) =~ s/:\d\d$//;
-
+
+ my $vault = $$expire{vault};
+ my $branch = $$expire{branch};
+
+ if ($recent{$vault}{$branch} eq $created)
+ {
+ printf "cannot expire %s:%s:%s It's the latest good
image\n",
+ $vault,
+ $branch,
+ $$expire{image};
+ ++$unexpired{$vault}{$branch};
+ next;
+ }
+
if (!$unexpired{$$expire{vault}}{$$expire{branch}})
{
printf "cannot expire %s:%s:%s No unexpired good images\n",
@@ -224,6 +238,19 @@
$$summary{vault} && $$summary{branch} && $$summary{Image}
or return;
+ my ($vault, $branch, $success, $created, $recent);
+
+ $vault = $$summary{vault};
+ $branch = $$summary{branch};
+ $success = $$summary{Status} =~ /^success/ && -d ($path
. '/tree');
+ ($created = $$summary{'Backup-complete'}) =~ s/:\d\d$//;
+ $recent = $recent{$vault}{$branch};
+
+ if ($success and (!defined($recent) or $recent lt $created))
+ {
+ $recent{$vault}{$branch} = $created;
+ }
+
if ($status == 0)
{
$$summary{Status} =~ /^success/ && -d ($path .
'/tree')
#!/usr/bin/perl
$CONFDIR = "/etc/dirvish";
# $Id: dirvish-expire.pl,v 12.0 2004/02/25 02:42:14 jw Exp $ $Name:
Dirvish-1_2 $
$VERSION = ('$Name: Dirvish-1_2 $' =~ /Dirvish/i)
? ('$Name: Dirvish-1_2 $' =~ m/^.*:\s+dirvish-(.*)\s*\$$/i)[0]
: '1.1.2 patch' . ('$Id: dirvish-expire.pl,v 12.0 2004/02/25 02:42:14
jw Exp $'
=~ m/^.*,v(.*:\d\d)\s.*$/)[0];
$VERSION =~ s/_/./g;
#########################################################################
# #
# Copyright 2002 and $Date: 2004/02/25 02:42:14 $
# 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;
my %recent;
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$//;
my $vault = $$expire{vault};
my $branch = $$expire{branch};
if ($recent{$vault}{$branch} eq $created)
{
printf "cannot expire %s:%s:%s It's the latest good image\n",
$vault,
$branch,
$$expire{image};
++$unexpired{$vault}{$branch};
next;
}
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;
my ($vault, $branch, $success, $created, $recent);
$vault = $$summary{vault};
$branch = $$summary{branch};
$success = $$summary{Status} =~ /^success/ && -d ($path .
'/tree');
($created = $$summary{'Backup-complete'}) =~ s/:\d\d$//;
$recent = $recent{$vault}{$branch};
if ($success and (!defined($recent) or $recent lt $created))
{
$recent{$vault}{$branch} = $created;
}
if ($status == 0)
{
$$summary{Status} =~ /^success/ && -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};
}
# Get patch level of loadconfig.pl in case exit codes
# are needed.
# $Id: loadconfig.pl,v 12.0 2004/02/25 02:42:15 jw Exp $
#########################################################################
# #
# Copyright 2002 and $Date: 2004/02/25 02:42:15 $
# Pegasystems Technologies and J.W. Schultz #
# #
# Licensed under the Open Software License version 2.0 #
# #
#########################################################################
sub seppuku # Exit with code and message.
{
my ($status, $message) = @_;
chomp $message;
if ($message)
{
$seppuku_prefix and print STDERR $seppuku_prefix, ': ';
print STDERR $message, "\n";
}
exit $status;
}
sub slurplist
{
my ($key, $filename, $Options) = @_;
my $f;
my $array;
$filename =~ m(^/) and $f = $filename;
if (!$f && ref($$Options{vault}) ne 'CODE')
{
$f = join('/', $$Options{Bank}, $$Options{vault},
'dirvish', $filename);
-f $f or $f = undef;
}
$f or $f = "$CONFDIR/$filename";
open(PATFILE, "<$f") or seppuku 229, "cannot open $filename for $key
list";
$array = $$Options{$key};
while(<PATFILE>)
{
chomp;
length or next;
push @{$array}, $_;
}
close PATFILE;
}
# loadconfig -- load configuration file
# SYNOPSYS
# loadconfig($opts, $filename, \%data)
#
# DESCRIPTION
# load and parse a configuration file into the data
# hash. If the filename does not contain / it will be
# looked for in the vault if defined. If the filename
# does not exist but filename.conf does that will
# be read.
#
# OPTIONS
# Options are case sensitive, upper case has the
# opposite effect of lower case. If conflicting
# options are given only the last will have effect.
#
# f Ignore fields in config file that are
# capitalized.
#
# o Config file is optional, return undef if missing.
#
# R Do not allow recoursion.
#
# g Only load from global directory.
#
#
#
# LIMITATIONS
# Only way to tell whether an option should be a list
# or scalar is by the formatting in the config file.
#
# Options reqiring special handling have to have that
# hardcoded in the function.
#
sub loadconfig
{
my ($mode, $configfile, $Options) = @_;
my $confile = undef;
my ($key, $val);
my $CONFIG;
ref($Options) or $Options = {};
my %modes;
my ($conf, $bank, $k);
$modes{r} = 1;
for $_ (split(//, $mode))
{
if (/[A-Z]/)
{
$_ =~ tr/A-Z/a-z/;
$modes{$_} = 0;
} else {
$modes{$_} = 1;
}
}
$CONFIG = 'CFILE' . scalar(@{$$Options{Configfiles}});
$configfile =~ s/^.*\@//;
if($configfile =~ m[/])
{
$confile = $configfile;
}
elsif($configfile ne '-')
{
if(!$modes{g} && $$Options{vault} && $$Options{vault} ne 'CODE')
{
if(!$$Options{Bank})
{
my $bank;
for $bank (@{$$Options{bank}})
{
if (-d "$bank/$$Options{vault}")
{
$$Options{Bank} = $bank;
last;
}
}
}
if ($$Options{Bank})
{
$confile = join('/', $$Options{Bank},
$$Options{vault}, 'dirvish',
$configfile);
-f $confile || -f "$confile.conf"
or $confile = undef;
}
}
$confile ||= "$CONFDIR/$configfile";
}
if($configfile eq '-')
{
open($CONFIG, $configfile) or seppuku 221, "cannot open STDIN";
} else {
! -f $confile && -f "$confile.conf" and $confile .= '.conf';
if (! -f "$confile")
{
$modes{o} and return undef;
seppuku 222, "cannot open config file: $configfile";
}
grep(/^$confile$/, @{$$Options{Configfiles}})
and seppuku 224, "ERROR: config file looping on
$confile";
open($CONFIG, $confile)
or seppuku 225, "cannot open config file: $configfile";
}
push(@{$$Options{Configfiles}}, $confile);
while(<$CONFIG>)
{
chomp;
s/\s*#.*$//;
s/\s+$//;
/\S/ or next;
if(/^\s/ && $key)
{
s/^\s*//;
push @{$$Options{$key}}, $_;
}
elsif(/^SET\s+/)
{
s/^SET\s+//;
for $k (split(/\s+/))
{
$$Options{$k} = 1;
}
}
elsif(/^UNSET\s+/)
{
s/^UNSET\s+//;
for $k (split(/\s+/))
{
$$Options{$k} = undef;
}
}
elsif(/^RESET\s+/)
{
($key = $_) =~ s/^RESET\s+//;
$$Options{$key} = [ ];
}
elsif(/^[A-Z]/ && $modes{f})
{
$key = undef;
}
elsif(/^\S+:/)
{
($key, $val) = split(/:\s*/, $_, 2);
length($val) or next;
$k = $key; $key = undef;
if ($k eq 'config')
{
$modes{r} and loadconfig($mode . 'O', $val,
$Options);
next;
}
if ($k eq 'client')
{
if ($modes{r} && ref ($$Options{$k}) eq 'CODE')
{
loadconfig($mode . 'og',
"$CONFDIR/$val", $Options);
}
$$Options{$k} = $val;
next;
}
if ($k eq 'file-exclude')
{
$modes{r} or next;
slurplist('exclude', $val, $Options);
next;
}
if (ref ($$Options{$k}) eq 'ARRAY')
{
push @{$$Options{$k}}, $_;
} else {
$$Options{$k} = $val;
}
}
}
close $CONFIG;
return $Options;
}
_______________________________________________
Dirvish mailing list
[email protected]
http://www.dirvish.org/mailman/listinfo/dirvish
