path: root/borg-restore.pl

#!/usr/bin/perl -T
use warnings;
use strict;

=head1 NAME

borg-restore.pl - Restore paths from borg backups

=head1 DESCRIPTION

borg-restore.pl helps to restore files from borg backups.

It takes one path, looks for its backups, shows a list of distinct versions and
allows to select one to be restored. Versions are based on the modification
time of the file.

It is also possible to specify a time for automatic selection of the backup
that has to be restored. If a time is specified, the script will automatically
select the newest backup that is at least as old as the time value that is
passed and restore it without further user interaction.

B<borg-restore.pl --update-cache> has to be executed regularly, ideally after
creating or removing backups.

=cut

=head1 OPTIONS

=over 4

=item B<--help>, B<-h>

Show help message.

=item B<--debug>

Enable debug messages.

=item B<--update-cache>, B<-u>

Update the lookup database. You should run this after creating or removing a backup.

=item B<--destination=>I<path>, B<-d=>I<path>

Restore the backup to 'path' instead of its original location. The destination
either has to be a directory or missing in which case it will be created. The
backup will then be restored into the directory with its original file or
directory name.

=item B<--time=>I<timespec>, B<-t=>I<timespec>

Automatically find the newest backup that is at least as old as I<timespec>
specifies. I<timespec> is a string of the form "<I<number>><I<unit>>" with I<unit> being one of the following:
s (seconds), min (minutes), h (hours), d (days), m (months = 31 days), y (year). Example: 5.5d

=back

=head1 SYNOPSIS

borg-restore.pl [options] <path>

 Options:
  --help, -h                 short help message
  --debug                    show debug messages
  --update-cache, -u         update cache files
  --destination, -d <path>   Restore backup to directory <path>
  --time, -t <timespec>      Automatically find newest backup that is at least
                             <time spec> old

 Time spec:
  Select the newest backup that is at least <time spec> old.
  Format: <number><unit>
  Units: s (seconds), min (minutes), h (hours), d (days), m (months = 31 days), y (year)

=cut

use v5.10;

package main;

use autodie;
use Carp::Assert;
use Cwd qw(abs_path getcwd);
use Data::Dumper;
use DateTime;
use DB_File;
use File::Basename;
use File::Copy;
use File::Path qw(mkpath);
use File::Slurp;
use File::Spec;
use File::Temp;
use Getopt::Long;
use IO::Compress::Gzip qw($GzipError);
use IPC::Run qw(run start);
use List::MoreUtils qw(firstidx);
use List::Util qw(any all);
use MLDBM qw(GDBM_File Storable);
use Pod::Usage;
use Storable;
use Time::HiRes;

my %opts;
my %db;
my $cache_path_base = "/home/flo/.cache/borg-restore.pl";
my @backup_prefixes = (
	{regex => "^/home/", replacement => "mnt/snapshots/vg0-homeborg/"},
	{regex => "^/boot/", replacement => ""},
	{regex => "^/", replacement => "mnt/snapshots/vg0-rootborg/"},
);

sub debug {
	say STDERR @_ if $opts{debug};
}

sub untaint {
	my $data = shift;
	my $regex = shift;

	$data =~ m/^($regex)$/ or die "Failed to untaint: $data";
	return $1;
}

sub borg_list {
	my @archives;

	run [qw(borg list)], '>', \my $output or die "borg list returned $?";

	for (split/^/, $output) {
		if (m/^([^\s]+)\s/) {
			push @archives, $1;
		}
	}

	return \@archives;
}

sub find_archives {
	my $path = shift;

	my $archives = retrieve get_cache_path('archive_list') or die "Failed to read cache file: $!";

	tie %db, 'MLDBM', get_cache_path("archives.db"), O_RDWR, 0600 or die "Failed to open database: $!";
	my $modtimes = $db{$path};
	untie %db;

	my %seen_modtime;
	my @ret;

	debug("All modification times from the database:\n", Dumper($modtimes));

	debug("Building unique archive list");

	for my $archive (@$archives) {
		my $modtime = $$modtimes[get_archive_index($archive, $archives)];

		if (defined($modtime) && (!$seen_modtime{$modtime}++)) {
			push @ret, {
				modification_time => $modtime,
				archive => $archive,
			};
		}
	}

	if (!@ret) {
		printf "\e[0;91mWarning:\e[0m Path '%s' not found in any archive.\n", $path;
	}

	@ret = sort { $a->{modification_time} cmp $b->{modification_time} } @ret;

	return \@ret;
}

