#!/usr/bin/perl -w
#
# $Id: scacot.pl,v 1.1 1997/08/13 20:52:43 cord Exp cord $ 
#
#
# scacot.pl - Squid CAche COnversion Tool
# Copyright (C) 1997  Cord Beermann
#
# URL: http://Cord.de/tools/squid/
#
# AUTHOR: Cord Beermann (cord@Wunder-Nett.org)
#
# This script is based on
#    upgrade-1.0-store.pl by Duane Wessels (wessels@nlanr.net) and
#    migrate_squid_cache.pl by Ralf Rudolph (ralf@artifex.de)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# 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
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# A Perl script is "correct" if it gets the job done before your boss fires
# you.
# ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen
#   & Randal. L. Schwartz)
#
#
# Bugs and shortcomings
# * It is slow. While copying the file to another location you have to switch
#    of Squid, so for this time no Proxy-Service will be available. (The
#    Conversion could take many hours!)
#
# Todo
# * use strict;
#
# Instructions:
############################################################################# 
#
# set this to YOUR Default 
#$SQUID = "/usr/local/squid";
$SQUID = "/var/proxy/www/squid";
#
#############################################################################

use Getopt::Std;
use File::Copy;
use File::Path;

getopts('mdh');

local $opt_h;

# print usage statement if not a correct input is given

$USAGE="$0 " . '$Revision: 1.1 $' . " , Copyright (C) 1997 Cord Beermann
$0 comes with ABSOLUTELY NO WARRANTY. It is free software, and you are
welcome to redistribute it under certain conditions. See source for details.

