#!/usr/bin/perl -w

#\section{The Mirror Script}

#tex \copyright\ Copyright 1998 by Chris Traxler $<$christoph.t.traxler@theo.physik.uni-giessen.de$>$.
# The GNU general public license applies.

##############################################################################
# You are permitted to use and alter this file under the terms of the GNU GPL.
# If you alter this file (improve the program), I kindly ask you to send 
# a copy to me at christoph.t.traxler@theo.physik.uni-giessen.de.
# You can retrieve a copy of the precise license terms at the URL
# ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0
#-----------------------------------------------------------------------------
# This script can be retrieved from
# ftp://krabat.physik.uni-giessen.de/pub/traxler/
##############################################################################

# A somehwhat complex hack that takes care of the daily automatic backups on my computers.
# Should reprogram this some day in a more structured manner, but for now it is ok.
# An example config file may be found after the end of the script (after __END__).

use strict;
use English;
use Getopt::Long;

#\subsection{Command-Line Parsing}

my $version='$Id: mirror,v 1.11 1998/05/03 20:59:06 cvstraxler Exp $';
$version =~ s/^.*mirror,v ([0-9.\/ ]*) ..:..:.. cvs.*$/$1/;

# I hate German and English mixed up in the output
$ENV{LANG}="C";

# User/host names
my $user=`whoami`;
my $host=`hostname -s`;
my $date=`date +\%x`;
my $datetime=`date +\"\%B \%d \%T\"`;
chomp($user); chomp($host); chomp($date); chomp($datetime);

# Options
my %option =
   (
     configfile => "$ENV{HOME}/.mirrorrc",
     force      => 0,
     maxlevel   => -1,
     version    => 0
   );

# prepend MIRROR environment variable to command line
unshift(@ARGV, split(' ', $ENV{MIRROR})) if(exists $ENV{MIRROR});

Getopt::Long::config('pass_through');
&GetOptions(\%option, 'configfile=s', 'maxlevel=i', 'force', 'version');

$option{force}=1 if($option{maxlevel}>=0);

# configuration hash. An example configuration is appended to this program text
# The following is a preconfiguration of those entries that have sensible default values.
# On itself, the following is not a complete configuration.
my %config =
   (
     # Must be root to do this backup?
     must_be_root => "no",

     # tool setup
     tar => "tar",
     compressopt => "--gzip",
     extension => "tgz",
     debug => "no",

     # email setup
     email => "$user\@$host", # email addresses for notification
     emergency_cc => "$user\@$host"  
   );

# Read config file
my $configfile=$option{configfile};
if(! -f $configfile || $option{version})
{
    if(!$option{version} && @ARGV && -f $ARGV[0])
    {
	print "You are using the old calling syntax $0 $ARGV[0].\n";
	print "The new one is $0 --configfile $ARGV[0].\n";
	exit 1;
    }

    print <<EOF;
mirror rev $version. To receive help, type 'perldoc $0' 
Copyright 1998 by Chris Traxler <christoph.t.traxler\@theo.physik.uni-giessen.de>.
EOF

    print "Configuration file $configfile not found!\n" unless($option{version});
    exit 1;
}
eval `cat $configfile`;

# Add command line config options
&GetOptions(\%config, 'debug!');

# debug mode?
my $debug = ($config{debug} && $config{debug}!~/^no$/i);

$option{force}=1 if($debug);

# is the snapshotdir defined and reachable
if(! exists $config{snapshotdir}
   || ! -d $config{snapshotdir}
   || ! -W $config{snapshotdir}
   || ! -R $config{snapshotdir}
   || ! exists $config{basename})
{
    print "A configuration file must specify an existing and R/W enabled\n";
    print "snapshot directory in \$config{snapshotdir}\n";
    print "and a basename for the snapshots and auxiliary files in \$config{basename}.\n";
    print "The configuration hash \%config as specified by $configfile\n";
    die "is incomplete or incorrect.\n";
}

# set up file names
my $basename="$config{snapshotdir}/$config{basename}";
my $statusfile="$basename\.status";
my $lockfile="$basename\.lock";

# set up messaging
my $messagefile="$basename\.messages";
my $emailsubject="";
my $errs=0;
system("rm -f $messagefile");

sub printmsg
{
    if($messagefile)
    {
	open(MSG, ">>$messagefile");
	print MSG @_;
	close(MSG);
    }
    else
    {
	print @_;
    }
}

