package Simba::DA;
use strict;
use warnings;

use Encode qw(decode encode);
use File::Find;
use File::stat;
use Readonly;
use Digest::SHA1;
use List::Util qw(min);
use IO::Handle;
use Simba::Util qw(quote unquote typestr);
use POSIX qw(strftime);

Readonly my $BUFSIZE => 128 * 1024;
#my $BUFSIZE = 128 * 1024;

sub new {
    my ($class, $opt) = @_;
    my $self = {};
    bless $self, $class;

    # read local config file here.
    # such a config file could contain:
    #
    # * some means for the CA to identify itself
    #   (currently we use SSH for that)
    #
    # * A list of directories which should not be descended into
    #   (for example, /proc, /sys, networked filesystems and 
    #   filesystems on removable media, ...)
    #
    # * encoding rules (e.g., charset of filenames)
    #
    # * Other system dependent parameters, e.g., whether to use ACLs
    #
    # For now we just hardcode the stuff:
    $self->{prune} = {
			'/proc' => 1,
			'/sys' => 1,
			'/nfs' => 1,
			'/tmp/hyre_be_dragones' => 1,
		    };
    $self->{charset} = 'utf-8';
    $self->{fh_out}  = exists($opt->{fh_out}) ? $opt->{fh_out} : \*STDOUT;
    $self->{fh_log}  = exists($opt->{fh_log}) ? $opt->{fh_log} : \*STDERR;
    $self->{log_level} = 99;

    die "PERL_UNICODE must not be set!" if $ENV{PERL_UNICODE};

    return $self;

}

my %dispatch = (
    list    => \&list,
    get     => \&get,
    default => \&no_such_command,
);

# the main loop:
# read one-line commands from stdin and dispatch commands
sub run {
    my ($self) = @_;

    binmode STDIN, ":raw";
    binmode STDOUT, ":raw";

    while (<>) {
	chomp;
        $self->log(10, "received: $_");
	my @cmd = split();
        my $sub = $dispatch{$cmd[0]} || $dispatch{default};
        $self->$sub(@cmd);
    }
}

sub list {
    my ($self, $cmd, $path) = @_;

    my $fh_out = $self->{fh_out};

    chdir $path or return;
    find({
	    preprocess
                => sub {
                        if ($self->{prune}{$File::Find::dir}) {
                            return ();
                        } else {
                            # not sure if sorting is useful
                            return sort @_;
                        }
                    },
	    wanted
                => sub {
                        my $st = lstat($_);
                        return unless $st; # ignore unstattable files.

                        my $fn = decode($self->{charset},
                                        $File::Find::name);
                        $fn = quote($fn);
                        $fh_out->print($fn);

                        $fh_out->print(metastr($fn, $st));

                        $fh_out->print("\n");
                    },
            no_chdir => 1,
        },
        "."
    );
    $fh_out->flush();
    $self->log(10, "$cmd done");
}

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

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

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 get {
    my ($self, $cmd, $path) = @_;

    my $fh_out = $self->{fh_out};

    # sanity checks on $path here?

    my $fn = encode($self->{charset}, unquote($path));

    # sanity checks on $path here?

    my $st = lstat($fn);
    if (!$st) {
        $fh_out->printflush("fail $path ($!)\n");
        return;
    }
    if (typestr($st->mode) eq 'f') {
        my $fh;
        unless (open($fh, '<:raw', $fn)) {
            $fh_out->printflush("fail $path ($!)\n");
            return;
        }
        $fh_out->print("data $path ", metastr($fn, $st), "\n");
        my $size = $st->size;
        my $err;
        my $sha1 = Digest::SHA1->new;

        while ($size > 0) {
            my $buffer;
            my $rc = read($fh, $buffer, min($size, $BUFSIZE));
            if (!defined($rc)) {
                # I/O error
                $err = $!;
                $fh_out->print("\0") for (1 .. $size);
                last;
            } elsif ($rc == 0) {
                # premature EOF.
                $err = "file shrunk by $size bytes";
                $fh_out->print("\0") for (1 .. $size);
                last;
            }
            $fh_out->print($buffer);
            $size -= length($buffer);
            $sha1->add($buffer);
        }
        $fh_out->print("\n");
        if ($err) {
            $fh_out->print("fail ($err)\n");
        } else {
            $fh_out->print("chk sha1 ", $sha1->hexdigest, "\n");
        }
        $fh_out->flush();
        $self->log(10, "$fn done");
    } elsif (typestr($st->mode) eq 'l') {
        my $target = readlink($fn);
        if (length($target) == $st->size) {
            $fh_out->print("data $path ", metastr($fn, $st), "\n");
            $fh_out->print("$target\n");
            $fh_out->print("chk sha1 ", sha1_hex($target), "\n");
        } else {
            $fh_out->print("fail ($!)\n");
        }
    } else {
        $fh_out->print("nodata $path ", metastr($fn, $st), "\n");
    }

}

sub metastr {
    my ($fn, $st) = @_;
    $st = lstat($fn) unless defined($st);

    my $s = "";

    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.

    $s .= " " . 'id=' . $st->dev . ":" . $st->ino;
    $s .= " " . 't=' . typestr($mode);
    $s .= " " . 's=' . $size;
    $s .= " " . 'm=' . $mtime;
    $s .= " " . 'o=' . quote(uid2name($uid));
    $s .= " " . 'g=' . quote(gid2name($gid));
    my $acl  = 'u::' . permstr(($mode & 0700) >> 6) . ',';
    $acl .= 'g::' . permstr(($mode & 0070) >> 3) . ',';
    $acl .= 'o:' . permstr(($mode & 0007) >> 0);
    $s .= " " . 'acl=' . quote($acl);
    $s .= " " . 'setuid=1' if $mode & 04000;
    $s .= " " . 'setgid=1' if $mode & 02000;
    $s .= " " . 'sticky=1' if $mode & 01000;
    $s .= " " . 'rdev=' . $st->rdev if ($mode & 0120000) == 0020000;

    return $s;
}

sub fh_out {
    my ($self, $fh_out) = @_;
    $self->{fh_out}  = $fh_out if defined($fh_out);
    return $self->{fh_out};
}

sub no_such_command {
    my ($self, $cmd) = @_;
    $self->{fh_out}->print("FAIL: no such command: $cmd\n");
    $self->log(5, "FAIL: no such command: $cmd");
}

sub log {
    my ($self, $level, $msg) = @_;
    if ($level <= $self->{log_level}) {
        $self->{fh_log}->print(strftime("%Y-%m-%dT%H:%M:%S%z", localtime), " $$ [$level]: $msg\n");
    }
}

1;

# vim: sw=4 expandtab tw=0