Brackup

 view release on metacpan or  search on metacpan

lib/Brackup/Backup.pm  view on Meta::CPAN

package Brackup::Backup;
use strict;
use warnings;
use Carp qw(croak);
use Brackup::ChunkIterator;
use Brackup::CompositeChunk;
use Brackup::GPGProcManager;
use Brackup::GPGProcess;
use File::Basename;
use File::Temp qw(tempfile);

sub new {
    my ($class, %opts) = @_;
    my $self = bless {}, $class;

    $self->{root}    = delete $opts{root};     # Brackup::Root
    $self->{target}  = delete $opts{target};   # Brackup::Target
    $self->{dryrun}  = delete $opts{dryrun};   # bool
    $self->{verbose} = delete $opts{verbose};  # bool
    $self->{inventory} = delete $opts{inventory};  # bool
    $self->{savefiles} = delete $opts{savefiles};  # bool
    $self->{zenityprogress} = delete $opts{zenityprogress};  # bool

    $self->{modecounts} = {}; # type -> mode(octal) -> count
    $self->{idcounts}   = {}; # type -> uid/gid -> count

    $self->{_uid_map} = {};   # uid -> username
    $self->{_gid_map} = {};   # gid -> group

    $self->{saved_files} = [];   # list of Brackup::File objects backed up
    $self->{unflushed_files} = [];   # list of Brackup::File objects not in backup_file

    croak("Unknown options: " . join(', ', keys %opts)) if %opts;

    return $self;
}