sub sysmsg
{
    if($debug)
    {
	printmsg "\t(Executing ".$_[0].")\n";
	return "";
    }
    my $output=`$_[0] 2>&1`;
    printmsg $output;
    return $output;
}

# check configuration thoroughly
checkconfig();

# Test: Do we have to be and are we root?
if($config{must_be_root}=~/^yes$/i && $EUID!="0")
{
    print "Your user name is $user.\n";
    print "This configuration requires root access.\n";
    exit(1);
}

# cd to root directory
my $oldpwd = `pwd`;
chomp($oldpwd);
chdir("/");

# read status file written on the last run of mirror
# preset status hash with sensible info
my %status;
clearstatus();
eval `cat $statusfile` if(-f $statusfile);

my $restart_after_notification=0;
if($status{restart_after_notification}!~/^no$/i)
{
    $restart_after_notification=$status{restart_after_notification};
}

# Is the last completed backup of this configuration dated from today?
# If yes, don't backup again. It's not worth the trouble.
if(!$restart_after_notification && !$option{force} && $status{last_backup_date} eq $date)
{
    print "Last successful backup dated from today.\n";
    exit(0);
}

# Prevent racing condition: Is another copy of this script running?
# If yes, the lock file contains its PID, and there should be an entry
# in the process table with that PID and the name of this script.
# If this is the case, bail out.
if(-f $lockfile)
{
    print "Hmm, a lock file exists. Is another copy of $0 running?\n";
    my $otherpid=`cat $lockfile`;
    chomp($otherpid);
    my $race=`ps x | grep $0 | grep $otherpid | grep -v grep`;
    chomp($race);

    # If $RACE is empty, the lock file is a stale one and can be removed.
    unless($race)
    {
        # message handling / debug mode helper
	printmsg "$datetime $host: $0 called.\n";
	printmsg "Removing stale lock file.\n";
	print "No $0 with PID $otherpid found, removing stale lock file.\n";
    }
    else
    {
	printmsg $race."\n";
	printmsg "This seems to be a racing condition. Bailing out.\n";
	emailandquit(1);
    }
}
else
{
    # no lock file existent
    printmsg "$datetime $host: $0 called.\n";
}

# Create a lock file with our PID
open(LOCKFILE, ">$lockfile");
print LOCKFILE "$PID\n";
close(LOCKFILE);

# Issue message on how long the last backup was ago...
if(!$restart_after_notification
   && $status{last_backup_date} 
   && $status{last_backup_date} ne "never")
{
    printmsg "Last successful backup dated from $status{last_backup_date}.\n";
}

# Check whether the backup levels are all present and correctly time-ordered
my $level=0;
my $backuptype=0;
my $baselevel=0;
my $basesnapshot="";
my $snapshot="";
my $age=1000;
my @backupchain;

# The %count hash will replace the %status{count} hash, and the 
# %lastwritten hash the $status{lastwritten}.
# Unless this run leads only to an email notification, the counting will be later 
# stored as status{count} again.
my %count;
my %lastwritten;
for (0..$config{levels}-1)
{
    $count{$_}=$status{count}{$_};
    $lastwritten{$_}=$status{lastwritten}{$_};
}

# ensure the base snapshots are all there, the dates are ascending,
# the maximal base level is thus predetermined
my $maxlevel=$config{levels}-1;
$maxlevel=$option{maxlevel} if($option{maxlevel}>=0 && $maxlevel>$option{maxlevel});
for(; $level<$maxlevel; $level++)
{
    next if($level>0 && $count{$level}==0);

    $basesnapshot=$snapshot;
    my $baseage=$age;
    
    $snapshot="$basename\_level_$level\_no_$count{$level}\.snapshot";
    $age=-1;
    $age=(-M $snapshot) if(-f $snapshot);

    last if(! -f $snapshot || $age>=$baseage);

    $baselevel=$level;
    push(@backupchain, $level);
}

# determine final count status, backup level and backup number. 
# Determine also an estimated size of this backup.
my $digit;
my $estimatedsize=0;
for($digit=$config{levels}-1; $digit>$level; $digit--)
{
    $estimatedsize+=$lastwritten{$digit};
    $count{$digit}=0;
    $lastwritten{$digit}=0;
}

