#!/usr/bin/perl -w

### Configuration parameters, true or false
# Currently unused
$debug = 0;

# Output a byte count in the beginning (required for some scripts, needs to scan file system twice)
$countBytes = 0;

# For which file systems to use the real dump
@realDumpFSTypes = qw(ext2 ext3);
$realDump = "/sbin/dump.bin";

# The mtab to manually parse, if "mount -nfv" doesn't work
$mtab = "/etc/mtab"; # Unless you want to use /proc/mounts...

# The tar to use (some may want to use a suid-tar, if run as "operator"
$tar = "tar";
$tar = "/bin/dumptar" if (-x "/bin/dumptar");

# If you need special consideration (especially useful for suid-tars)
# umask 002;

### End of configuration options

use Date::Format;
use File::stat;
use Fcntl ':mode';

### Minimal "dump" argument parser
# Returns a hash with the entries found.
# - Single-character options are set to 1 if occured
# - Options with argument get the argument as the hash value
# - The dumplevel is stored under key "level"
# - The number of arguments parsed (i.e., the index of the first untouched argument in the array) is stored as "argc"
sub getDumpParams {
    my $opts = $_[0];
    my $index = 1;	# Current parameter
    my %dumpParams = ();

    while ($opts ne "") {
	my $firstChar = substr($opts, 0, 1);
	$opts = substr($opts, 1);

	if ($firstChar ge '0' && $firstChar le '9') {
	    $dumpParams{"level"} = $firstChar;
	} elsif (index("BbdeFhLsTf", $firstChar) >= 0) {
	    # Store parameter
	    $dumpParams{$firstChar} = $_[$index++];
	} else {
	    # Remember parameter
	    $dumpParams{$firstChar} = 1;
	}
    }
    $dumpParams{"argc"} = $index;
    return \%dumpParams;
}

### get the device path, file system type, and mount point for the given
# file or directory (as a list, in that order).
sub getDevInfo {
    my $path = $_[0];
    my($devPath, $dirPath, $fsType);
    my($statPath, $statMount);
    my $dummy;

    # Try mount -nfv first
    # This is the best, as it does symlink resolution etc.
    # Some mounts allow this operation only for root, but we can try...
    if (open(MOUNT, "mount -nfv $path 2> /dev/null |")) {
	while (<MOUNT>) {
	    if (m/^(.*) on (.*) type (.*) \((.*)\)$/) {
		return ($1, $2, $3);
	    } else {
		die "mount -nfv $path: Illegal format: $_";
	    }
	}
	close(MOUNT);
    }

    # Did not work, do our own scan of the mount table
    $statPath =	stat($path) or die "stat " . $path . ": " . $!;
    open(MTAB, $mtab) or die "Cannot open " . $path . ": " . $!;
    while (<MTAB>) {
	chomp;
	($devPath, $dirPath, $fsType, $dummy) = split();
	# Does the parameter match the directory name?
	if ($dirPath eq $path) {
	    return ($devPath, $dirPath, $fsType);
	}
	# If not, does the parameter point to the same device?
	if ($devPath =~ m,^/,) {
	    # Ignore errors
	    if ($statMount = stat($devPath)) {
		if (S_ISBLK($statMount->mode) && $statPath->rdev == $statMount->rdev) {
		    return ($devPath, $dirPath, $fsType);
		}
	    }
	}
    }
    close(MTAB);
    die "Error: cannot find mount entry for $path";
}

#### Get the date of the last dump (i.e., highest dumplevel) of at most the current dump level
# Input: (device path, dump level)
# Output: date string
sub getDumpDate {
    my $path = $_[0], $level = $_[1];
    my $bestDate = undef;
    my $bestLevel = undef;

    # No dump dates? Keep oldest
    open(DUMPDATES, "/etc/dumpdates") or return ($bestDate, $bestLevel);
    
    while (<DUMPDATES>) {
	chomp;
	if (m,^$path ([0-9]) (.*)$,) {
	    if ((!defined($bestLevel) || ($1 > $bestLevel))
		&& ($1 < $level)) {
		$bestLevel = $1;
		$bestDate = $2;
	    }
	}
    }
    close(DUMPDATES);
    return ($bestDate, $bestLevel);
}

