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

use Encode qw(decode encode from_to);
use File::Find;
use File::stat;
use Readonly;
use Digest::SHA1;
use List::Util qw(min);

Readonly my $BUFSIZE => 128 * 1024;

sub new {
    my ($class) = @_;
    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';

    return $self;

}

my %dispatch = (
    list => \&list,
    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;
	my @cmd = split();
        my $sub = $dispatch{$cmd[0]} || $dispatch{default};
        $self->$sub(@cmd);
    }
}

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

    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);
                        print $fn;

                        print metastr($fn, $st);

                        print "\n";
                    },
            no_chdir => 1,
        },
        $path
    );

}

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 quote {
    my ($s) = @_;
    $s =~ s{[\000-\040&=]}{sprintf("&#%d;", ord($&))}eg;
    return encode('utf-8', $s);
}

sub unquote {
    my ($s) = @_;
    $s = decode('utf-8', $s);
    $s =~ s{&#(\d+);}{chr($1)}eg;
    return $s;
}

my @typestr = (
    #0   1    2    3    4    5    6    7
    '?', 'p', 'c', '?', 'd', '?', 'b', '?',
    'f', '?', 'l', '?', 's', '?', '?', '?',
);
sub typestr {
    my ($mode) = @_;
    $mode >>= 12;
    return $typestr[$mode] || '?';
}

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

    # sanity checks on $path here?

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

    # sanity checks on $path here?

    my $st = lstat($fn);
    if (!$st) {
        print "fail $path ($!)\n";
        return;
    }
    if (typestr($st->mode) eq 'f') {
        my $fh;
        unless (open($fh, '<:raw', $fn)) {
            print "fail $path ($!)\n";
            return;
        }
        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 = $!;
                print "\0" for (1 .. $size);
                last;
            } elsif ($rc == 0) {
                # premature EOF.
                $err = "file shrunk by $size bytes";
                print "\0" for (1 .. $size);
                last;
            }
            print $buffer;
            $size -= length($buffer);
            $sha1->add($buffer);
        }
        print "\n";
        if ($err) {
            print "fail ($err)\n";
        } else {
            print "chk sha1 ", $sha1->hexdigest, "\n";
        }
    } elsif (typestr($st->mode) eq 'l') {
        my $target = readlink($fn);
        if (length($target) == $st->size) {
            print "data $path ", metastr($fn, $st), "\n";
            print "$target\n";
            print "chk sha1 ", sha1_hex($target), "\n";
        } else {
            print "fail ($!)\n";
        }
    } else {
        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;
}

1;

# vim: sw=4 expandtab