#   FauBackup - Backup System, using a Filesystem for Storage
#   Copyright (C) 2000-2002 Martin Waitz, Dr. Volkmar Sieh
#   $Id: faubackup,v 1.10.2.3 2001/05/31 17:38:02 mnwaitz Exp $
#
#   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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;

use File::stat;
use Getopt::Long;

my $version	= '@VERSION@';
my $conffile	= '/etc/faubackup.conf';

my $usage= <<END;
Usage:	$0 [options] [machine:]srcdir [destdir]
	$0 [options] --clean [destdir]
	$0 [--list[=destdir]]
END
my $help = $usage . <<END;

This Program uses a filesystem on a hard drive for incremental and full backups.

Some Options:
	-v	Verbose mode, print processed directories, size when listing
	--list	show info about backups already created

	--clean	remove old backups before/instead making a fresh one.

	machine	if given, backup will be done from remote machine.
	srcdir	This Directory gets backed up.
	destdir	Place to hold the backup.
		A default directory will be chosen if omitted.

See faubackup(8) for more information about using $0.
$0 relies on faubackup-gather and faubackup-scatter to do the actual backup.

FauBackup version $version,
Copyright (c) 2000-2002 Martin Waitz, Dr. Volkmar Sieh.
Developed at Friedrich Alexander University Erlangen-Nuremberg.
FauBackup comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it under
certain conditions; see the GNU General Public License for details.
END


#####################################################################

#
# defaults
#
$FAUBACKUP::backup	= "/backup/MACHINE:DIR";
$FAUBACKUP::autocreate	= 1;
$FAUBACKUP::keepyears	= 2;
$FAUBACKUP::keepmonths	= 12;
$FAUBACKUP::keepweeks	= 4;
$FAUBACKUP::keepdays	= 7;
$FAUBACKUP::keeplastofday = 0;
$FAUBACKUP::rsh		= "rsh";
$FAUBACKUP::gather	= "faubackup-gather";
$FAUBACKUP::scatter	= "faubackup-scatter";
$FAUBACKUP::find	= "faubackup-find";
@FAUBACKUP::ignore	= ();

#
# read configuration
#
do $conffile or die "could not read $conffile: $!" if -r $conffile;

my( $backup, $autocreate, $rsh, $keep, $keeplastofday, $find, @ignore );
$backup = $FAUBACKUP::backup;
$autocreate = $FAUBACKUP::autocreate;
$keep->{YEAR} = $FAUBACKUP::keepyears;
$keep->{MONTH} = $FAUBACKUP::keepmonths;
$keep->{WEEK} = $FAUBACKUP::keepweeks;
$keep->{DAY} = $FAUBACKUP::keepdays;
$keeplastofday = $FAUBACKUP::keeplastofday;
$rsh = $FAUBACKUP::rsh;
$find = $FAUBACKUP::find;
@ignore = @FAUBACKUP::ignore;

$rsh=$ENV{'FAUBACKUP_RSH'} if $ENV{'FAUBACKUP_RSH'};

# globals
my $time = time;
my @localtime = localtime($time);


# global variables set by command line
my $show_help=0;
my $show_usage=0;
my $show_version=0;
my $verbose=0;
my $srcdir;
my $destdir;
my @list=();
my @clean=();
my $gatherdir;
my $scatterdir;
my $ignored;


#####################################################################

# return a list of backup directories
sub backups_in($)
{
	my $expr = shift;
	$expr =~ s#MACHINE#*#;
	$expr =~ s#DIR#*#;
	return glob $expr;
}

sub backupdir(@)
{
	return backups_in($backup) if @_==1 && $_[0] eq '';
	return @_;
}


sub backup($)
{
	my( $dir ) = @_;

	#
	# get date of all backups
	#
	my( $entry, @backup );
	opendir DIR, $dir or die "opendir $dir: $!";
	foreach $entry (readdir DIR) {
		next unless $entry =~ /^\d+-\d+-\d+@\d+:\d+:\d+$/;
		my( $date, $sb );
		$date = {};
		$date->{ENTRY} = $entry;
		$date->{DIR} = "$dir/$entry";
		$sb = lstat($date->{DIR});
		# safety checks:
		next unless -d _;
		next unless -d "$date->{DIR}/..inodes";

		$date->{MTIME} = $sb->mtime;
		my @time = localtime($date->{MTIME});
		# calculate how old this date is:
		$date->{YEAR} = $localtime[5] - $time[5];
		$date->{MONTH} = $date->{YEAR}*12 + $localtime[4] - $time[4];
		# 5.1.1970 was a monday -> substract 4 days to get #weeks:
		$date->{WEEK} = int(($time-4*24*3600) / (7*24*3600)) -
				int(($date->{MTIME}-4*24*3600) / (7*24*3600));
		$date->{DAY} =  int($time / (24*3600)) -
				int($date->{MTIME} / (24*3600));
		push @backup, $date;
	}
	closedir DIR or die "closedir $dir: $!";

	return sort {$a->{MTIME} <=> $b->{MTIME}} @backup;
}