### Update /etc/dumpdates with the given time and level, deleting all entries with higher level
# Input: (device path, dump level, date)
# Modifies: /etc/dumpdates (without locking)
sub updateDumpDates {
    my $path = $_[0], $level = $_[1], $date = $_[2];
    my @dumpdates = (), @sorteddates = ();
    my $entry;

    if (open(DUMPDATES, "/etc/dumpdates")) {
	# OK, read it in
	while (<DUMPDATES>) {
	    chomp;
	    if (m,^$path ([0-9]) ,) {
		# Our path: Keep only higher dump levels
		push(@dumpdates, $_) if ($1 < $level);
	    } else {
		# Other paths: All of them
		push(@dumpdates, $_);
	    }
	}
	close(DUMPDATES);
    }

    # Add our own entry (if $date was generated with ctime(), it contains a newline)
    $entry = "$path $level $date";
    chomp($entry);
    push(@dumpdates, $entry);

    @sorteddates = sort(@dumpdates);

    # Output in a new file, and then rename this
    # Idea: If there is a race condition, noone will ever see the empty file
    open(DUMPDATES, ">/etc/dumpdates.$$") or die "/etc/dumpdates.$$: $!";
    for my $i (@sorteddates) {
	print DUMPDATES $i . "\n" or die "Error writing /etc/dumpdates.$$: $!";
#	print STDERR $i . "\n";
    }
    close(DUMPDATES) or die "Error closing /etc/dumpdates.$$: $!";
    rename("/etc/dumpdates.$$", "/etc/dumpdates") or die "Rename /etc/dumpdates.$$ /etc/dumpdates: $!";
}

# Main
$params = getDumpParams(@ARGV);
if ($debug) {
    for $i (keys(%$params)) {
	print STDERR $i, "=", $params->{$i}, "\n";
    }
}
if (!exists($params->{"level"}) || !exists($params->{"f"})) {
    die "Usage: $0 <dump-like parameters> <additional parameters to tar>";
}
($devPath, $dirPath, $fsType) = getDevInfo($ARGV[$params->{"argc"}]);

# If $realDump exists and the fstype is one of those supported, call $realDump instead
for my $i (@realDumpFSTypes) {
    if ($i eq $fsType && -x $realDump) {
	exec($realDump, @ARGV[0 .. $params->{"argc"}]);
    }
}

# Allow us to make tar paths relative
chdir($dirPath) || die "chdir: $!";

@args = ($tar, "-cf", $params->{"f"}, "--one-file-system", "--sparse" );
($prevDate, $prevLevel) = getDumpDate($devPath, $params->{"level"});
push(@args, "--newer", $prevDate) if (defined($prevDate));
# User args
push(@args, @ARGV[$params->{"argc"}+1 .. $#ARGV]) if ($params->{"argc"} <= $#ARGV);
push(@args, ".");


$start = time();
print STDERR "  DUMP: Date of this level " . $params->{"level"} . " dump: " . ctime($start);
if (defined($prevLevel) && $prevLevel < $params->{"level"}) {
    print STDERR "  DUMP: Date of last level $prevLevel dump: $prevDate\n";
}
print STDERR "  DUMP: Dumping $devPath ($dirPath) to " . $params->{"f"} . "\n";
print STDERR "  DUMP: Using backend " . join(" ", @args) . " (pwd=$dirPath)\n";

if ($countBytes) {
    die "Not supported right now";
    # shell code: (cannot easily be changed to work safely with open())
    # bytes=`$tar -c -f - --one-file-system --absolute-names --sparse --newer "$newer" $mnt | wc -c`
    # blocks=`expr $bytes / 1024`
    # echo " DUMP: estimated $blocks tape blocks on a partial tape."
}

$! = undef;
# Do the backup
if (system(@args) == 0) {
    print STDERR "  DUMP: Date this dump completed: " . ctime(time());
    if ($params->{"u"}) {
	umask(022);
	updateDumpDates($devPath, $params->{"level"}, ctime($start));
    }
} else {
    print STDERR "  DUMP: Backend failed: $!\n";
}

print STDERR "  DUMP: DUMP IS DONE\n";
