#!/usr/bin/perl -w
#
# Copyright (c) 2005 - 2008 Miek Gieben; Mark J Hewitt
# See LICENSE for the license
# Hardlink script
# See URL
# for writing your own scripts or modify this one

use strict;

use Getopt::Long qw(:config no_ignore_case bundling);
use File::Basename;
use File::Path;
use File::Copy;
use POSIX;

# common functions
my $prefix="/usr";
my $datarootdir = "${prefix}/share";
require "${datarootdir}/rdup/shared.pl";
my $d= i18n();

my $ts = time;
my $progName = basename $0;
my ($help, $version, $verbose, $attr, $remote, $hourly, $backupDir);
my %hardlink;
my ($restore, $strip);

$strip = 0;
GetOptions("h" => \$help,
	"V" => \$version,
	"a" => \$attr, # extended attr support
	"c" => \$remote,
	"R" => \$restore,	# restore mode (ala the old rdup-cp)
	"p=i" => \$strip,	# strip i slashes (only when restoring)
	"v" => \$verbose,
	"b=s" => \$backupDir);

usage() if $help;
version($progName) if $version;

die $d->get("** Need a -b option") if !$backupDir;
die $d->get("** -p is only valid with -R") if $strip && !$restore;
chomp (my $hostname = `hostname`);
my $attr_there = check_attr() if $attr;

# Statistics
my $ftsize = 0;        # Total file size
my $ireg = 0;        # Number of regular files
my $idir = 0;        # Number of directories
my $ilnk = 0;        # Number of symbolic links
my $irm  = 0;        # Number of files removed
my ($t, $bits, $uid, $gid, $psize, $fsize, $path);

if (!exist($backupDir)) {
    mkpath($backupDir) or die $d->get("** Cannot create") . 
	"`$backupDir': $!";
}

if ($remote) {
    while (<STDIN>) {
	chomp;
	($t, $bits, $uid, $gid, $psize, $fsize) = split(" ", $_, 6);
	_mirror($backupDir);
    }
} else {
    while (<STDIN>) {
	chomp;
	($t, $bits, $uid, $gid, $psize, $fsize, $path) = split(" ", $_, 7);
	_mirror($backupDir);
    }
}
# postprocess the hardlinks
foreach (keys %hardlink) {
    # create hardlinks
    link("$backupDir/$hardlink{$_}", "$backupDir/$_") or 
	warn $d->get("** Cannot create hardlink:") .  
	" $backupDir/$hardlink{$_} -> $backupDir/$_: $!";
}

if (! $restore) {
    my $te = time;
    printf STDERR $d->get("** #REG FILES  : %d\n"), $ireg;
    printf STDERR $d->get("** #DIRECTORIES: %d\n"), $idir;
    printf STDERR $d->get("** #SYMLINKS   : %d\n"), $ilnk;
    printf STDERR $d->get("** #HARDLINKS  : %d\n"), 0 + keys %hardlink;
    printf STDERR $d->get("** #(RE)MOVED  : %d\n"), $irm;
    printf STDERR $d->get("** DELTA FSIZE : %.1f MB\n"), $ftsize/1024.0/1024.0;
    printf STDERR $d->get("** STORED IN   : %s\n"), $backupDir;
    printf STDERR $d->get("** ELAPSED     : %.2f m\n"), ($te - $ts) / 60.00;
    rchmod(755, $backupDir);
}
exit 0;

