#!/usr/bin/perl package Simba::CA; use strict; use warnings; use Encode; use IPC::Open2; use POSIX qw(strftime); use Simba::Util qw(quote unquote typestr); use Readonly; use Digest::SHA1; use List::Util qw(min); use IO::Handle; use File::stat; Readonly my $BUFSIZE => 128 * 1024; sub new { my ($class) = @_; my $self = {}; bless $self, $class; $self->{basedir} = '/backup'; $self->{targets} = [ { host => 'localhost', dir => '/var/tmp', }, ]; 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 my @dirs = glob($self->{basedir} . '/????-??-??T??.??.??/' . $target->{host} . '/' . $target->{dir}); $self->{last_backup} = $dirs[-1]; my $timestamp = $self->{timestamp} || strftime('%Y-%m-%dT%H.%M.%S', localtime); $self->{this_backup} = $self->{basedir} . "/$timestamp/" . $target->{host} . '/' . $target->{dir}; 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($list_dfd, $list_cfd, "/usr/bin/ssh", "-l", "simba_da", $target->{host}, "da"); $list_cfd->printflush("list $target->{dir}\n"); # XXX - encode! close($list_cfd); 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($file_dfd, $file_cfd, "/usr/bin/ssh", "-l", "simba_da", $target->{host}, "da"); } $file_cfd->printflush("get $target->{dir}/$f->{name}\n"); # XXX - encode! my $header = <$file_dfd>; # this should be the same as $_ - check? if ($header =~ /^data (.*)/) { my $f2 = $self->parse($1); open(my $file_bfd, '>:raw', "$self->{this_backup}/$f->{name}") or die; # XXX my $size = $f2->{s}; my $err; my $sha1 = Digest::SHA1->new; while ($size > 0) { my $buffer; my $rc = read($file_dfd, $buffer, min($size, $BUFSIZE)); if (!defined($rc)) { # I/O error print STDERR "error reading from data socket: $!"; last; } elsif ($rc == 0) { # premature EOF. print STDERR "unexpected EOF reading from data socket"; last; } $file_bfd->print($buffer); $size -= length($buffer); $sha1->add($buffer); } my $trailer = <$file_dfd>; # should be empty line $trailer = <$file_dfd>; if ($trailer =~ /^fail /) { print STDERR $trailer; } elsif ($trailer =~ /^chk sha1 (\w+)/) { if ($sha1->hexdigest ne $1) { print STDERR "checksum error\n"; } } else { print STDERR "unexpected trailer $trailer\n"; } } else { print STDERR "unexpected header $header\n"; } } } elsif ($f->{t} eq 'd') { my $d = "$self->{this_backup}/$f->{name}"; $d =~ s,//+,/,g; mkdir_p($d, 0700) or die "cannot mkdir $d: $!"; # XXX } else { # create local copy (or insert into DB only?) print STDERR "ignored $_\n"; } # insert into DB. } } sub parse { my ($self, $s) = @_; my @s = split(/ +/, $s); my $f = {}; $f->{name} = shift @s; $f->{name} = $1 if ($f->{name} =~ /(.*)/); # detaint XXX for (@s) { my ($k, $v) = split(/=/, $_, 2); $f->{$k} = $v; # special processing for permissions etc, here? } $f->{o} = unquote($f->{o}); $f->{g} = unquote($f->{g}); $f->{acl} = unquote($f->{acl}); return $f; } sub present { my ($self, $f) = @_; return unless $self->{last_backup}; my $st = lstat("$self->{last_backup}/$f->{name}"); return unless $st; if ($st->mtime == $f->{m} && $st->size == $f->{s} && uid2name($st->uid) eq $f->{o} && uid2name($st->gid) eq $f->{g} && mode2acl($st->mode) eq $f->{acl} && (($st->mode & 04000) == ($f->{setuid} || 0) * 04000) && (($st->mode & 02000) == ($f->{setgid} || 0) * 02000) && (($st->mode & 01000) == ($f->{sticky} || 0) * 01000) ) { return 1; } else { return 0; } } sub mkdir_p { my ($dir, $perm) = @_; $perm = 0777 unless(defined($perm)); if (-d $dir) { return 1; } elsif (mkdir($dir, $perm)) { return 1; } elsif ($!{ENOENT}) { my $parentdir = $dir; $parentdir =~ s|(.*)/.+|$1|; mkdir_p($parentdir, $perm); if (-d $dir) { return 1; } else { return mkdir($dir, $perm); } } else { return undef; } } sub basedir { my ($self, $dir) = @_; $self->{basedir} = $dir if defined($dir); return $self->{basedir}; } sub targets { my ($self, $targets) = @_; $self->{targets} = $targets if defined($targets); return $self->{targets}; } sub add_target { my ($self, $target) = @_; push @{ $self->{targets} }, $target; return $self->{targets}; } # vim: tw=0 expandtab 1;