sub collect_metadata($$); # to make perl happy with recursion
sub collect_metadata($$)
{
	my( $date, $dir ) = @_;

	my $entry;
	my @subdirs;
	opendir DIR, $dir or die "opendir $dir: $!";
	foreach $entry (readdir DIR) {
		next if $entry eq '.' || $entry eq '..';
		my $s = lstat "$dir/$entry";
		if( -d _ ) {
			push @subdirs, "$dir/$entry";
		} else {
			# size in K
			my $size = $s->blocks / 2; # assumes 512byte blocks
			my $dev = $s->dev;
			my $ino = $s->ino;
			$date->{FILES}{"$dev/$ino"} = $size;
			if( -f _ && $s->nlink==2 ) {
				# this file is only used by this backup
				$date->{SIZE} += $size;
			}
		}
	}
	closedir DIR or die "closedir $dir: $!";

	foreach $dir (@subdirs) { collect_metadata($date, $dir) }
}

sub compare_space($$)
{
	my( $date, $last ) = @_;

	$date->{FADD} = $date->{FREM} = 0;
	$date->{SADD} = $date->{SREM} = 0;
	$date->{SIZE} = 0;

	$date->{FILES} = {};

	collect_metadata( $date, "$date->{DIR}/..inodes" );

	my $file;
	foreach $file (keys %{$date->{FILES}}) {
		if( $last->{FILES}{$file} ) {
			# this file is linked with old backupd
			delete $last->{FILES}{$file};
		} else {
			# new/changed file
			$date->{FADD}++;
			$date->{SADD} += $date->{FILES}{$file};
		}
	}
	foreach $file (keys %{$last->{FILES}}) {
		# removed/changed file
		$date->{FREM}++;
		$date->{SREM} += $last->{FILES}{$file};
	}
}



#
# Cleanup Funktion
#

sub cleanup($)
{
	my( $dir ) = @_;

	print STDERR "checking for obsolete backups in '$dir'\n" if $verbose>1;

	my( @backup, @obsolete );
	@backup = backup $dir;

	#
	# remove obsolete backups
	#
	my( $date, $last );
	$last = { YEAR=>-1, MONTH=>-1, WEEK=>-1, DAY=>-1 };
	foreach $date (@backup) {
		my $keepme = 0;

		my $type;
		foreach $type (qw(DAY WEEK MONTH YEAR)) {
			# we will keep it if this is the first backup
			# of an interval (day, week, etc)
			$keepme ||= ($date->{$type}!=$last->{$type} &&
					$date->{$type}<=$keep->{$type});
		}

		if( $keeplastofday && $date->{DAY}==$last->{DAY} &&
					$date->{DAY}<=$keep->{DAY} ) {
			# this backup was made on the same day as the last
			# and the user wants to keep the most recent backup
			$keepme = 1;
			push @obsolete, $last;
		}
		
		push @obsolete, $date unless $keepme;
		$last = $date;
	}

	foreach $date (@obsolete) {
		my @cmd = ('/bin/rm', '-rf', '--', $date->{DIR});
		print STDERR "deleting old $date->{DIR}\n" if $verbose==1;
		print STDERR "@cmd\n" if $verbose>1;
		(system {$cmd[0]} @cmd) == 0 or
			die "@cmd: exit $?";
	}
}

sub list($)
{
	my( $dir ) = @_;

	print "$dir\n";

	my( @backup );
	@backup = backup $dir;

	my( $date, $last, %first );
	$last = { YEAR=>-1, MONTH=>-1, WEEK=>-1, DAY=>-1 };
	%first = ( YEAR=>"", MONTH=>"", WEEK=>"", DAY=>"" );
	foreach $date (@backup) {
		my $type;
		my @types=();
		# this is similar to cleanup computation
		# FIXME: dosn't honor $keeplastofday yet
		foreach $type (qw(YEAR MONTH WEEK DAY)) {
			if( $date->{$type}<=$keep->{$type} ) {
				$first{$type} ||= $date->{ENTRY};
				push @types, $type
					if $date->{$type}!=$last->{$type};
			}
		}
		# get information about backup sizes if requested
		if( $verbose ) {
			compare_space($date, $last);
			print "\t$date->{ENTRY} " .
				"f+$date->{FADD}-$date->{FREM} " .
				"size+$date->{SADD}-$date->{SREM}:$date->{SIZE} " .
				"@types\n";
		}
		$last = $date;
	}

	if( !$verbose ) {
		print "\t  first daily backup on $first{DAY}\n" if $first{DAY};
		print "\t first weekly backup on $first{WEEK}\n" if $first{WEEK} ne $first{DAY};
		print "\tfirst monthly backup on $first{MONTH}\n" if $first{MONTH} ne $first{WEEK};
		print "\t first yearly backup on $first{YEAR}\n" if $first{YEAR} ne $first{MONTH};
	}
	print "\tdoes not contain backups\n" unless $first{DAY}||$first{WEEK}||$first{MONTH}||$first{YEAR};
	print "\n";
}

