view release on metacpan or  search on metacpan

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

package Brackup::Restore;
use strict;
use warnings;
use Carp qw(croak);
use Digest::SHA1;
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) {

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

            }
            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
        $it->{Mode} ||= ($type eq 'd' ? $meta->{DefaultDirMode} : $meta->{DefaultFileMode});
        $it->{UID}  ||= $meta->{DefaultUID};
        $it->{GID}  ||= $meta->{DefaultGID};

        warn " * restoring $path_escaped to $full_escaped\n" if $self->{verbose};
        $self->_restore_link     ($full, $it) if $type eq "l";
        $self->_restore_directory($full, $it) if $type eq "d";
        $self->_restore_fifo     ($full, $it) if $type eq "p";
        $self->_restore_file     ($full, $it) if $type eq "f";

        $self->_chown($full, $it, $type, $meta) if $it->{UID} || $it->{GID};
    }

    # clear chunk cached by _restore_file
    delete $self->{_cached_dig};
    delete $self->{_cached_dataref};

    if ($restore_count) {
        warn " * fixing stat info\n" if $self->{verbose};
        $self->_exec_statinfo_updates;
        warn " * done\n" if $self->{verbose};
        return 1;
    } else {
        die "nothing found matching '$self->{prefix}'.\n" if $self->{prefix};
        die "nothing found to restore.\n";
    }
}

sub _lookup_remote_uid {
    my ($self, $remote_uid, $meta) = @_;

    return $self->{_local_uid_map}->{$remote_uid} 
        if defined $self->{_local_uid_map}->{$remote_uid};

    # meta remote user map - remote_uid => remote username
    $self->{_remote_user_map} ||= { map { split /:/, $_, 2 } split /\s+/, $meta->{UIDMap} };

    # try and lookup local uid using remote username
    if (my $remote_user = $self->{_remote_user_map}->{$remote_uid}) {
        my $local_uid = getpwnam($remote_user);
        return $self->{_local_uid_map}->{$remote_uid} = $local_uid
            if defined $local_uid;
    }

    # if remote username missing locally, fallback to $remote_uid
    return $self->{_local_uid_map}->{$remote_uid} = $remote_uid;
}

sub _lookup_remote_gid {
    my ($self, $remote_gid, $meta) = @_;

    return $self->{_local_gid_map}->{$remote_gid} 
        if defined $self->{_local_gid_map}->{$remote_gid};

    # meta remote group map - remote_gid => remote group
    $self->{_remote_group_map} ||= { map { split /:/, $_, 2 } split /\s+/, $meta->{GIDMap} };

    # try and lookup local gid using remote group
    if (my $remote_group = $self->{_remote_group_map}->{$remote_gid}) {
        my $local_gid = getgrnam($remote_group);
        return $self->{_local_gid_map}->{$remote_gid} = $local_gid
            if defined $local_gid;
    }

    # if remote group missing locally, fallback to $remote_gid
    return $self->{_local_gid_map}->{$remote_gid} = $remote_gid;
}

sub _chown {
    my ($self, $full, $it, $type, $meta) = @_;

    my $uid = $self->_lookup_remote_uid($it->{UID}, $meta) if $it->{UID};
    my $gid = $self->_lookup_remote_gid($it->{GID}, $meta) if $it->{GID};

    if ($type eq 'l') {
        if (! defined $self->{_lchown}) {
            no strict 'subs';
            $self->{_lchown} = eval { require Lchown } && Lchown::LCHOWN_AVAILABLE;
        }
        if ($self->{_lchown}) {
            Lchown::lchown($uid, -1, $full) if defined $uid;
            Lchown::lchown(-1, $gid, $full) if defined $gid;
        }
    } else {
        # ignore errors, but change uid and gid separately to sidestep unprivileged failures
        chown $uid, -1, $full if defined $uid;
        chown -1, $gid, $full if defined $gid;
    }
}

sub _update_statinfo {
    my ($self, $full, $it) = @_;

    push @{ $self->{_stats_to_run} }, sub {
        if (defined $it->{Mode}) {
            chmod(oct $it->{Mode}, $full) or
                die "Failed to change mode of $full: $!";
        }

        if ($it->{Mtime} || $it->{Atime}) {
            utime($it->{Atime} || $it->{Mtime},
                  $it->{Mtime} || $it->{Atime},
                  $full) or
                die "Failed to change utime of $full: $!";
        }
    };
}

sub _exec_statinfo_updates {
    my $self = shift;

    # change the modes/times in backwards order, going from deep
    # files/directories to shallow ones.  (so we can reliably change
    # all the directory mtimes without kernel doing it for us when we
    # modify files deeper)
    while (my $sb = pop @{ $self->{_stats_to_run} }) {
        $sb->();
    }
}

sub _restore_directory {
    my ($self, $full, $it) = @_;

    unless (-d $full) {
        mkdir $full or    # FIXME: permissions on directory
            die "Failed to make directory: $full ($it->{Path})";
    }

    $self->_update_statinfo($full, $it);
}

sub _restore_link {
    my ($self, $full, $it) = @_;

    if (-e $full) {
        # TODO: add --conflict={skip,overwrite} option, defaulting to nothing: which dies
        die "Link $full ($it->{Path}) already exists.  Aborting.";
    }
    symlink $it->{Link}, $full
        or die "Failed to link";
}

sub _restore_fifo {
    my ($self, $full, $it) = @_;

    if (-e $full) {
        die "Named pipe/fifo $full ($it->{Path}) already exists.  Aborting.";