# Count one backup up. 
# Overflow to next lower backup level if 
# (a) max. number of backups of this level is reached
# (b) the last backup written was larger than some last backup of lower level written 
for($digit=$level; $digit>=0; $digit--)
{
    $count{$digit}++;
    pop(@backupchain) if(@backupchain && $backupchain[-1]==$digit);

    # is there an overflow, i.e. a lower-level backup whose size is smaller than the anticipated size
    # of this backup?
    $estimatedsize+=$lastwritten{$digit};
    my $overflow=0;
    my $digit1;
    for($digit1=$digit-1; $digit1>=0; $digit1--)
    {
	if($count{$digit1} && $estimatedsize>$lastwritten{$digit1})
	{
	    $overflow=1;
	    last;
	}
    }

    # also an overflow if maximal count of this level is reached
    last if($count{$digit}<=$config{maxcount}{$digit} && !$overflow);
    $count{$digit}=0;
    $lastwritten{$digit}=0;
}

# complete backup cycle done?
if($digit<0)
{
    $count{0}=1;
    $digit=0;
}

$level=$digit;
$backuptype=$config{backuptype}{$level};
push(@backupchain, $level);

# special care has to be taken if this is the restart after a user notification
if($restart_after_notification)
{
    if($level != $status{$restart_after_notification}{notifylevel})
    {
	printmsg "Strange... notification level is different from determined level.\n";
	printmsg "This is an internal error!\n";
	$level = $status{$restart_after_notification}{notifylevel};
    }
    $backuptype=$config{$restart_after_notification}{restart};
    $status{restart_after_notification}="no";
}

# determine base level and snapshot names
$baselevel=$backupchain[-2] if($level>0);
$baselevel=0 if($level==0);
$basesnapshot="$basename\_level_$baselevel\_no_$count{$baselevel}\.snapshot";
$snapshot="$basename\_level_$level\_no_$count{$level}\.snapshot";

# set up text for later messaging
my $backupkind="incremental backup no $count{$level} of level $level";
$backupkind="a full backup" unless $level;

# this a notification?
my $send_notification=0;

# tar command
my $tar=$config{tar};

