simba/lib/Simba/CA.pm

#!/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;