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
Dirvish@dirvish.org
http://www.dirvish.org/mailman/listinfo/dirvish

Reply via email to