cleanup_offload_cache.pl

#!/usr/bin/perl -w

use warnings;
use strict;

# unbuffered output.
$| = 1;

require LWP;
require LWP::UserAgent;
require HTTP::Status;
require HTTP::Date;
my $ua = new LWP::UserAgent;  # we create a global UserAgent object
$ua->env_proxy;

sub dumpHttpHeads {
    foreach (@_) {
        my $url = $_;
        my $request = HTTP::Request->new(HEAD => $url);
        my $response = $ua->request($request);
        if ($response->is_error()) {
            print("HEAD request to $url failed.\n");
        } else {
            print("$url:\n");
            my @keys = $response->header_field_names();
            foreach (@keys) {
                print("  $_: " . $response->header($_) . "\n");
            }
            print("\n\n");
        }
    }
}


sub loadMetadata {
    my $fname = shift;
    return undef if not open(FH, '<', $fname);
    my %retval;
    while (not eof(FH)) {
        my $key = <FH>;
        my $val = <FH>;
        chomp($key) if (defined $key);
        chomp($val) if (defined $val);
        #print("'$key' == '$val'\n");
        $retval{$key} = $val;
    }
    close(FH);

    if (not defined $retval{'X-Offload-Hostname'}) {
        $retval{'X-Offload-Hostname'} = 'icculus.org';
    }
    return(%retval);
}

sub usage {
    die("USAGE: $0 <offloaddir> [--outputurls] [--nukeshortfiles] [--youngerthan=X]\n")
}

my $youngerthan = undef;
my $nukeshortfiles = 0;
my $outputurls = 0;
my $offloaddir = undef;
foreach (@ARGV) {
    $nukeshortfiles = 1, next if ($_ eq '--nukeshortfiles');
    $outputurls = 1, next if ($_ eq '--outputurls');
    $youngerthan = $1, next if (/\A--youngerthan=(\d+)\Z/);
    $offloaddir = $_, next if not defined $offloaddir;
    usage();
}

usage() if (not defined $offloaddir);

opendir(DIRH, $offloaddir) || die("Couldn't open directory [$offloaddir]: $!");

my $diskrecovered = 0;
my $headrequests = 0;
my $filesseen = 0;
my $filesdelete = 0;
my $totalfilespace = 0;

print("\n");
print("mod_offload cleanup script starting up...\n");
if (defined $youngerthan) {
    print("Only checking files younger than $youngerthan days.\n");
    $youngerthan *= 24 * 60 * 60;  # convert days to seconds.
} else {
    print("Checking all files.\n");
}

while (my $f = readdir(DIRH)) {
    # '7' is the file size info in stat().
    # '9' is the mtime info in stat().
    my $filespace = 0;

    $filesseen++;

    if ($f =~ /\Adebug-/) {
        print(" - Deleting debug file '$f'.\n");
        my @statbuf = (stat($f));
        my $size = 0;
        $size = $statbuf[7] if @statbuf;
        $diskrecovered += $size;
        $totalfilespace += $size;
        $filesdelete++;
        unlink("$offloaddir/$f");
    }

    next if (not $f =~ /\A(meta|file)data-/);
    my ($filetype, $etag) = ($f =~ /\A(meta|file)data-(.*)\Z/);
    my $metadatapath = $offloaddir . '/metadata-' . $etag;
    my $filedatapath = $offloaddir . '/filedata-' . $etag;

    my $filecachesize = (stat($filedatapath))[7];

    my @metastat = stat($metadatapath);
    my $filecachemtime = $metastat[9];

    $filespace += $metastat[7] if (-f $metadatapath);
    $filespace += $filecachesize if (-f $filedatapath);

    $totalfilespace += $filespace;

    if ((not -f $filedatapath) || (not -f $metadatapath)) {
        unlink $metadatapath;
        unlink $filedatapath;
        $filesdelete++;
        $diskrecovered += $filespace;
        next;
    }

    next if ($filetype eq 'file');
    next if ((defined $youngerthan) && ((time()-$metastat[9]) > $youngerthan));

    my %metadata = loadMetadata($metadatapath);
    next if (not %metadata);

    my $tmp = $metadata{'ETag'};
    $tmp = '"BOGUSSTRING"' if (not defined $tmp);
    $tmp =~ s/\A\"(.*?)\"\Z/$1/;
    if ($tmp ne $etag) {
        print("File '$metadatapath' is bogus.\n");
        $diskrecovered += $filespace;
        unlink $metadatapath;
        unlink $filedatapath;
        $filesdelete++;
        next;
    }

    my $len = $metadata{'Content-Length'};
    my $hostname = $metadata{'X-Offload-Hostname'};
    my $origurl = $metadata{'X-Offload-Orig-URL'};
    my $url = 'http://' . $hostname . $origurl;

    if ($outputurls) {
        print "$url\n";
        next;
    }

    $headrequests++;
    my $request = HTTP::Request->new(HEAD => $url);
    my $response = $ua->request($request);

    print(" - $url ($etag) ... ");

    my $dokill = 0;
    my $httpcode = $response->code();
    if ($httpcode == 404) {
        print("is no longer on base server.");
        $dokill = 1;
    } elsif ($response->is_error()) {
        # everything else we ignore for now.
        print("status unknown (HTTP error $httpcode).");
    } elsif (($nukeshortfiles) && ($len != $filecachesize)) {
        $dokill = 1;
        print("Cached file is wrong size.");
    } else {
        my $hetag = $response->header('ETag');
        $hetag = '' if (not defined $hetag);
        $dokill = 1 if ($hetag ne "\"$etag\"");
        # !!! FIXME: check other attributes...
        print("out of date in some way.") if ($dokill);
    }

    if ($dokill) {
        print("  DELETE!\n");
        $diskrecovered += $filespace;
        unlink $metadatapath;
        unlink $filedatapath;
        $filesdelete++;
    } else {
        print("KEEP!\n");
    }
}

closedir(DIRH);

if (not $outputurls) {
    print("Recovered $diskrecovered bytes of $totalfilespace.\n");
    print("$filesseen files seen, $filesdelete deleted.\n");
    print("$headrequests HTTP HEAD requests.\n");
}

exit 0;