simba/lib/Simba/DA.pm

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

use Encode;
use File::Find;
use File::stat;

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 "\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);
}

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) = @_;

}

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;
}

1;

# vim: sw=4 expandtab