my $tarmsg="";
if($backuptype=~/harddisk/i)
{
    my $backupname="$config{$backuptype}{path}/$config{basename}\_level_$level\_no_$count{$level}"
                   ."\.$config{extension}";
	
    printmsg "Creating ".$backupkind." in $backupname\n";
    printmsg "\tby comparison with $basesnapshot.\n" if $level;

    $emailsubject = "Backup (Level $level) on $backupname.";
    
    # harddisk backup	
    sysmsg("rm -f $snapshot\.active");
    sysmsg("cp $basesnapshot $snapshot\.active") if($level);

    $tarmsg=sysmsg("$tar --create $config{compressopt} --one-file-system --totals "
		   ."--file=$backupname\.active "
		   ."--listed-incremental=$snapshot\.active "
		   ."--files-from=$config{includelist} "
		   ."--exclude-from=$config{excludelist}");
    
    sysmsg("mv $backupname\.active $backupname");
    system("touch $snapshot") if($debug);
}
elsif($backuptype=~/remote/i)
{
    my $remoteuser;
    my $remotehost;
    my $remotepath;

    if($config{$backuptype}{path}=~/^(.*?)\@(.*?):(.*)$/)
    {
	$remoteuser=$1;
	$remotehost=$2;
	$remotepath=$3;
    }
    else
    {
	printmsg "Backup path $config{$backuptype}{path} is not a valid remote path.\n";
	emailandquit(1);
    }

    my $backupname="$remotepath/$config{basename}\_level_$level\_no_$count{$level}"
                   ."\.$config{extension}";
    
    printmsg "Creating $backupkind in $remoteuser\@$remotehost:$backupname\n";
    printmsg "\tby comparison with $basesnapshot.\n" if $level;
    
    $emailsubject = "Backup (Level $level) on $remoteuser\@$remotehost:$backupname.";
    
    # remote backup	
    sysmsg("rm -f $snapshot\.active");
    sysmsg("cp $basesnapshot $snapshot\.active") if($level);

    sysmsg("($tar --create $config{compressopt} --one-file-system --totals "
	   ."--file=- "
	   ."--listed-incremental=$snapshot\.active "
	   ."--files-from=$config{includelist} "
	   ."--exclude-from=$config{excludelist} 2>>$messagefile) "
	   ."| (rsh 2>>$messagefile $remotehost -l $remoteuser "
	   ."\"cat >$backupname\.active; mv $backupname\.active $backupname\")");

    # read the whole message file in
    my $delim=$/;
    undef $/;
    open(MSG, "<$messagefile");
    $tarmsg=<MSG>;
    close(MSG);
    $/=$delim;

    # filter out the actual tar message, that is, the rest of the message file after our tar command 
    $tarmsg =~ s/.*cat >$backupname\.active; mv $backupname\.active $backupname[^\n]*\n(.*)/$1/s;

    system("touch $snapshot") if($debug);
}
elsif($backuptype=~/tape/i)
{
    my $label="$config{basename}\_level_$level\_no_$count{$level}";

    my $device=$config{$backuptype}{device};
    my $position=$status{$backuptype}{position};

    printmsg "Creating ".$backupkind." on tape $device\n";
    printmsg "\tat file offset $status{$backuptype}{position} from the beginning of the tape\n";
    printmsg "\tby comparison with $basesnapshot.\n" if $level;

    $emailsubject = "Backup (Level $level) on tape $device.";
    
    # tape backup
    sysmsg("rm -f $snapshot\.active");
    sysmsg("cp $basesnapshot $snapshot\.active") if($level);
    sysmsg("mt -f $device stoptions 7");

    if($position)
    {
       sysmsg("mt -f $device asf $position");
    }
    else
    {
       sysmsg("mt -f $device rewind");
    }
	
    # store tape position for bookkeeping
    $status{$backuptype}{old_backup_positions}{$count{$level}}=$status{$backuptype}{position};

    # do the backup. Blocks are (blocking-factor) * (512 Bytes) large.
    $tarmsg=sysmsg("$tar --create $config{compressopt} --label=$label --one-file-system --totals "
		   ."--file=$device --blocking-factor=128 "
		   ."--listed-incremental=$snapshot\.active "
		   ."--files-from=$config{includelist} "
		   ."--exclude-from=$config{excludelist}");

    # rewind tape
    my $mtmsg=`mt -f $device rewind 2>&1`;
    my $mttime=0;
    printmsg("Waiting up to 5 minutes for tape drive to finish writing.\n") if($mtmsg=~/busy/);
    while($mtmsg=~/busy/ && $mttime<10)
    {
	$mtmsg=`mt -f $device rewind 2>&1`;
	sleep(30);
	$mttime++;
    }
    sysmsg("mt -f $device rewind"); # this is to make possible errors visible in the log
    system("touch $snapshot") if($debug);
}
elsif($backuptype=~/notify/i)
{
    $emailsubject="NOTIFICATION: Backup Level $level No $count{$level} is due.";
    printmsg "*****************NOTIFICATION************************************************\n";
    printmsg "Backup Level $level No $count{$level} is due.\n";
    printmsg "You have configured user notification, probably to do a media change.\n";
    printmsg "Please do so and then restart\n";
    printmsg "\t$0 --configfile $configfile ".($option{maxlevel}>=0 ? " --maxlevel $maxlevel" : "")."\n"; 
    printmsg "*****************************************************************************\n";

    $status{restart_after_notification}=$backuptype;
    $status{$backuptype}{notifylevel}=$level;
    $send_notification=1;
}

# Are there any error messages?
open(MSG, "<$messagefile");
my @errors=grep(/error|no space left|busy|timed? ?out|denied/io, <MSG>);
close(MSG);

# filter out the verbose output of tar (known "blah-blah")
@errors=grep(!/tar: (File.*shrunk*|cannot (add file|stat)|removing leading|error exit delayed)/io, @errors);

# count the errors
$errs += scalar(@errors);