# returns true (a Brackup::BackupStats object) on success, or dies with error
sub backup {
    my ($self, $backup_file) = @_;

    my $root   = $self->{root};
    my $target = $self->{target};

    my $stats  = Brackup::BackupStats->new;

    my @gpg_rcpts = $self->{root}->gpg_rcpts;

    my $n_kb         = 0.0; # num:  kb of all files in root
    my $n_files      = 0;   # int:  # of files in root
    my $n_kb_done    = 0.0; # num:  kb of files already done with (uploaded or skipped)

    # if we're pre-calculating the amount of data we'll
    # actually need to upload, store it here.
    my $n_files_up   = 0;
    my $n_kb_up      = 0.0;
    my $n_kb_up_need = 0.0; # by default, not calculated/used.

    my $n_files_done = 0;   # int
    my @files;         # Brackup::File objs

    $self->debug("Discovering files in ", $root->path, "...\n");
    $self->report_progress(0, "Discovering files in " . $root->path . "...");
    $root->foreach_file(sub {
        my ($file) = @_;  # a Brackup::File
        push @files, $file;
        $self->record_mode_ids($file);
        $n_files++;
        $n_kb += $file->size / 1024;
    });

    $self->debug("Number of files: $n_files\n");
    $stats->timestamp('File Discovery');
    $stats->set('Number of Files' => $n_files);
    $stats->set('Total File Size' => sprintf('%0.01f MB', $n_kb / 1024));

    # calc needed chunks
    if ($ENV{CALC_NEEDED}) {
        my $fn = 0;
        foreach my $f (@files) {
            $fn++;
            if ($fn % 100 == 0) { warn "$fn / $n_files ...\n"; }
            foreach my $pc ($f->chunks) {
                if ($target->stored_chunk_from_inventory($pc)) {
                    $pc->forget_chunkref;
                    next;
                }
                $n_kb_up_need += $pc->length / 1024;

lib/Brackup/Backup.pm  view on Meta::CPAN

        # store the metafile, encrypted, on the target
        if (@gpg_rcpts) {
            my $encfile = $backup_file . ".enc";
            my @recipients = map {("--recipient", $_)} @gpg_rcpts;
            system($self->{root}->gpg_path, $self->{root}->gpg_args,
                   @recipients,
                   "--trust-model=always",
                   "--batch",
                   "--encrypt", 
                   "--output=$encfile", 
                   "--yes", 
                   $backup_file)
                and die "Failed to run gpg while encryping metafile: $!\n";
            open ($store_fh, $encfile) or die "Failed to open encrypted metafile '$encfile': $!\n";
            $store_filename = $encfile;
            $is_encrypted = 1;
        } else {
            # Reopen $metafh to reset file pointer (no backward seek with IO::Compress::Gzip)
            open($store_fh, $backup_file) or die "Failed to open metafile '$backup_file': $!\n";
            $store_filename = $backup_file;
        }

        # store it on the target
        $self->debug("Storing metafile to " . ref($target));
        my $name = $self->{root}->publicname . "-" . $self->backup_time;
        $target->store_backup_meta($name, $store_fh, { filename => $store_filename, is_encrypted => $is_encrypted });
        $stats->timestamp('Metafile Storage');

        # cleanup encrypted metafile
        if ($is_encrypted) {
            close $store_fh or die "Close on encrypted metafile failed: $!";
            unlink $store_filename;
        }
    }
    $self->report_progress(100, "Backup complete.");

    return $stats;
}

sub default_file_mode {
    my $self = shift;
    return $self->{_def_file_mode} ||= $self->_default_mode('f');
}

sub default_directory_mode {
    my $self = shift;
    return $self->{_def_dir_mode} ||= $self->_default_mode('d');
}

sub _default_mode {
    my ($self, $type) = @_;
    my $map = $self->{modecounts}{$type} || {};
    return (sort { $map->{$b} <=> $map->{$a} } keys %$map)[0];
}

sub default_uid {
    my $self = shift;
    return $self->{_def_uid} ||= $self->_default_id('u');
}

sub default_gid {
    my $self = shift;
    return $self->{_def_gid} ||= $self->_default_id('g');
}

sub _default_id {
    my ($self, $type) = @_;
    my $map = $self->{idcounts}{$type} || {};
    return (sort { $map->{$b} <=> $map->{$a} } keys %$map)[0];
}

# space-separated list of local uid:username mappings
sub uid_map {
    my $self = shift;
    my @map;
    my $uidcounts = $self->{idcounts}{u};
    for my $uid (sort { $a <=> $b } keys %$uidcounts) {
      if (my $name = getpwuid($uid)) {
        push @map, "$uid:$name";
      }
    }
    return join(' ', @map);
}

# space-separated list of local gid:group mappings
sub gid_map {
    my $self = shift;
    my @map;
    my $gidcounts = $self->{idcounts}{g};
    for my $gid (sort { $a <=> $b } keys %$gidcounts) {
      if (my $name = getgrgid($gid)) {
        push @map, "$gid:$name";
      }
    }
    return join(' ', @map);
}

sub backup_time {
    my $self = shift;
    return $self->{backup_time} ||= time();
}

sub backup_header {
    my $self = shift;
    my $ret = "";
    my $now = $self->backup_time;
    $ret .= "BackupTime: " . $now . " (" . localtime($now) . ")\n";
    $ret .= "BackupDriver: " . ref($self->{target}) . "\n";
    if (my $fields = $self->{target}->backup_header) {
        foreach my $k (sort keys %$fields) {
            die "Bogus header field from driver" unless $k =~ /^\w+$/;
            my $val = $fields->{$k};
            next if ! defined $val || $val eq '';   # skip keys with empty values
            die "Bogus header value from driver" if $val =~ /[\r\n]/;
            $ret .= "Driver-$k: $val\n";
        }
    }
    $ret .= "RootName: " . $self->{root}->name . "\n";
    $ret .= "RootPath: " . $self->{root}->path . "\n";
    $ret .= "TargetName: " . $self->{target}->name . "\n";
    $ret .= "DefaultFileMode: " . $self->default_file_mode . "\n";
    $ret .= "DefaultDirMode: " . $self->default_directory_mode . "\n";
    $ret .= "DefaultUID: " . $self->default_uid . "\n";
    $ret .= "DefaultGID: " . $self->default_gid . "\n";
    $ret .= "UIDMap: " . $self->uid_map . "\n";
    $ret .= "GIDMap: " . $self->gid_map . "\n";
    $ret .= "GPG-Recipient: $_\n" for $self->{root}->gpg_rcpts;
    $ret .= "\n";
    return $ret;
}

sub record_mode_ids {
    my ($self, $file) = @_;
    $self->{modecounts}{$file->type}{$file->mode}++;
    $self->{idcounts}{u}{$file->uid}++;
    $self->{idcounts}{g}{$file->gid}++;
}

sub add_unflushed_file {
    my ($self, $file, $handlelist) = @_;
    push @{ $self->{unflushed_files} }, [ $file, $handlelist ];
}   

sub flush_files {
    my ($self, $fh) = @_;
    while (my $rec = shift @{ $self->{unflushed_files} }) {
      next unless $fh;
      my ($file, $stored_chunks) = @$rec;
      print $fh $file->as_rfc822($stored_chunks, $self);
    }
}

sub add_saved_file {
    my ($self, $file, $handlelist) = @_;
    push @{ $self->{saved_files} }, [ $file, $handlelist ];
}   

sub foreach_saved_file {
    my ($self, $cb) = @_;
    foreach my $rec (@{ $self->{saved_files} }) {
        $cb->(@$rec);  # Brackup::File, arrayref of Brackup::StoredChunk
    }
}

sub debug {
    my ($self, @m) = @_;
    return unless $self->{verbose};
    my $line = join("", @m);
    chomp $line;
    print $line, "\n";
}

sub report_progress {
    my ($self, $percent, $message) = @_;

    if ($self->{zenityprogress}) {
        if (defined($message) && length($message) > 100) {
            $message = substr($message, 0, 100)."...";
        }
        print STDOUT "#", $message, "\n" if defined $message;
        print STDOUT $percent, "\n" if defined $percent;
    }
}

1;



( run in 1.512 second using v1.01-cache-2.11-cpan-5735350b133 )