Usage: $0 [-md] old_squid.conf new_squid.conf\n
-m: move  (this will remove your old cache)
-d: debug (tell what $0 will do, but don't touch the data)
-h: help  (prints out this message)

It is strongly recommended to test the conversion first with the
'-d'-option!\n\n";

die $USAGE if ($opt_h);

die $USAGE unless ($#ARGV > -1);

foreach (@ARGV) {
    if (defined $NEW_CONF) {
	die $USAGE;
    } elsif (defined $OLD_CONF) {
	$NEW_CONF = $_;
    } else {
	$OLD_CONF = $_;	
    }
}
die $USAGE unless (defined $NEW_CONF and defined $OLD_CONF);

if ($opt_d) {
    print "old squid.conf: $OLD_CONF\nnew squid.conf: $NEW_CONF\n";
}

# get data from the config-files
($old_swap_log, $old_swap_level1_dirs, $old_swap_level2_dirs, @old_dir) =
    read_squidconf($OLD_CONF);
($new_swap_log, $new_swap_level1_dirs, $new_swap_level2_dirs, @new_dir) =
    read_squidconf($NEW_CONF);

# make new directories
foreach $c (@new_dir) {
    $cn = "$c";
    my_mkdir ($cn);
    foreach $d1 (0..($new_swap_level1_dirs-1)) {
	$p1 = sprintf ("$cn/%02X", $d1);
	my_mkdir ($p1);
	foreach $d2 (0..($new_swap_level2_dirs-1)) {
	    $p2 = sprintf ("$p1/%02X", $d2);
	    my_mkdir ($p2);
	}
    }
}

open (OLD_CACHE_LOG, "$old_swap_log") ||
    die("$0: open $old_swap_log: $!\n");

unless ($opt_d) {
    open (NEW_CACHE_LOG, ">$new_swap_log") ||
	die("$0: open $new_swap_log: $!\n");
} else {
    print "open $new_swap_log for writing\n";
}

$goodcount = 0;
$totalcount = 0;
while (<OLD_CACHE_LOG>) {
    $totalcount++;
    chop;
    ($cache_file, $cache_timestamp, $cache_expires, $cache_lastmodified,
     $cache_size, $cache_url) = split;
    $old_object = cachefile_to_object($cache_file, $old_swap_level1_dirs,
				      $old_swap_level2_dirs, @old_dir);
    $new_object = cachefile_to_object($cache_file, $new_swap_level1_dirs,
				      $new_swap_level2_dirs, @new_dir);
    unless (@S = stat($old_object)) {
	print "skipped $old_object: $!\n";
	next;
    }
    unless ($S[7] == $cache_size) {
	print "skipped $old_object: File size mismatch\n";
	next;
    }
    if ($opt_m) {
	next unless my_move($old_object,$new_object);
    } else {
	next unless my_copy($old_object,$new_object);
    }
    unless ($opt_d) {
	print NEW_CACHE_LOG ("$cache_file $cache_timestamp $cache_expires $cache_lastmodified $cache_size $cache_url\n");
    }
    $goodcount++;
}
close(OLD_CACHE_LOG);
close(NEW_CACHE_LOG);

if ($opt_m) {
    print "\n\n",$goodcount," of ",$totalcount," files moved.\n";
    unless ($opt_d) {
	rmtree ([@old_dir],0 ,1);
    } else {
	print "rm -rf @old_dir\n";
    }
} else {
    print "\n\n",$goodcount," of ",$totalcount," files copied.\n";
}
    
exit(0);

sub my_copy {
    my ($f,$t) = @_;
    if ($f eq $t) {
	warn("$0: copying $f to itself - skipping\n");
    } elsif ($opt_d) {
	print "cp $f $t\n";
    } else {
	copy($f,$t) or warn("$0: cp $f,$t: $!\n");
    }
}

sub my_move {
    my ($f,$t) = @_;
    if ($f eq $t) {
	warn("$0: moving $f to itself - skipping\n");
    } elsif ($opt_d) {
	print "mv $f $t\n";
    } else {
	copy($f,$t) or warn("$0: cp $f,$t: $!\n");
	unlink($f) or warn("$0: rm $f: $!\n");
    }
}

sub read_squidconf {
    my $SQUIDCONF = $_[0];
    # initialize variables
    # SQUID-Default settings
    my @cache_dir;
    my $cache_dir = ("$SQUID/cache");
    my $cache_swap_log;
    my $swap_level1_dirs = "16";
    my $swap_level2_dirs = "256";

    # Read the squid.conf
    open (SQUIDCONF, "$SQUIDCONF") || die("$0: open $SQUIDCONF: $!");
    while (<SQUIDCONF>) {
	if (/^\s*#/) {
	    next;
	} elsif (s/\s*cache_dir\s+//) {
	    chop;
	    push @cache_dir, $_;
	} elsif (s/\s*cache_swap_log\s+//) {
	    chop($cache_swap_log = $_);
	} elsif (s/\s*swap_level1_dirs\s+//) {
	    chop($swap_level1_dirs = $_);
	} elsif (s/\s*swap_level2_dirs\s+//) {
	    chop($swap_level2_dirs = $_);
	}
    }
    unless (defined @cache_dir) {
	print "WARNING! No cache_dir-directive found.\nUsing $cache_dir.\n";
	@cache_dir = ("$cache_dir");
    }
    if ($swap_level1_dirs > 256) {
	print "WARNING! swap_level1_dirs in $SQUIDCONF is greater than 256.\nStopping.\n";
	exit(1);
    }
    if ($swap_level2_dirs > 256) {
	print "WARNING! swap_level2_dirs in $SQUIDCONF is greater than 256.\nStopping.\n";
	exit(1);
    }
    $cache_swap_log = $cache_dir[0] . '/log' unless defined $cache_swap_log;
    # Debug
    if ($opt_d) {
	print "cache_dir: @cache_dir\n";
	print "cache_log: $cache_swap_log\n";
	print "cache_L1 : $swap_level1_dirs\n";
	print "cache_L2 : $swap_level2_dirs\n";
    }
    return($cache_swap_log,$swap_level1_dirs,$swap_level2_dirs,@cache_dir);
}

sub my_mkdir {
    my $p = $_[0];
    if ($opt_d) {
	print "mkdir $p\n";
    } else {
	mkpath ($p, 0, 0755) or die("$0:mkdir $p: $!\n");
    }
}

sub cachefile_to_object {
    my $cachefile = hex(shift(@_));
    my $swaplevel1dirs = shift(@_);
    my $swaplevel2dirs = shift(@_);
    my @cachedir = @_;
    return sprintf ("%s/%02X/%02X/%08X",
		    $cachedir[$cachefile % ($#cachedir + 1)],
		    ($cachefile / ($#cachedir + 1)) % $swaplevel1dirs,
		    (($cachefile / ($#cachedir + 1)) / $swaplevel1dirs) % $swaplevel2dirs,
		    $cachefile,
		    );
}