App-BorgRestore
view release on metacpan or search on metacpan
extension. For example a '/lib' symlink and '/lib64'. '/lib' would be
missing from the database.
3.4.1 2020-09-27T12:57:01Z
- Fix missing cache data for files that exist with and without an
extension. For example '/home/*/.ssh/id_rsa' would be missing from the
database and only the accompanying `id_rsa.pub` file would be contained
in the database.
3.4.0 2019-09-28T13:28:49Z
- Remove archive name untaint restrictions (remove untaint_archive_name
function)
3.3.0 2019-02-07T16:18:41Z
- Support borg list's --prefix option via $borg_prefix setting
- Properly handle cases where the DB is empty after removal of archive
information
3.2.1 2018-11-01T12:54:26Z
- Add missing version requirement to List::Util dependency
lib/App/BorgRestore.pm view on Meta::CPAN
package App::BorgRestore;
use v5.14;
use strictures 2;
our $VERSION = "3.4.5";
use App::BorgRestore::Borg;
use App::BorgRestore::DB;
use App::BorgRestore::Helper qw(untaint);
use App::BorgRestore::PathTimeTable::DB;
use App::BorgRestore::PathTimeTable::Memory;
use App::BorgRestore::Settings;
use autodie;
use Carp;
use Cwd qw(abs_path getcwd);
use Path::Tiny;
use File::pushd;
use Function::Parameters;
lib/App/BorgRestore.pm view on Meta::CPAN
If the destination path (C<$destination/$last_elem_of_backup_path>) exists, it
is removed before beginning extraction from the backup.
Warning: This method temporarily modifies the current working directory of the
process during method execution since this is required by C<`borg extract`>.
=cut
method restore($path, $archive, $destination) {
$destination = untaint($destination, qr(.*));
$path = untaint($path, qr(.*));
$log->infof("Restoring %s to %s from archive %s", $path, $destination, $archive->{archive});
my $basename = path($path)->basename;
my $components_to_strip =()= $path =~ /\//g;
$log->debugf("CWD is %s", getcwd());
{
$log->debugf("Changing CWD to %s", $destination);
mkdir($destination) unless -d $destination;
my $workdir = pushd($destination, {untaint_pattern => qr{^(.*)$}});
my $final_destination = abs_path($basename);
$final_destination = untaint($final_destination, qr(.*));
$log->debugf("Removing %s", $final_destination);
File::Path::remove_tree($final_destination);
$self->{deps}->{borg}->restore($components_to_strip, $archive->{archive}, $path);
}
$log->debugf("CWD is %s", getcwd());
}
=head3 restore_simple
$app->restore_simple($path, $timespec, $destination);
lib/App/BorgRestore/Borg.pm view on Meta::CPAN
package App::BorgRestore::Borg;
use v5.14;
use strictures 2;
use App::BorgRestore::Helper qw(untaint);
use autodie;
use Date::Parse;
use Function::Parameters;
use IPC::Run qw(run start new_chunker);
use JSON;
use Log::Any qw($log);
use Version::Compare;
=encoding utf-8
lib/App/BorgRestore/Borg.pm view on Meta::CPAN
}
}
$log->warning("No archives detected in borg output. Either you have no backups or this is a bug") if @archives == 0;
return \@archives;
}
method restore($components_to_strip, $archive_name, $path) {
$log->debugf("Restoring '%s' from archive %s, stripping %d components of the path", $path, $archive_name, $components_to_strip);
$archive_name = untaint($archive_name, qr(.*));
system(qw(borg extract -v --strip-components), $components_to_strip, $self->{borg_repo}."::".$archive_name, $path);
}
method list_archive($archive, $cb) {
$log->debugf("Fetching file list for archive %s", $archive);
my $fh;
if (Version::Compare::version_compare($self->{borg_version}, "1.1") >= 0) {
open ($fh, '-|', 'borg', qw/list --format/, '{mtime} {path}{NEWLINE}', $self->{borg_repo}."::".$archive);
} else {
lib/App/BorgRestore/DB.pm view on Meta::CPAN
package App::BorgRestore::DB;
use v5.14;
use strictures 2;
use App::BorgRestore::Helper qw(untaint);
use autodie;
use DBI;
use Function::Parameters;
use Log::Any qw($log);
use Number::Bytes::Human qw(format_bytes);
use Path::Tiny;
=encoding utf-8
lib/App/BorgRestore/DB.pm view on Meta::CPAN
$self->{dbh}->do('insert into `archives` select null, * from `archives_old`');
$self->{dbh}->do('drop table `archives_old`');
my $st = $self->{dbh}->prepare("select `archive_name` from `archives`;");
$st->execute();
while (my $result = $st->fetchrow_hashref) {
my $archive = $result->{archive_name};
# We trust all values here since they have already been
# sucessfully put into the DB previously. Thus they must be
# safe to deal with.
$archive = untaint($archive, qr(.*));
my $archive_id = $self->get_archive_id($archive);
$self->{dbh}->do("alter table `files` rename column `timestamp-$archive` to `$archive_id`");
}
},
3 => sub {
# Drop all cached files due to a bug in
# lib/App/BorgRestore/PathTimeTable/DB.pm that caused certain files
# to be skipped rather than being added to the `files` table.
$self->{dbh}->do('delete from `archives`');
$self->{dbh}->do('delete from `files`');
lib/App/BorgRestore/DB.pm view on Meta::CPAN
# Remove columns left over by migrations 3 and 4 from files tables
my @archive_ids;
my $st = $self->{dbh}->prepare("select `id` from `archives`;");
$st->execute();
while (my $result = $st->fetchrow_hashref) {
push @archive_ids, $result->{id};
}
$self->{dbh}->do('create table `files_new` (`path` text, primary key (`path`)) without rowid;');
for my $archive_id (@archive_ids) {
$archive_id = untaint($archive_id, qr(.*));
$self->{dbh}->do('alter table `files_new` add column `'.$archive_id.'` integer;');
}
if (@archive_ids > 0) {
my @columns_to_copy = map {'`'.$_.'`'} @archive_ids;
@columns_to_copy = ('`path`', @columns_to_copy);
$self->{dbh}->do('insert into `files_new` select '.join(',', @columns_to_copy).' from files');
}
$self->{dbh}->do('drop table `files`');
lib/App/BorgRestore/DB.pm view on Meta::CPAN
method get_archive_row_count() {
my $st = $self->{dbh}->prepare("select count(*) count from `files`;");
$st->execute();
my $result = $st->fetchrow_hashref;
return $result->{count};
}
method add_archive_name($archive) {
my $st = $self->{dbh}->prepare('insert into `archives` (`archive_name`) values (?);');
$st->execute(untaint($archive, qr(.*)));
$self->_add_column_to_table("files", $archive);
}
method _add_column_to_table($table, $column) {
my $st = $self->{dbh}->prepare('alter table `'.$table.'` add column `'.$self->get_archive_id($column).'` integer;');
$st->execute();
}
method remove_archive($archive) {
lib/App/BorgRestore/DB.pm view on Meta::CPAN
if (@timestamp_columns_to_copy > 0) {
my $sql = 'delete from `files` where ';
$sql .= join(' is null and ', @timestamp_columns_to_copy);
$sql .= " is null";
my $st = $self->{dbh}->prepare($sql);
$st->execute();
}
my $st = $self->{dbh}->prepare('delete from `archives` where `archive_name` = ?;');
$st->execute(untaint($archive, qr(.*)));
}
method get_archive_id($archive) {
my $st = $self->{dbh}->prepare("select `id` from `archives` where `archive_name` = ?;");
$archive = untaint($archive, qr(.*));
$st->execute($archive);
my $result = $st->fetchrow_hashref;
return untaint($result->{id}, qr(.*));
}
method get_archives_for_path($path) {
my $st = $self->{dbh}->prepare('select * from `files` where `path` = ?;');
$st->execute(untaint($path, qr(.*)));
my @ret;
my $result = $st->fetchrow_hashref;
my $archives = $self->get_archive_names();
for my $archive (@$archives) {
my $archive_id = $self->get_archive_id($archive);
my $timestamp = $result->{$archive_id};
lib/App/BorgRestore/Helper.pm view on Meta::CPAN
package App::BorgRestore::Helper;
use v5.14;
use strictures 2;
use autodie;
use Exporter 'import';
use Function::Parameters;
use POSIX ();
our @EXPORT_OK = qw(untaint);
=encoding utf-8
=head1 NAME
App::BorgRestore::Helper - Helper functions
=head1 DESCRIPTION
App::BorgRestore::Helper provides some general helper functions used in various packages in the L<App::BorgRestore> namespace.
=cut
fun untaint($data, $regex) {
$data =~ m/^($regex)$/ or die "Failed to untaint: $data";
return $1;
}
fun format_timestamp($timestamp) {
return POSIX::strftime "%a. %F %H:%M:%S %z", localtime $timestamp;
}
# XXX: this also exists in BorgRestore::_handle_added_archives()
fun parse_borg_time($string) {
if ($string =~ m/^.{4} (?<year>....)-(?<month>..)-(?<day>..) (?<hour>..):(?<minute>..):(?<second>..)$/) {
lib/App/BorgRestore/Settings.pm view on Meta::CPAN
package App::BorgRestore::Settings;
use v5.14;
use strictures 2;
use App::BorgRestore::Helper qw(untaint);
use autodie;
use Function::Parameters;
use Sys::Hostname;
=encoding utf-8
=head1 NAME
App::BorgRestore::Settings - Settings package
lib/App/BorgRestore/Settings.pm view on Meta::CPAN
=item C<$prepare_data_in_memory>
Default: 0
When new archives are added to the cache, the modification time of each parent
directory for a file's path are updated. If this setting is set to 1, these
updates are done in memory before data is written to the database. If it is set
to 0, any changes are written directly to the database. Many values are updated
multiple time, thus writing directly to the database is slower, but preparing
the data in memory may require a substaintial amount of memory.
New in version 3.2.0. Deprecated in v3.2.0 for future removal possibly in v4.0.0.
=back
=head2 Example Configuration
$borg_repo = "/path/to/repo";
$backup_prefix = "";
$cache_path_base = "/mnt/somewhere/borg-restore.pl-cache";
lib/App/BorgRestore/Settings.pm view on Meta::CPAN
}
load_config_files();
if (not defined $cache_path_base) {
die "Error: \$cache_path_base is not defined. This is most likely because the\n"
."environment variables \$HOME and \$XDG_CACHE_HOME are not set. Consider setting\n"
."the path in the config file or ensure that the variables are set.";
}
$cache_path_base = untaint($cache_path_base, qr/.*/);
return $self;
}
method get_config() {
return {
borg => {
repo => $borg_repo,
backup_prefix => $backup_prefix,
path_prefixes => [@backup_prefixes],
lib/App/BorgRestore/Settings.pm view on Meta::CPAN
fun load_config_files() {
my @configfiles;
if (defined $ENV{XDG_CONFIG_HOME} or defined $ENV{HOME}) {
push @configfiles, sprintf("%s/borg-restore.cfg", $ENV{XDG_CONFIG_HOME} // $ENV{HOME}."/.config");
}
push @configfiles, "/etc/borg-restore.cfg";
for my $configfile (@configfiles) {
$configfile = untaint($configfile, qr/.*/);
if (-e $configfile) {
unless (my $return = do $configfile) {
die "couldn't parse $configfile: $@" if $@;
die "couldn't do $configfile: $!" unless defined $return;
die "couldn't run $configfile" unless $return;
}
}
}
}
script/borg-restore.pl view on Meta::CPAN
$Log::Log4perl::caller_depth + 1;
Log::Log4perl->get_logger()->fatal("Uncaught exception: ".$_[0], @_[1..$#_]);
exit(2);
};
}
sub main {
logger_setup();
my %opts;
# untaint PATH because we do not expect this to be run across user boundaries
$ENV{PATH} = App::BorgRestore::Helper::untaint($ENV{PATH}, qr(.*));
Getopt::Long::Configure ("bundling");
GetOptions(\%opts, "help|h", "debug", "update-cache|u", "destination|d=s", "time|t=s", "adhoc", "version", "list", "quiet", "detail", "json") or pod2usage(2);
pod2usage(0) if $opts{help};
if ($opts{version}) {
printf "Version: %s\n", $App::BorgRestore::VERSION;
return 0;
}
script/borg-restore.pl view on Meta::CPAN
return 0;
}
if ($opts{"list"}) {
my @patterns = @ARGV;
push @patterns, '', if @patterns == 0;
my $json_data = {};
for my $pattern (@patterns) {
$pattern = App::BorgRestore::Helper::untaint($pattern, qr/.*/);
my $paths = $app->search_path($pattern);
for my $path (@$paths) {
my $archives; $archives = $app->find_archives($path) if $opts{detail};
if ($opts{json}) {
$json_data->{$path} = {
path => $path,
archives => $archives,
} unless defined $json_data->{$path};
} else {
( run in 0.343 second using v1.01-cache-2.11-cpan-4e96b696675 )