#!/usr/bin/perl -w

# Make a list of URLs in the cache and their corresponding
# cache filenames

use File::Find ();
use Digest::SHA1 qw/sha1_hex/;

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

sub wanted;

sub usage {
    print <<EOH;
    usage: $0 [url1 [url2 [...]]]
EOH
    exit 1;
}

# GM can store without ports, A-REX always uses ports
# so check with default port no if none given
my %ports = (
    'rc'    => '389',
    'rls'   => '39281',
    'http'  => '80',
    'https' => '443',
    'httpg' => '8443',
    'srm'   => '8443',
    'ldap'  => '389',
    'ftp'   => '21',
    'gsiftp'=> '2811',
    'lfc'   => '5010'
    );

my @files;

if (@ARGV > 0) {
    if ($ARGV[0] eq '-h') { usage(); }
    # for each file add default port if necessary
    foreach $file (@ARGV) {
	push (@files, $file);
	next if $file !~ m|(\w+)://(\S+?)/\S*|;
	next if ! defined( $ports{$1} );
	$protocol = $1;
	$host = $2;
	next if index($host, ':') != -1;
	# no port so try the default
	$file =~ s|$host|$host:$ports{$protocol}|;
	push (@files, $file);
    }
}

# find conf file and get cache dir
my $conffile = $ENV{"ARC_CONFIG"};
if (!$conffile || ! -e $conffile) {
    $conffile = '/etc/arc.conf';    
}

die "Conf file not found. Use ARC_CONFIG to give non-standard location" if ! -e $conffile;

# parse to find cache dirs
my @caches;
open FILE, $conffile or die $!;
while (<FILE>) {
    if (/^cachedir=/) {
        if (/%/) {print "\n Warning: cache-list cannot deal with substitutions - $_\n";}
        elsif (m!^cachedir="(/\S*)\s(/\S*)"! || m!^cachedir="(/\S*)"! || m!^cachedir=(/\S*)!) {push(@caches, $1);}
    }
}

close FILE;

die "No caches found in config file $conffile" if @caches==0;

# list all files
if (@files == 0) {
    foreach $cache (@caches) {
	print "Cache: $cache\n";
	if (! -d $cache) { print " Cache is empty\n"; }
	else { File::Find::find({wanted => \&wanted}, $cache."/data"); }
    }
}
# list files given as arguments
else {
    foreach $file (@files) {
	$hash = sha1_hex($file);
	if (length($hash) != 40) {
	    print "Error in hash calculation for file $file\n";
	    next;
	}
	# look for this file in the caches
	foreach $cache (@caches) {
	    $cachefile = $cache.'/data/'.substr($hash, 0, 2).'/'.substr($hash, 2);
	    if (-e $cachefile) {
		print " $file $cachefile";
		print ' (locked)' if -e "$cachefile.lock";
		print "\n";
	    }
	}
    }
}


sub wanted {
    return if $name !~ m|\.meta$|;
    return if ! -e substr($name, 0, -5);
    open FILE, $name or die "$name $!";
    my $line = <FILE>;
    my @data = split(/\s+/, $line);
    my $fname = substr($name, 0, rindex($name, ".meta"));
    print " $data[0] $fname\n";
}