unless($send_notification)
{
    if($errs)
    {
	# unsuccessful backup: delete temp. snapshot file
	sysmsg("rm -f $snapshot\.active");   
    }
    else
    {
        # complete the backup process by validating the new snapshot	
	sysmsg("mv -f $snapshot\.active $snapshot");

	# determine total bytes written
	$tarmsg=~/Total bytes written:\s*([0-9]*)/i;
	$lastwritten{$level}=$1/1000000 if(defined $1); # the harddisk industrys interpretation of MB

	if($debug)
	{
	    print "Enter backup size in MB (debugging mode!)\n";
	    $lastwritten{$level}=<STDIN>;
	    chomp($lastwritten{$level});
	}

	# transfer the %count hash back to status{count} 
	for (0..$config{levels}-1)
	{
	    $status{count}{$_}=$count{$_};
	    $status{lastwritten}{$_}=$lastwritten{$_};
	}

	# For tapes: prevent writing beyond EOT by resetting the position appropriately
	if($backuptype=~/tape/i)
	{
	    # Compute a crude approximation of the space left
	    my $MBytes=$lastwritten{$level};

	    $MBytes/=1.5 if($config{compressopt}); # assume 1.5:1 compression
	    
	    $status{$backuptype}{used}+=$MBytes;
	    
	    printmsg "Assuming a 1.5:1 compression, $status{$backuptype}{used} MB are now used\n"; 
	    printmsg "on this tape ($backuptype).\n";
	    
	    my $spaceleft=0;
	    
	    if(exists $config{$backuptype}{capacity})
	    {
		$spaceleft=($config{$backuptype}{capacity}-$status{$backuptype}{used});
		printmsg "The configured capacity is $config{$backuptype}{capacity} MB,\n";
		printmsg "so there should be $spaceleft MB left.\n";
	    }

	    if($spaceleft<2*$MBytes || $tarmsg=~/I\/O Error/i)
	    {
		$status{$backuptype}{position}=0;
		$status{$backuptype}{used}=0;
	    }
	    else
	    {
		$status{$backuptype}{position}++;
	    }

	    printmsg "Next tape backup of this type ($backuptype) will be written on position"
		    ." $status{$backuptype}{position}.\n";
	}

	# successful backup: make appropriate status entries
	$status{last_backup_date}=$date;
	$status{mostrecent}{$level}=$date;
	
	# print overview of current backup chain
	printbackupchain();
    }
}

# second notification after the backup
if($restart_after_notification && $config{$restart_after_notification}{notify_again}!~/^no$/i)
{
    $emailsubject="NOTIFICATION: Backup Level $level No $count{$level} completed.";
    printmsg "*****************NOTIFICATION***************************************************\n";
    printmsg "Backup Level $level No $count{$level} completed.\n";
    printmsg "You have configured user notification, probably to do a media change.\n";
    printmsg "This email is to remind you to change the media back if necessary.\n";
    printmsg "********************************************************************************\n";
    $send_notification=1;
}

# clean up and done
writestatus($statusfile);
emailandquit(0);

# subroutines used in this script:
# send email
sub emailandquit
{
    if($errs)
    {
	if($send_notification)
	{
	    $emailsubject =~ s/^NOTIFICATION/ERRORS/;
	}
	else
	{
	    $emailsubject = "ERRORS: ".$emailsubject;
	}
    }

    # Send all our messages plus the stderr from the tar command as an email
    # to the sysadmin. We are using the listed-incremental mode of GNU tar
    # for the actual backup. Put together the command
    my $emailcmd = "mail $config{email} -s \"$emailsubject\"";

    if(($send_notification || $errs)
       && (exists $config{emergency_cc} && ($config{emergency_cc} ne $config{email})))
    {
	$emailcmd .= " -c $config{emergency_cc} ";
    }

    if(exists $config{cc} && ($config{cc} ne $config{email}))
    {
	$emailcmd .= " -c $config{cc} ";
    }

    $emailcmd .= " <$messagefile";
    
    unless($debug)
    {
	system($emailcmd);
    }
    else
    {
	print "-----------THIS WOULD BE MY EMAIL COMMAND---------------------------------------\n";
	print $emailcmd."\n";
	print "-----------THIS WOULD BE MY EMAIL-----------------------------------------------\n";
	print `cat $messagefile`;
	print "--------------------------------------------------------------------------------\n";
    }
    
    # clean up
    system("rm -f $lockfile") if(defined $lockfile);
    system("rm -f $basename\*\.active") if(exists $config{snapshotdir});

    # done
    chdir($oldpwd);
    exit($_[0]);
}

