#!/usr/bin/perl -w
use strict;

# use 5.006;	# for Fcntl ':mode'

use FileHandle;
use IPC::Open2;

use File::Find;
use File::stat;
# use Fcntl ':mode';
use MD5;
use POSIX qw(strftime);

my $configfile = $ARGV[0];
unless ($configfile) {
    $configfile = "$ENV{HOME}/etc/dsb/config";
    unless (-f $configfile) {
	$configfile = "/etc/dsb/config";
	unless (-f $configfile) {
	    die "$0: no useable config file"
	}
    }
}

my $tmpdir;
my $logdir;
my $passphrase;
my $encrkey;
my $signkey;
my $account;
my $startdir;
my @patterns;

readconfigfile();

my $idxfile="$logdir/dsbbackup." .
	     strftime("%Y-%m-%dT%H:%M:%S%z", localtime) . ".log";

my($rdrfh, $wtrfh);
$rdrfh = \*RDR;		# obsolete for perl >= 5.6
$wtrfh = \*WTR;
my $pid = open2($rdrfh, $wtrfh,
		 'ssh', $account, 'dsbsrv');
open(IDX, "> $idxfile");
print IDX "<dsbbackup:index>\n";

#find({wanted => \&check_file, no_chdir => 1}, $startdir);
find(\&check_file, $startdir);

print IDX "</dsbbackup:index>\n";

sub check_file {
    my $file = $File::Find::name;

    for my $pat (@patterns) {
	if ($file =~ m/$pat->[0]/) {
	    return if ($pat->[1] eq '-');
	}
	last;
    }
    my $st = lstat($file);
    my $mode = $st->mode;
    my $uid = $st->uid;
    my $gid = $st->gid;
    my $rdev = $st->rdev;
    my $size = $st->size;
    my $mtime = $st->mtime;

    # ignoring nlinks for now. We should store hard links somewhere
    # however.

    my $perm = '';
    $perm .= ' owner=' . quote(uid2name($uid));
    $perm .= ' group=' . quote(gid2name($gid));
    my $acl  = 'user::' . permstr(($mode & 0700) >> 6) . ' ';
    $acl .= 'group::' . permstr(($mode & 0070) >> 3) . ' ';
    $acl .= 'other:' . permstr(($mode & 0007) >> 0) . ' ';
    $perm .= ' acl=' . quote($acl);
    $perm .= ' setuid="1"' if $mode & 04000;
    $perm .= ' setgid="1"' if $mode & 02000;
    $perm .= ' sticky="1"' if $mode & 01000;

    my $desc;
    my $content = 0;
    if (-d _) {
	$desc = "<directory name=" . quote($file) . "$perm />";
    } elsif (-f _) {
	$desc = "<file name=" . quote($file) . "$perm size='$size' mtime='$mtime' />";
	$content = 1;
    } elsif (-l _) {
	$desc = "<link name=" . quote($file) . " target=" . quote(readlink($file)) . " />";
    } elsif (-b _) {
	$desc = "<blockdevice name=" . quote($file) . "$perm rdev='$rdev' />";
    } elsif (-c _) {
	$desc = "<chardevice name=" . quote($file) . "$perm rdev='$rdev' />";
    } elsif (-p _) {
	$desc = "<fifo name=" . quote($file) . "$perm />";
    } elsif (-S _) {
	$desc = "<socket name=" . quote($file) . "$perm />";
    } else {
	print STDERR "$0: warning: $file has unknown mode $mode\n";
    }
    print "$0: $desc\n";
    my $key = MD5->hexhash($desc);
    substr($desc, -2, 0) = "key=" . quote($key) . " ";
    print $wtrfh "QUERY $key [0]\n";
    my $result = <$rdrfh>;
    chomp($result);
    print "\t$result\n";
    if ($result eq "HAVENOT $key \[0\]") {
	if ($content) {
	    open(T, ">$tmpdir/$$") or die "cannot create tmpfile $tmpdir/$$: $!";

	    print T "$desc\n";
	    open(F, "<$file");
	    while (<F>) {
		print T $_;
	    }
	    close(F);
	    close(T);
	    store_encr($key, "$tmpdir/$$");
	    unlink("$tmpdir/$$");
	} else {
	    # store only metadata
	    open(T, ">$tmpdir/$$") or die "cannot create tmpfile $tmpdir/$$: $!";
	    print T "$desc\n";
	    close(T);
	    store_encr($key, "$tmpdir/$$");
	    unlink("$tmpdir/$$");
	}
	$result = <$rdrfh>;
	chomp($result);
	print "\t$result\n";
    }
    substr($desc, -2, 0) = "result=" . quote($result) . " ";
    print IDX "$desc\n";
}

my %ucache;
sub uid2name {
    my ($uid) = @_;
    return $ucache{$uid} if ($ucache{$uid});
    my $uname = getpwuid($uid);
    if ($uname) {
	$ucache{$uid} = $uname;
    } else {
	# no user name - use numeric id
	$ucache{$uid} = $uid;
    }
}


my %gcache;
sub gid2name {
    my ($gid) = @_;
    return $gcache{$gid} if ($gcache{$gid});
    my $gname = getgrgid($gid);
    if ($gname) {
	$gcache{$gid} = $gname;
    } else {
	# no group name - use numeric id
	$gcache{$gid} = $gid;
    }
}

sub quote {
    my ($s) = @_;

    $s =~ s{[^- _./:A-Za-z0-9\[\]]}{sprintf("&#x%X;", ord($&))}eg;
    return "'$s'";
}

sub permstr {
    my ($perm) = @_;

    return ($perm & 04 ? 'r' : '-') .
           ($perm & 02 ? 'w' : '-') .
           ($perm & 01 ? 'x' : '-');
}

sub store_encr {
    my ($key, $file) = @_;
    system("gpg -se -r $encrkey -u $signkey --passphrase-fd=0 $file < $passphrase");
    my $st = stat("$file.gpg");
    if ($st) {
	print $wtrfh "STORE $key \[" . $st->size . "\]\n";
	open(F, "<$file.gpg");
	while (<F>) {
	    print $wtrfh $_;
	}
	close(F);
    } else {
	print STDERR "encrypting $file failed\n";
    }
    unlink ("$file.gpg");
}

sub readconfigfile {
    open(F, "<$configfile") or die "cannot open $configfile: $!";
    while (<F>) {
	chomp;
	my ($key, $val) = split(/\s*=\s*/);
	if ($key eq 'tmpdir') {$tmpdir=$val;}
	elsif ($key eq 'logdir') {$logdir = $val;}
	elsif ($key eq 'passphrase') {$passphrase = $val;}
	elsif ($key eq 'encrkey') {$encrkey = $val;}
	elsif ($key eq 'signkey') {$signkey = $val;}
	elsif ($key eq 'account') {$account = $val;}
	elsif ($key eq 'startdir') {$startdir = $val;}
	elsif ($key eq 'trustedkey') {}
	elsif ($key eq 'include') {push (@patterns, [$val, '+']);}
	elsif ($key eq 'exclude') {push (@patterns, [$val, '-']);}
	else {
	    die "unknown keyword $key in $configfile:$.\n";
	}
    }
    close(F);
}
