view release on metacpan or  search on metacpan

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

use POSIX qw(mkfifo);
use Fcntl qw(O_RDONLY O_CREAT O_WRONLY O_TRUNC);
use String::Escape qw(unprintable);
use Brackup::DecryptedFile;
use Brackup::Decrypt;

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

    $self->{to}      = delete $opts{to};      # directory we're restoring to
    $self->{prefix}  = delete $opts{prefix};  # directory/file filename prefix, or "" for all
    $self->{filename}= delete $opts{file};    # filename we're restoring from
    $self->{config}  = delete $opts{config};  # brackup config (if available)
    $self->{verbose} = delete $opts{verbose};

    $self->{_local_uid_map} = {};  # remote/metafile uid -> local uid
    $self->{_local_gid_map} = {};  # remote/metafile gid -> local gid

    $self->{prefix} =~ s/\/$// if $self->{prefix};

    $self->{_stats_to_run} = [];  # stack (push/pop) of subrefs to reset stat info on

    die "Destination directory doesn't exist" unless $self->{to} && -d $self->{to};
    croak("Unknown options: " . join(', ', keys %opts)) if %opts;

    $self->{metafile} = Brackup::DecryptedFile->new(filename => $self->{filename});

    return $self;
}

# returns a hashref of { "foo" => "bar" } from { ..., "Driver-foo" => "bar" }
sub _driver_meta {
    my $src = shift;
    my $ret = {};
    foreach my $k (keys %$src) {
        next unless $k =~ /^Driver-(.+)/;
        $ret->{$1} = $src->{$k};
    }
    return $ret;
}

sub restore {
    my ($self) = @_;
    my $parser = $self->parser;
    my $meta = $parser->readline;
    my $driver_class = $meta->{BackupDriver};
    die "No driver specified" unless $driver_class;

    my $driver_meta = _driver_meta($meta);

    my $confsec;
    if ($self->{config} && $meta->{TargetName}) {
        $confsec = eval { $self->{config}->get_section('TARGET:' . $meta->{TargetName}) };
    }
    # If no config section, use an empty one up with no keys to simplify Target handling
    $confsec ||= Brackup::ConfigSection->new('fake');

    eval "use $driver_class; 1;" or die
        "Failed to load driver ($driver_class) to restore from: $@\n";
    my $target = eval {"$driver_class"->new_from_backup_header($driver_meta, $confsec); };
    if ($@) {
        die "Failed to instantiate target ($driver_class) for restore. Perhaps it doesn't support restoring yet?\n\nThe error was: $@";
    }
    $self->{_target} = $target;
    $self->{_meta}   = $meta;

    # handle absolute prefixes by stripping off RootPath to relativise
    if ($self->{prefix} && $self->{prefix} =~ m/^\//) {
        $self->{prefix} =~ s/^\Q$meta->{RootPath}\E\/?//;
    }

    # we first process directories, then files sorted by their first chunk,
    # then the rest. The file sorting allows us to avoid loading composite 
    # chunks and identical single chunk files multiple times from the target
    # (see _restore_file)
    my (@dirs, @files, @rest);
    while (my $it = $parser->readline) {
        my $type = $it->{Type} || 'f';
        if($type eq 'f') {
            # find dig of first chunk
            ($it->{Chunks} || '') =~ /^(\S+)/;
            my ($offset, $len, $enc_len, $dig) = split(/;/, $1 || '');
            $it->{fst_dig} = $dig || '';
            push @files, $it;
        } elsif($type eq 'd') {
            push @dirs, $it;
        } else {
            push @rest, $it;
        }
    }
    @files = sort { $a->{fst_dig} cmp $b->{fst_dig} } @files;

    my $restore_count = 0;
    for my $it (@dirs, @files, @rest) {
        my $type = $it->{Type} || "f";
        my $path = unprintable($it->{Path});
        my $path_escaped = $it->{Path};
        my $path_escaped_stripped = $it->{Path};
        die "Unknown filetype: type=$type, file: $path_escaped" unless $type =~ /^[ldfp]$/;

        if ($self->{prefix}) {
            next unless $path =~ m/^\Q$self->{prefix}\E(?:\/|$)/;
            # if non-dir and $path eq $self->{prefix}, strip all but last component
            if ($type ne 'd' && $path =~ m/^\Q$self->{prefix}\E\/?$/) {
                if (my ($leading_prefix) = ($self->{prefix} =~ m/^(.*\/)[^\/]+\/?$/)) {
                    $path =~ s/^\Q$leading_prefix\E//;
                    $path_escaped_stripped =~ s/^\Q$leading_prefix\E//;
                }
            }
            else {
                $path =~ s/^\Q$self->{prefix}\E\/?//;
                $path_escaped_stripped =~ s/^\Q$self->{prefix}\E\/?//;
            }
        }

        $restore_count++;
        my $full = $self->{to} . "/" . $path;
        my $full_escaped = $self->{to} . "/" . $path_escaped_stripped;

        # restore default modes/user/group from header