From 0a327c96c08fc5c146f17021a787aadce39c9f19 Mon Sep 17 00:00:00 2001 From: Peter Palfrader Date: Fri, 2 Sep 2005 00:21:32 +0000 Subject: Add some stuff git-svn-id: svn+ssh://asteria.noreply.org/svn/weaselutils/trunk@2 bc3d92e2-beff-0310-a7cd-cc87d7ac0ede --- expire-baks | 214 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 214 insertions(+) create mode 100755 expire-baks (limited to 'expire-baks') 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 + +=pod + +=head1 NAME + +expire-baks -- expire backup files + +=head1 SYNOPSIS + +=over + +=item B [B<--help>] + +=item B [B<--version>] + +=item B [B<--verbose>] B<--dir=>I [B<--now=>I] + +=back + +=head1 DESCRIPTION + +B expires backup files in the directory named I of the +format IB<->IB<-something.gz> where I and I +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 to print debugging messages about its +progress. + +=item B<--version> + +Print version number and exit sucessfully. + +=back + +=head1 AUTHOR + +Peter Palfrader Epeter@palfrader.org + +=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= [--now=]\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); + -- cgit v1.2.3