# check configuration
sub checkconfig
{
    if(!exists $config{includelist} || !exists $config{excludelist})
    {
	printmsg "The configuration entries \config{includelist} and\n";
	printmsg "\$config{excludelist} must be defined.\n";
	printmsg "The configuration hash \%config as specified by $configfile\n";
	printmsg "is incomplete or incorrect.\n";
	emailandquit(1);
    }       

    my $configentry;
    for $configentry (qw(basename levels maxcount backuptype))
    {
	if(!exists $config{$configentry})
	{
	    printmsg "The configuration entry \$config{$configentry} is not defined\n";
	    printmsg "in $configfile.\n";
	    emailandquit(1);
	}
    }

    my $level;
    for $level (0..$config{levels}-1)
    {
	for $configentry (qw(maxcount backuptype))
	{
	    if(!exists $config{$configentry}{$level})
	    {
		printmsg "The configuration entry \$config{$configentry}{$level} is not defined\n";
		printmsg "in $configfile.\n";
		emailandquit(1);
	    }
	}

	if(!exists $config{$config{backuptype}{$level}})
	{
	    printmsg "The configuration subentry \$config{$config{backuptype}{$level}}\n";
	    printmsg "is not defined in $configfile.\n";
	    emailandquit(1);
	}
    }

    for $configentry (grep(/remote/i, (keys %config)))
    {
	my $subentry;
	for $subentry (qw(path))
	{
	    if(!exists $config{$configentry}{$subentry})
	    {
		printmsg "The configuration subentry \$config{$configentry}{$subentry}\n";
		printmsg "is not defined in $configfile.\n";
		emailandquit(1);
	    }
	}
    }

    for $configentry (grep(/tape/i, (keys %config)))
    {
	my $subentry;
	for $subentry (qw(device))
	{
	    if(!exists $config{$configentry}{$subentry})
	    {
		printmsg "The configuration subentry \$config{$configentry}{$subentry}\n";
		printmsg "is not defined in $configfile.\n";
		emailandquit(1);
	    }
	}
    }

    for $configentry (grep(/harddisk|remote/i, (keys %config)))
    {
	my $subentry;
	for $subentry (qw(path))
	{
	    if(!exists $config{$configentry}{$subentry})
	    {
		printmsg "The configuration subentry \$config{$configentry}{$subentry}\n";
		printmsg "is not defined in $configfile.\n";
		emailandquit(1);
	    }
	}
    }

    for $configentry (grep(/notify/i, (keys %config)))
    {
	my $subentry;
	for $subentry (qw(restart notify_again))
	{
	    if(!exists $config{$configentry}{$subentry})
	    {
		printmsg "The configuration subentry \$config{$configentry}{$subentry}\n";
		printmsg "is not defined in $configfile.\n";
		emailandquit(1);
	    }
	}
    }  
}