sub user_select_archive {
	my $archives = shift;

	my $selected_archive;

	my $counter = 0;

	if (!@$archives) {
		return undef;
	}

	for my $archive (@$archives) {
		printf "\e[0;33m%3d: \e[1;33m%s\e[0m %s\n", $counter++, format_timestamp($archive->{modification_time}), $archive->{archive};
	}

	printf "\e[0;34m%s: \e[0m", "Enter ID to restore (Enter to skip)";
	my $selection = <STDIN>;
	return undef if !defined($selection);
	chomp $selection;

	return undef unless ($selection =~ /^\d+$/ && defined(${$archives}[$selection]));
	return ${$archives}[$selection];
}

sub select_archive_timespec {
	my $archives = shift;
	my $timespec = shift;

	my $seconds = timespec_to_seconds($timespec);
	if (!defined($seconds)) {
		say STDERR "Error: Invalid time specification";
		return undef;
	}

	my $target_timestamp = time - $seconds;

	debug("Searching for newest archive that contains a copy before ", format_timestamp($target_timestamp));

	for my $archive (reverse @$archives) {
		if ($archive->{modification_time} < $target_timestamp) {
			return $archive;
		}
	}

	return undef;
}

sub format_timestamp {
	my $timestamp = shift;

	state $timezone = DateTime::TimeZone->new( name => 'local' );
	my $dt = DateTime->from_epoch(epoch => $timestamp, time_zone => $timezone);
	return $dt->strftime("%a. %F %H:%M:%S %z");
}

sub timespec_to_seconds {
	my $timespec = shift;

	if ($timespec =~ m/^(?<value>[0-9.]+)(?<unit>.+)$/) {
		my $value = $+{value};
		my $unit = $+{unit};

		my %factors = (
			s       => 1,
			second  => 1,
			seconds => 1,
			minute  => 60,
			minutes => 60,
			h       => 60*60,
			hour    => 60*60,
			hours   => 60*60,
			d       => 60*60*24,
			day     => 60*60*24,
			days    => 60*60*24,
			m       => 60*60*24*31,
			month   => 60*60*24*31,
			months  => 60*60*24*31,
			y       => 60*60*24*365,
			year    => 60*60*24*365,
			years   => 60*60*24*365,
		);

		if (exists($factors{$unit})) {
			return $value * $factors{$unit};
		}
	}

	return undef;
}

sub restore {
	my $path = shift;
	my $archive = shift;
	my $destination = shift;

	$destination = untaint($destination, qr(.*));
	$path = untaint($path, qr(.*));

	printf "Restoring %s to %s from archive %s\n", $path, $destination, $archive->{archive};

	my $basename = basename($path);
	my $components_to_strip =()= $path =~ /\//g;

	debug(sprintf("CWD is %s", getcwd()));
	debug(sprintf("Changing CWD to %s", $destination));
	mkdir($destination) unless -d $destination;
	chdir($destination) or die "Failed to chdir: $!";

	my $final_destination = abs_path($basename);
	$final_destination = untaint($final_destination, qr(.*));
	debug("Removing ".$final_destination);
	File::Path::remove_tree($final_destination);
	system(qw(borg extract -v --strip-components), $components_to_strip, "::".$archive->{archive}, $path);
}

sub get_cache_dir {
	return "$cache_path_base/v1";
}

sub get_cache_path {
	my $item = shift;
	return get_cache_dir()."/$item";
}

sub get_temp_path {
	my $item = shift;

	state $tempdir_obj = File::Temp->newdir();

	my $tempdir = $tempdir_obj->dirname;

	return $tempdir."/".$item;
}

sub add_path_to_hash {
	my $hash = shift;
	my $path = shift;
	my $time = shift;

	my @components = split /\//, $path;

	my $node = $hash;

	if ($path eq ".") {
		if ($time > $$node[1]) {
			$$node[1] = $time;
		}
		return;
	}

	# each node is an arrayref of the format [$hashref_of_children, $mtime]
	# $hashref_of_children is undef if there are no children
	for my $component (@components) {
		if (!defined($$node[0]->{$component})) {
			$$node[0]->{$component} = [undef, $time];
		}
		# update mtime per child
		if ($time > $$node[1]) {
			$$node[1] = $time;
		}
		$node = $$node[0]->{$component};
	}
}

sub get_missing_items {
	my $have = shift;
	my $want = shift;

	my $ret = [];

	for my $item (@$want) {
		my $exists = any { $_ eq $item } @$have;
		push @$ret, $item if not $exists;
	}

	return $ret;
}

sub get_archive_index {
	my $archive = shift;
	my $archives = shift;

	return firstidx(sub { $_ eq $archive }, @$archives);
}

