hjp
/
simba
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

Snapshot

This commit is contained in:
hjp 2006-10-02 10:56:36 +00:00
commit 86fd40023c
4 changed files with 266 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Notes Normal file
View File

@ -0,0 +1,12 @@
Simple
Integrated
Multiplatform
Backup &
Archive
or
Simply
Accessible
Backup &
Archive

8
da Executable file
View File

@ -0,0 +1,8 @@
#!/usr/bin/perl -T
use warnings;
use strict;
use Simba::DA;
my $da = Simba::DA->new();
$da->run();

61
lib/Simba/CA.pm Normal file
View File

@ -0,0 +1,61 @@
package Simba::CA;
use Encode;
use IPC::Open2;
sub new {
my ($class) = @_;
my $self = {};
bless $self, $class;
$self->{basedir} = '/home/hjp/backup';
$self->{targets} = [
{ host => 'bernon.wsr.ac.at', dir => '/', }
{ host => 'users.wsr.ac.at', dir => '/shares/user', }
];
return $self;
}
sub run {
my ($self) = @_;
# run sequentially for prototype. In production we probably
# want some concurrency
for my $target (@{$self->{targets}}) {
$self->backup2disk($target);
}
}
sub backup2disk {
my ($self, $target) = @_;
# get previous generation
$self->{last_backup} = "...";
$self->{this_backup} = "...";
my ($list_pid, $list_cfd, $list_dfd); # connection to get list of files
my ($file_pid, $file_cfd, $file_dfd); # connection to get content of files
$list_pid = open2(my $list_cfd, my $list_dfd, "ssh", "-l", "simba_da", $host, "da");
$list_cfd->printflush("list $dir\n"); # XXX - encode!
while (<$list_dfd>) {
# split into fields
my $f = $self->parse($_);
# if file is already present
if ($f->{t} eq 'f') {
if($self->present($f)) {
link("$self->{last_backup}/$f->{name}", "$self->{this_backup}/$f->{name}") or die; # XXX
} else {
# else request from da
unless ($file_pid) {
$file_pid = open2(my $file_cfd, my $file_dfd, "ssh", "-l", "simba_da", $host, "da");
}
$file_cfd->printflush("get $dir\n"); # XXX - encode!
} else {
# create local copy (or insert into DB only?)
}
# insert into DB.
}
}

185
lib/Simba/DA.pm Normal file
View File

@ -0,0 +1,185 @@
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