# escape for use in shell command
sub escape($)
{
	my( $str ) = @_;

	$str =~ s/'/'\\''/g;
	return "\'$str\'";
}


#####################################################################

#
# command line parsing
#


# Configure and "...+" entries doesn't work in perl5.004 :(
#Getopt::Long::Configure( qw(bundling) );
GetOptions(	"help|h" => \$show_help,
		"usage" => \$show_usage,
		"version|V" => \$show_version,
#		"verbose|v+" => \$verbose,
		"verbose|v" => \$verbose,
		"debuglevel=i" => \$verbose,
		"ignore=s@" => \@ignore,
		"rsh=s" => \$rsh,
		"clean:s@" => \@clean,
		"list|l:s@" => \@list,
		"years|y=i" => \$keep->{YEAR},
		"months|m=i" => \$keep->{MONTH},
		"weeks|w=i" => \$keep->{WEEK},
		"days|d=i" => \$keep->{DAY},
		"keep-last" => \$keeplastofday,
		# deprecated options:
		"p" => \$ignored,
		"i=s" => \$scatterdir,
		"o=s" => \$gatherdir,
) or $show_usage=1;


if( $show_help ) {
	print $help;
	exit 0;
}
if( $show_version ) {
	print "faubackup $version\n";
	exit 0;
}

# default action is '--list'
@list=('') if @list==0 && @ARGV==0 && @clean==0 && !$scatterdir && !$gatherdir;

$show_usage=1 if @ARGV>2;
$show_usage=1 if @list>0 && (@ARGV>0 || @clean || $scatterdir || $gatherdir);

if( $show_usage ) {
	print STDERR $usage;
	print STDERR "See '$0 --help' for details\n";
	exit 1;
}


#####################################################################

#
# now do the work
#

if( @list>0 ) {
	foreach (backupdir @list ) { list($_); }
	exit 0;
}

# now clean these directories
if( @clean>0 ) {
	foreach (backupdir @clean) { cleanup($_); }
}


my( $gather, $scatter );
@ignore = map {escape($_)} @ignore;
$gather = "$find @ignore | $FAUBACKUP::gather";
$gather .= " -v" if $verbose && $gatherdir;
$scatter = $FAUBACKUP::scatter . ($verbose?" -v":"");

#
# process old options
#
if( $gatherdir ) {
	chdir $gatherdir or die "chdir $gatherdir: $!";
	exec $gather;
	die "exec $FAUBACKUP::gather: $!";
}
if( $scatterdir ) {
	chdir $scatterdir or die "chdir $scatterdir: $!";
	exec $scatter
	die "exec $FAUBACKUP::scatter: $!";
}


#
# process new backup syntax
#
exit 0 unless @ARGV; # nothing more to do?

# parse remote source machine
$srcdir = $ARGV[0];
my( $srchost, $desthost );
{
	my $dir;
	( $srchost, $dir ) = $srcdir =~ /^([\@a-zA-Z0-9_-]+):(.*)$/;
	$srcdir=$dir if $srchost;
}

# build up destdir if neccessary
if( @ARGV>1 ) {
	$destdir = $ARGV[1];
} else {
	my $dir = $srcdir;
	$dir = $srcdir;
	$dir =~ s#^/##;
	$dir =~ s#/$##;
	$dir =~ s#/#-#g;
	my $hostname = $srchost;
	$hostname ||= `hostname||cat /etc/hostname`;
	chomp $hostname;
	$destdir = $backup;
	$destdir =~ s#MACHINE#$hostname#;
	$destdir =~ s#DIR#$dir#;
}

# parse remote destination machine
{
	my $dir;
	( $desthost, $dir ) = $destdir =~ /^([\@a-zA-Z0-9_-]+):(.*)$/;
	$destdir=$dir if $desthost;
}

# build commands to execute
$gather = "cd " . escape($srcdir) . "&&" . $gather;
$gather = "$rsh $srchost " . escape($gather) if $srchost;

$scatter = "cd " . escape($destdir) . "&&" . $scatter;
$scatter = "$rsh $desthost " . escape($scatter) if $desthost;

print STDERR "source=$gather\n" if $verbose>1;
print STDERR "drain=$scatter\n" if $verbose>1;

$| = 1;
open STDIN, "$gather |" or die "fork: $!";
system( 'mkdir', '-p', $destdir )==0
	or die "mkdir $destdir: exit $?" if $autocreate;
system( $scatter )==0 or exit $?;
close STDIN or exit $?;

exit 0;