sub handle_removed_archives {
	my $archives = shift;
	my $previous_archives = shift;
	my $borg_archives = shift;

	my $start = Time::HiRes::gettimeofday();

	# TODO this name is slightly confusing, but it works as expected and
	# returns elements that are in the previous list, but missing in the new
	# one
	my $remove_archives = get_missing_items($borg_archives, $previous_archives);

	if (@$remove_archives) {
		for my $archive (@$remove_archives) {
			my $archive_index = get_archive_index($archive, $archives);
			debug(sprintf("Removing archive %s at index %d", $archive, $archive_index));
			assert($archive_index >= 0) if DEBUG;

			splice @$archives, $archive_index, 1;
			while (my ($path, $data) = each %db) {
				# TODO remove archive indexes all at once
				if (@$data > 0) {
					if (exists($$data[$archive_index])) {
						splice @$data, $archive_index, 1;
						$db{$path} = sanitize_db_data($data);
					}

					if (@$data == 0) {
						delete $db{$path};
					}
					assert(@$data <= @$archives) if DEBUG;
				}
			}
			save_database($archives);
		}

		clean_db($archives);
		save_database($archives);

		my $end = Time::HiRes::gettimeofday();
		debug(sprintf("Removing archives finished after: %.5fs", $end - $start));
	}
}

sub sanitize_db_data {
	my $data = shift;

	my @ret;

	for my $item (@$data) {
		if (defined($item)) {
			push @ret, $item + 0;
		} else {
			push @ret, undef;
		}
	}

	return \@ret;
}

sub handle_added_archives {
	my $archives = shift;
	my $borg_archives = shift;

	my $add_archives = get_missing_items($archives, $borg_archives);

	for my $archive (@$add_archives) {
		push @$archives, $archive;
		my $start = Time::HiRes::gettimeofday();
		my $archive_index = get_archive_index($archive, $archives);
		my $lookuptable = [{}, 0];

		debug(sprintf("Adding archive %s at index %d", $archive, $archive_index));

		my $proc = start [qw(borg list --list-format), '{isomtime} {path}{NEWLINE}', "::".$archive], ">pipe", \*OUT;
		while (<OUT>) {
			# roll our own parsing of timestamps for speed since we will be parsing
			# a huge number of lines here
			# example timestamp: "Wed, 2016-01-27 10:31:59"
			if (m/^.{4} (?<year>....)-(?<month>..)-(?<day>..) (?<hour>..):(?<minute>..):(?<second>..) (?<path>.+)$/) {
				my $time = POSIX::mktime($+{second},$+{minute},$+{hour},$+{day},$+{month}-1,$+{year}-1900);
				#debug(sprintf("Adding path %s with time %s", $+{path}, $time));
				add_path_to_hash($lookuptable, $+{path}, $time);
			}
		}
		$proc->finish() or die "borg list returned $?";

		save_node($archives, $archive_index,  undef, $lookuptable);

		save_database($archives);

		my $end = Time::HiRes::gettimeofday();
		debug(sprintf("Adding archive finished after: %.5fs", $end - $start));
	}
}

sub save_database {
	my $archives = shift;

	my $db_path = get_cache_path('archives.db');
	my $db_path_tmp = get_temp_path('archives.db.tmp');
	my $db_path_new = get_cache_path('archives.db.new');
	my $archive_cache = get_cache_path('archive_list');
	my $archive_cache_tmp = get_temp_path('archive_list.tmp');
	my $archive_cache_new = get_cache_path('archive_list.new');

	debug("Saving temporary database to permanent location");

	untie %db;

	compact_db($db_path_tmp);

	store $archives, $archive_cache_tmp or die "Failed to save archive list to cache: $!";

	cp($archive_cache_tmp, $archive_cache_new);
	cp($db_path_tmp, $db_path_new);

	unlink($archive_cache) if -e $archive_cache;
	unlink($db_path) if -e $db_path;

	move($archive_cache_new, $archive_cache);
	move($db_path_new, $db_path);

	open_db_rw($db_path_tmp);
}