# write status file
sub writestatus
{
    my $statusfile=shift;

    open(STATUS, ">$statusfile");

    print STATUS <<EOF;
# This file is read in and automatically re-generated on each run of $0.
# Do not edit.
\%status =
 (
   last_backup_date => \"$status{last_backup_date}\",
   restart_after_notification => \"$status{restart_after_notification}\", 

   count => 
    { 
EOF
    print STATUS "      ";

    my $level;
    for $level (0..$config{levels}-1)
    {
	print STATUS $level." => ".$status{count}{$level}.", ";
    }

    print STATUS <<EOF;

    },

   mostrecent => 
    { 
EOF

    print STATUS "      ";
    for $level (0..$config{levels}-1)
    {
	print STATUS $level." => \"".$status{mostrecent}{$level}."\", ";
    }

    print STATUS <<EOF;

    },

   lastwritten => 
    { 
EOF

    print STATUS "      ";
    for $level (0..$config{levels}-1)
    {
	print STATUS $level." => ".$status{lastwritten}{$level}.", ";
    }

    print STATUS <<EOF;

    },
EOF

    my $tape;
    for $tape (grep(/tape/i, (keys %status)))
    {
	print STATUS <<EOF;

   $tape => 
    {
      used => $status{$tape}{used},        
      position => $status{$tape}{position},
      old_backup_positions => 
      {
EOF

        for (0..$config{levels}-1)
        {
	    print STATUS "       $_ => $status{$tape}{old_backup_positions}{$_},\n"
		if(exists $status{$tape}{old_backup_positions}{$_});
        }

        print STATUS "      }\n";
        print STATUS "    },\n";
    }

    my $notify;     
    for $notify (grep(/notify/i, (keys %status)))
    {
	print STATUS <<EOF;

   $notify => 
    {
      notifylevel => $status{$notify}{notifylevel}
    },
EOF
    }

    print STATUS <<EOF;
 );
EOF
}

# preset status hash with sensible info
sub clearstatus
{
    %status =
     (
       last_backup_date => "never",
       restart_after_notification => "no",   # If yes, points to the relevant entry.
     );

    my $level;
    for $level (0..$config{levels}-1)
    {
	$status{count}{$level}=0;
	$status{lastwritten}{$level}=0;
	$status{mostrecent}{$level}="never";
    }
    
    my $tape;
    for $tape (grep(/tape/i, (keys %config)))
    {
	$status{$tape}{used}=0;
	$status{$tape}{position}=0;
    }

    my $notify;
    for $notify (grep(/notify/i, (keys %config)))
    {
	$status{$notify}{notifylevel}=0;
    }
}

sub printbackupchain
{
    printmsg "________________________________________________________________________________\n";
    printmsg "This is a complete list of the backups needed to restore the current state:\n";

    my $chainlevel;
    for $chainlevel (@backupchain)
    {
	my $chaintype=$config{backuptype}{$chainlevel};
	my $chaincount=$status{count}{$chainlevel};
	my $chainname="";

	if($chaintype=~/notify/i)
	{
	    $chaintype=$config{$chaintype}{restart};
	}

	if($chaintype=~/harddisk/i)
	{
	    printmsg "$status{mostrecent}{$chainlevel}: Level $chainlevel ($chaintype): "
		."$config{$chaintype}{path}/$config{basename}"
		."_level_$chainlevel\_no_$chaincount\.$config{extension}\n"; 
	}

	if($chaintype=~/remote/i)
	{
	    printmsg "$status{mostrecent}{$chainlevel}: Level $chainlevel ($chaintype): "
		."$config{$chaintype}{path}/$config{basename}"
		."_level_$chainlevel\_no_$chaincount\.$config{extension}\n"; 
	}

	if($chaintype=~/tape/i)
	{
	    printmsg "$status{mostrecent}{$chainlevel}: Level $chainlevel ($chaintype): "
		."Tape backup (level $chainlevel, no $chaincount, "
		."tape pos $status{$chaintype}{old_backup_positions}{$chaincount})\n";
	}
    }  
    printmsg "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n";
}

#\subsection{Man page}

=head1 NAME

mirror - Highly Configurable N-Level Automatic Backup Utility

=head1 SYNOPSIS

B<mirror> I<options>

=head1 DESCRIPTION

B<mirror> is usually called daily by a CRON job, and is usually also called on system startup 
(on desktop systems that are shutdown and restarted daily). It then determines what is necessary 
to perform a backup of the desired and configured kind, and performs that backup by calling GNU tar
with appropriate options.

It is common to configure a multilevel backup of the kind "every 16 days a full level-0 backup to 
tape, every 4 days a differential level-1 backup over the network, and daily a differential 
level-2 backup to a local harddisk."

=head1 PREREQUISITES

Necessary tools for using B<mirror> are the GNU version of tar, gzip, a running email setup 
(B<mirror> calls the mail command), and the tape utility mt (if tape backups are configured).
For network backups, rsh needs to be setup and functioning.

=head1 OPTIONS

B<mirror> is highly configurable, mainly through a configuration file. However, it also takes a couple 
of options: 

=over 8

=item -v --version 

prints the version number and exits.

=item -c --configfile <configfile> 

specifies the configuration file. Default is the file .mirrorrc in the caller's home directory.

=item -m --maxlevel <maxlevel> 

sets the maximum level of the backup done. This is useful if, say, you have configured a 3-level backup,
level-2 goes to a harddisk and is due today, but you know there have been so many changes to the system
that the harddisk cannot store this backup. Then, you want to force a backup of level 1, using the option
--maxlevel 1. Implies option --force.

=item -f --force

forces a backup even if the last successful backup has been performed today, in which case B<mirror> 
stops printing a message. 

=back

The following options can be specified both on the command line and in the configuration file.

=over 8

=item -d --debug

Switches to debug mode, in which no real action is performed, only a report is printed. You have to enter
the size of the (fictive) backup in MB so you can track what B<mirror> would do in a certain situation.
Implies --force. This option can be negated (--nodebug) and is off by default.

=back

=head1 ENVIRONMENT

=over 8

=item MIRROR

Default arguments. These are simply prepended to the command line argument on every 
call of B<mirror>.

=back

=head1 CONFIGURATION FILE

B<mirror> is configured by a Perl configuration file with a fairly simple syntax.
The configuration file is expected by default to be ~/.mirrorrc but different names 
can be specified on the command line. 

An example configuration file explaining all the available options is given in the following:

 #! Call this config script as 
 # "mirror --configfile <config>"
 %config = 
 (
   # 1. General backup setup
   # Directory for snapshot files, 
   # status/lock file, and temporary data
   snapshotdir => "/root/snapshots",

   # List of files/dirs to be included/excluded 
   # in the backup (one file name per line)
   includelist => "/root/mirror.conf/include",
   excludelist => "/root/mirror.conf/exclude", 

   # Base name of the backup files. 
   # This default is pretty sensible.
   basename => "$host",

   # Must be root to do this backup? 
   # ("yes" or "no")
   must_be_root => "no",

   # 2. Tool setup
   
   tar => "tar",            # tar command to use
   compressopt => "--gzip", # compression option to use
   extension => "tgz",      # backup file name extension
   debug => "no",           # debug mode

   # Email setup
   email => "$user\@$host", # email addresses for messages
   cc => "$user\@$host",    # possible second email address

   # Third email address 
   # (used in case of errors and for user notification)
   emergency_cc => "$user\@$host", 

   # Backup level configuration 
   # number of levels is 3: level-0 through level-3
   # (arbitrary number of levels possible)
   levels => 4, 

   # Specify number of backups on each level 
   # before next lower level is due
   maxcount => 
   { 
     0 => 0,  # infinite number of level-0 (full) backups
     1 => 10, # max. 10 x level-1 before next level-0
     2 => 5,  # max. 5 x level-2 before next level-1
     3 => 5   # max. 5 x level-3 before next level-2
   },

   # Specify type of backup on each level.
   # The names given here are arbitrary but must 
   # each contain exactly one of the substrings "notify", 
   # "tape", "remote" or "harddisk" to specify the type of 
   # backup. The names correspond to the names of 
   # the separate entries below. 
   backuptype => 
   { 
     0 => "notify_me",      # notify user
     1 => "streamer_tape",  # backup to local tape
     2 => "remote_machine", # backup over network
     3 => "harddisk"        # backup to mounted harddisk
   },
  
   # This is a typical harddisk backup configuration.
   # These may have different names but must contain 
   # a "harddisk" in their name.
   harddisk => 
   {
     path => "/bkup", # where to put the backup files...
   },

   # This is a typical tape backup configuration.
   # These may have different names but must contain 
   # a "tape" in their name.
   streamer_tape => 
   {
     # The type device (must be non-rewinding!).
     device => "/dev/nst0",
     # Optional tape capacity in MB.
     capacity => 4000
   },

   # This is an example remote backup configuration
   # These may have different names but must contain
   # a "remote" in their name.
   remote_machine =>
   {
     path => "$user\@jumbo:/archive/$host",
   },

   # This is a typical notification backup configuration
   # If notification is configured, the user is sent an 
   # email, and after the script is started again (by 
   # hand or CRON or whatever), the backup is done. 
   # If desired, a second notification is sent afterwards. 
   # This emailing has the goal to remind the user to 
   # change media before the backup is done, and 
   # afterwards to change media back. These notification 
   # backups may have different names but must contain 
   # a "notify" in their name.
   notify_me => 
   {    
     # what to do on next run
     restart => "othertape",
     # notify again after restart?
     notify_again => "yes",
   },   

   # After getting our email notification, the user 
   # restarts the program and we have to do this 
   # (note that this is again a tape backup, to 
   # be seen by the "tape" in the name).
   othertape =>
   {
     device => "/dev/nst0"
   },
 );

=head1 FILES

=over 8

=item /usr/local/bin/mirror

The B<mirror> script.

=item /usr/local/man/man1/mirror.1

The man page, generated from Perl's POD. 
You can produce the manpage by typing 
'pod2man mirror >mirror.1'

=back

=head1 BUGS

No bugs are known :-)

=head1 AUTHOR

Copyright 1998 by Chris Traxler <christoph.t.traxler@theo.physik.uni-giessen.de>. The GNU general
public license applies. 

You are permitted to use and alter B<mirror> under the terms of the GNU GPL. If you alter this file
(and improve the program), I kindly ask you to send a copy to me at
christoph.t.traxler@theo.physik.uni-giessen.de. You can retrieve a copy of the precise license terms at
the URL ftp://prep.ai.mit.edu/pub/gnu/COPYING-2.0

B<mirror> can be retrieved from any CPAN mirror or from ftp://krabat.physik.uni-giessen.de/pub/traxler/

=cut