sub _mirror {
    my $dir = shift;
    my $dump = substr($t, 0, 1);
    my $type = substr($t, 1, 1);
    my ($target, $ret, $old, $new);

    sanity_check($dump, $bits, $psize, $fsize, $uid, $gid);
    if ($remote) {
	$path = "";
	read STDIN, $path, $psize;
    }

    # strip path when restoring
    if ($restore) { $path = strip_path($strip, $path); }

    die $d->get("** Empty path")  if ($path eq "");
    print STDERR "$path\n" if $verbose;

    $target = "$dir/$path";

    if ($dump eq '+') {        # add

	if ($type eq 'l' or $type eq 'h') {
	    # the filesize is the leftname of the link
	    # the path_name size is the size of left -> right
	    $new = substr($path, 0, $fsize);
	    $old = substr($path, $fsize + 4); # skip ' -> '
	    $target = "$dir/$new";
	}

	# if there is already something there - remove it
	if (exist($target) == 1) {
	    if ($type eq '-' or $type eq 'l' or $type eq 'h') {
		if (-d _) {
		    rmtree $target or warn $d->get("** Cannot remove:") . " $target: $!";
		} else {
		    unlink $target or warn $d->get("** Cannot unlink:") . " $target: $!";
		}
	    } elsif ($type eq 'd') {
		if (-f _ || -l _) {      # Type of entry has changed
		    unlink $target or warn $d->get("** Cannot unlink:") . " $target: $!";
		}
	    }
	}

	if ($type eq '-') {		# REG
	    if ($remote) {
		open FILE, ">$target" or warn $d->get("** Cannot create:") . " $target: $!";
		if ($fsize != 0) {
		    copyout($fsize, *FILE);
		}
		close FILE or warn "** Failed to close: $!";
	    } else {
		$ret = copy($path, $target) or warn $d->get("** Copy failed:") . " $! $path $target";
	    }
	    $ftsize += $fsize;
	    $ireg++;

	} elsif ($type eq 'd') {        # DIR
	    mkpath($target) unless -d _;
	    # fix unaccessible paths for mortal users
	    if ($> != 0) {
		if (length($bits) == 3 and substr($bits, 0, 1) ne "7") {
		    print STDERR $d->get("** Chmod u+rwx") . " $target\n";
		    $bits = "7" . substr($bits, 1, 2);
		}
		if (length($bits) == 4 and substr($bits, 1, 1) ne "7") {
		    print STDERR $d->get("** Chmod u+rwx") . " $target\n";
		    $bits = substr($bits, 0, 1) . "7" . substr($bits, 2, 2);
		}
	    }
	    $idir++;

	} elsif ($type eq 'l') {        # SLNK
	    symlink($old, $target) or warn $d->get("** Cannot create symlink:") . 
		" $old -> $target: $!";
	    $ilnk++;
	} elsif ($type eq 'h') {	# HLNK
	    $hardlink{$new} = $old;
	}

	if ($type ne 'l' and $type ne 'h') {
	    rchown($uid, $gid, $target);
	    chown_attr($attr_there, $uid, $gid, $target);
	    rchmod($bits, $target);
	}

    } else {        # Remove
	next if $restore;   # not in restore mode
	if (exist($target)) {
	    if (-d _) {
		rmtree $target or warn $d->get("** Cannot remove:") . " $target: $!";
	    } else {
		unlink $target or warn $d->get("** Cannot unlink:") . " $target: $!";
	    }
	}
	$ftsize -= $fsize;
	$irm++;
    }
}

sub usage {
    print "$progName -b DIR [OPTIONS]\n\n";
    print "Update hardlinks according to the filelist of rdup\n\n";
    print "OPTIONS\n";
    print " -b DIR  use DIR as the backup directory\n";
    print " -R      restore mode\n";
    print " -a      write extended attributes r_uid/r_gid with uid/gid\n";
    print " -c      process the file content also (rdup -c), for remote backups\n";
    print " -v      print the files processed to standard error\n";
    print " -p NUM  strip NUM slashes from the filenames (only valid with -R)\n";
    print " -h      this help\n";
    print " -V      print version\n";
    exit 0;
}

# only needed for restoring
sub strip_path {
        my ($s, $p) = (shift, shift);
	$s = 0 if $s < 0;

        my @path = split /\/+/, $p; 
	my $r = join '/', @path[$s..$#path];
}
