Add some stuff

git-svn-id: svn+ssh://asteria.noreply.org/svn/weaselutils/trunk@2 bc3d92e2-beff-0310-a7cd-cc87d7ac0ede

1 files changed, 214 insertions, 0 deletions

diff --git a/expire-baks b/expire-baks
new file mode 100755
index 0000000..c015a38
--- /dev/null
+++ b/expire-baks
@@ -0,0 +1,214 @@
+#!/usr/bin/perl -wI /usr/local/share/perl5
+
+# expire-baks  --  expire backup files of format yyyymmdd-hhmmss-something.gz
+#
+#  Copyright (C) 2003, 2005 Peter Palfrader <peter@palfrader.org>
+
+=pod
+
+=head1 NAME
+
+expire-baks  --  expire backup files
+
+=head1 SYNOPSIS
+
+=over
+
+=item B<expire-baks> [B<--help>]
+
+=item B<expire-baks> [B<--version>]
+
+=item B<expire-baks> [B<--verbose>] B<--dir=>I<directory> [B<--now=>I<unix timestamp>]
+
+=back
+
+=head1 DESCRIPTION
+
+B<expire-baks> expires backup files in the directory named I<directory> of the
+format I<yyyymmdd>B<->I<hhmmss>B<-something.gz> where I<yyyymmdd> and I<hhmmss>
+are the date and time respectively of a backup file.
+
+The script uses a scheme that keeps more of the more recent files while keeping less and
+less of them as they get old.  The rules are currently built in, but if need arises it
+should be simple to move them to a config file or similar.
+
+The current scheme holds one file a day for 2 weeks, then one a week for 2
+months, 4 weeks for 2 years and one every 12 weeks for 10 years.  Everything
+older than that doesn't exist anyway and if it does it gets expires too.
+
+=head1 OPTIONS
+
+=over
+
+=item B<--help>
+
+Print a short help and exit sucessfully.
+
+=item B<--now>
+
+Change the script's idea of the current time.
+
+=item B<--verbose>
+
+Verbose mode. Causes B<expire-baks> to print debugging messages about its
+progress.
+
+=item B<--version>
+
+Print version number and exit sucessfully.
+
+=back
+
+=head1 AUTHOR
+
+Peter Palfrader E<lt>peter@palfrader.org<gt>
+
+=head1 BUGS
+
+=over
+
+=item Files older than the longest rule (10 years) get ignored.
+
+=back
+
+Please report new bugs to the author.
+
+=cut
+
+use strict;
+use English;
+use Getopt::Long;
+use Time::ParseDate;
+
+my %RULES = (
+	'2 weeks'	=> '1 day',	# For 2 weeks keep one a day
+	'2 months'	=> '1 week',	# For 2 months keep one a week
+	'2 years'	=> '4 weeks',	# For 2 years keep one every 4 weeks
+	'10 years'	=> '12 weeks'	# For 10 years keep one every 12 weeks
+);
+
+my $NOW = time;
+my $VERSION = '0.2';
+my $SKEW = 3600;
+my $VERBOSE = 0;
+
+sub parserules(%) {
+	my (%rulesin) = @_;
+
+	my %rulesout;
+	for my $how_long (keys %rulesin) {
+		my $how_long_t = parsedate($how_long, NOW  => 1) or
+			die ("Cannot pase key '$how_long' in rules.\n");
+		$how_long_t -= 1;
+
+		my $keep = parsedate($rulesin{$how_long}, NOW  => 1) or
+			die ("Cannot pase value of '$how_long' '$rulesin{$how_long}' in rules.\n");
+		$keep -= 1;
+
+		$rulesout{$how_long_t} = $keep;
+	}
+	return %rulesout;
+};
+
+sub getfiles($) {
+	my ($dir) = @_;
+
+	opendir(DIR, $dir) or die ("Cannot open dir $dir: $!.\n");
+	my @files = grep { ! /^\./ } readdir(DIR);
+	closedir(DIR);
+
+	my %files;
+	for my $file (@files) {
+		next if $file =~ /^MD5-/;
+		my ($date, $time, $facility) = $file =~ /^(\d{8})-(\d{6})-(.*)$/;
+		(defined $date && defined $time && defined $facility) or
+			warn ("Cannot parse '$file'.\n"),
+			next;
+
+		$date =~ s/^(\d{4})(\d{2})(\d{2})$/$1-$2-$3/ or
+			warn ("Cannot parse date '$date' of file '$file'."),
+			next;
+
+		my $timestamp = parsedate($date." ".$time);
+		defined $timestamp or
+			warn ("Cannot parse timestamp file '$file'."),
+			next;
+
+		die ("how come I already have this timestamp in this facility? file: '$file'.\n") if
+			defined $files{$facility}->{$timestamp};
+
+		$files{$facility}->{$timestamp} = $file;
+	}
+	return %files;
+}
+
+sub doexpire($$$) {
+	my ($dir, $files, $rules) = @_;
+
+	for my $facility (keys %$files) {
+		print "***\nFACILITY $facility\n" if $VERBOSE;
+		my @keep = sort { - ($a <=> $b) } keys %$rules;
+		my @timestamps = sort { $a <=> $b } keys %{$files->{$facility}};
+
+		my @expire;
+		my $last = undef;
+		while (@timestamps && @keep) {
+			my $timestamp = shift @timestamps;
+			my $age = $NOW - $timestamp;
+
+			while ((scalar @keep >= 2) &&
+			       ($age < $keep[1])) {	# find the right rules key
+				shift @keep;
+				print "Moving to next rule $keep[0]; keep files for $rules->{$keep[0]}\n" if (defined $keep[0] && $VERBOSE);
+			};
+
+			my $howoften = $rules->{$keep[0]};
+
+			if (defined $last &&
+			    ($timestamp - $last < $howoften - $SKEW)) {	# if the difference between the 
+				push @expire, $timestamp;		# last we kept and this one is too
+									# small, then expire.
+				print "Expire file at $timestamp (".(scalar localtime $timestamp).")\n" if $VERBOSE;
+			} else {
+				$last = $timestamp;		# else keep it and set last to this one.
+				print "Keep file at $timestamp (".(scalar localtime $timestamp).")\n" if $VERBOSE;
+			};
+		}
+
+		for my $timestamp (@expire) {
+			my $filename = $files->{$facility}->{$timestamp};
+			print "Removing $filename\n" if $VERBOSE;
+			unlink ($dir.'/'.$filename) or warn ("Cannot unlink $dir/$filename: $!.\n");
+		};
+	}
+
+};
+
+
+my $HELP = 0;
+my $PRINTVERSION = 0;
+my $DIRECTORY;
+
+my $USAGE = "Usage: $PROGRAM_NAME [--help] | [--version] | [--verbose] --dir=<directory> [--now=<unix timestamp>]\n";
+Getopt::Long::config('bundling');
+GetOptions (
+        '--help' => \$HELP,
+        '--verbose+' => \$VERBOSE,
+        '--version' => \$PRINTVERSION,
+        '--dir=s' => \$DIRECTORY,
+	'--now=s' => \$NOW,
+) or
+        die ($USAGE);
+$HELP and
+        print $USAGE,
+        exit(0);
+$PRINTVERSION and
+        print "$PROGRAM_NAME version $VERSION",
+        exit(0);
+(defined $DIRECTORY) or
+        die ($USAGE);
+
+my %rules = parserules(%RULES);
+my %files = getfiles($DIRECTORY);
+doexpire($DIRECTORY, \%files, \%rules);
+