sub build_archive_cache {
	my $borg_archives = borg_list();
	my $db_path = get_cache_path('archives.db');
	my $db_path_tmp = get_temp_path('archives.db.tmp');
	my $archive_cache = get_cache_path('archive_list');
	my $previous_archives = [];
	my $archives = [];

	if (! -f $db_path and ! -f $archive_cache) {
		debug("Unable to find both, archive list and database. Creating new ones");
	} else {
		$previous_archives = retrieve $archive_cache or die "Failed to read archive list from cache: $!";
	}

	# start with the contents of the cache file and update it as we change the db
	$archives = $previous_archives;

	# ensure the cache directory exists
	mkpath(get_cache_dir(), {mode => 0700});

	if (-f $db_path) {
		debug("Creating temporary database copy");
		cp($db_path, $db_path_tmp) or die "Failed to create temporary database copy: $!";
	}

	open_db_rw($db_path_tmp);

	handle_removed_archives($archives, $previous_archives, $borg_archives);
	handle_added_archives($archives, $borg_archives);

	if ($opts{debug}) {
		debug(sprintf("DB contains information for %d archives", scalar(@$archives)));
		run([qw(echo count)], '|', ['gdbmtool', $db_path]);
	}

	untie %db;
}

sub open_db_rw {
	my $db_path = shift;

	tie %db, 'MLDBM', $db_path, O_RDWR|O_CREAT, 0600 or die "Failed to open db file: $!";
}

sub cp {
	run([qw(cp -p), @_]);
}

sub save_node {
	my $archives = shift;
	my $archive_index = shift;
	my $prefix = shift;
	my $node = shift;

	for my $child (keys %{$$node[0]}) {
		my $path;
		$path = $prefix."/" if defined($prefix);
		$path .= $child;

		my $data = $db{$path};

		if (!defined($data)) {
			$data = [];
		}
		$$data[$archive_index] = $$node[0]->{$child}[1];

		assert(@$data == @$archives) if DEBUG;
		$db{$path} = sanitize_db_data($data);

		save_node($archives, $archive_index, $path, $$node[0]->{$child});
	}
}

sub get_mtime_from_lookuptable {
	my $lookuptable = shift;
	my $path = shift;

	my @components = split /\//, $path;
	my $node = $lookuptable;

	for my $component (@components) {
		$node = $$node[0]->{$component};
		if (!defined($node)) {
			return undef;
		}
	}
	return $$node[1];
}

sub clean_db {
	my $archives = shift;

	while (my ($path, $data) = each %db) {
		# check if data is empty or all fields in data are undef
		if (!@$data || all { !defined($_) } @$data) {
			debug("Deleting path because it's not part of any archive: ", $path);
			delete $db{$path};
		}
		assert(@$data <= @$archives) if DEBUG;
	}
}

sub compact_db {
	my $db_path = shift;

	run([qw(echo reorganize)], "|", ["gdbmtool", $db_path], "2>", \my $output) or die "Failed to reorganize database: $!";
	print($output) if $opts{debug};
}

sub update_cache {
	debug("Checking if cache is complete");
	build_archive_cache();
	debug("Cache complete");
}

sub main {
	# untaint PATH because we only expect this to run as root
	$ENV{PATH} = untaint($ENV{PATH}, qr(.*));

	Getopt::Long::Configure ("bundling");
	GetOptions(\%opts, "help|h", "debug", "update-cache|u", "destination|d=s", "time|t=s") or pod2usage(2);
	pod2usage(0) if $opts{help};

	if ($opts{"update-cache"}) {
		update_cache();
		return 0;
	}

	pod2usage(-verbose => 0) if (@ARGV== 0);

	my @paths = @ARGV;

	my $path;
	my $timespec;
	my $destination;

	$path = $ARGV[0];

	if (defined($opts{destination})) {
		$destination = $opts{destination};
	}

	if (defined($opts{time})) {
		$timespec = $opts{time};
	}

	if (@ARGV > 1) {
		say STDERR "Error: Too many arguments";
		exit(1);
	}

	my $canon_path = File::Spec->canonpath($path);
	my $abs_path = abs_path($canon_path);
	if (!defined($abs_path)) {
		say STDERR "Error: Failed to resolve path to absolute path: $canon_path: $!";
		say STDERR "Make sure that all parts of the path, except the last one, exist.";
		exit(1);
	}

	if (!defined($destination)) {
		$destination = dirname($abs_path);
	}
	my $backup_path = $abs_path;
	for my $backup_prefix (@backup_prefixes) {
		if ($backup_path =~ m/$backup_prefix->{regex}/) {
			$backup_path =~ s/$backup_prefix->{regex}/$backup_prefix->{replacement}/;
			last;
		}
	}

	debug("Asked to restore $backup_path to $destination");

	my $archives = find_archives($backup_path);

	my $selected_archive;

	if (defined($timespec)) {
		$selected_archive = select_archive_timespec($archives, $timespec);
	} else {
		$selected_archive = user_select_archive($archives);
	}

	if (!defined($selected_archive)) {
		say STDERR "Error: No archive selected or selection invalid";
		return 1;
	}

	restore($backup_path, $selected_archive, $destination);

	return 0;
}

exit main()