dirvish 1.2.1-1.2 / usr / sbin / dirvish-expire

#!/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;


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')
				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;
}