mirror of https://github.com/digint/btrbk
444 lines
14 KiB
Perl
Executable File
444 lines
14 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
=head1 NAME
|
|
|
|
btrbk - backup btrfs volumes at file-system level
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
btrbk --help
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Backup tool for btrfs (sub-)volumes, taking advantage of btrfs
|
|
specific send-receive mechanism, allowing incremental backups at
|
|
file-system level.
|
|
|
|
The full btrbk documentation is available at L<http://www.digint.ch/btrbk>.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Axel Burri <axel@tty0.ch>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (c) 2014 Axel Burri. All rights reserved.
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation, either version 3 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings FATAL => qw( all );
|
|
|
|
use POSIX qw(strftime);
|
|
use File::Path qw(make_path);
|
|
use Getopt::Std;
|
|
use Data::Dumper;
|
|
use Tie::IxHash;
|
|
|
|
our $VERSION = "0.01";
|
|
our $PROJECT_HOME = '<http://www.digint.ch/btrbk>';
|
|
|
|
my $version_info = "btrfs-backup command line client, version $VERSION";
|
|
my $time_format = "%Y%m%d_%H%M%S";
|
|
|
|
my $src_snapshot_dir = "_btrbk_snap";
|
|
|
|
my %vol_info;
|
|
my $dryrun;
|
|
my $verbose = 0;
|
|
my $debug = 0;
|
|
|
|
sub VERSION_MESSAGE
|
|
{
|
|
print STDERR $version_info . "\n\n";
|
|
}
|
|
|
|
sub HELP_MESSAGE
|
|
{
|
|
print STDERR "usage: $0 [options] <src_root_volume> <subvol> <dest_root_volume> <subvol>\n";
|
|
print STDERR "\n";
|
|
print STDERR "options:\n";
|
|
print STDERR " -h, --help display this help message\n";
|
|
print STDERR " --version display version information\n";
|
|
# print STDERR " -i incremental backup\n";
|
|
print STDERR " -c config file\n";
|
|
print STDERR " -v verbose\n";
|
|
print STDERR " -d debug\n";
|
|
print STDERR " -p pretend only (dryrun)\n";
|
|
print STDERR "\n";
|
|
print STDERR "For additional information, see $PROJECT_HOME\n";
|
|
}
|
|
|
|
sub DEBUG { my $t = shift; print STDOUT "DEBUG: $t\n" if($debug); }
|
|
sub INFO { my $t = shift; print STDOUT "$t\n" if($verbose); }
|
|
sub WARN { my $t = shift; print STDOUT "WARN: $t\n"; }
|
|
|
|
sub run_cmd($;$)
|
|
{
|
|
my $cmd = shift;
|
|
my $non_destructive = shift;
|
|
my $ret = "";
|
|
INFO ">>> $cmd" unless($non_destructive);
|
|
if($non_destructive || (not $dryrun)) {
|
|
DEBUG "CMD: $cmd";
|
|
$ret = `$cmd`;
|
|
chomp($ret);
|
|
DEBUG "RET: $ret";
|
|
die("command execution failed: \"$cmd\"") if($?);
|
|
}
|
|
return $ret;
|
|
}
|
|
|
|
sub check_vol($$)
|
|
{
|
|
my $root = shift;
|
|
my $vol = shift;
|
|
die("subvolume info not present: $root") unless(exists($vol_info{$root}));
|
|
foreach (values %{$vol_info{$root}}) {
|
|
return 1 if($_->{FS_PATH} eq "$root/$vol");
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub check_src($$)
|
|
{
|
|
my $root = shift;
|
|
my $vol = shift;
|
|
die("subvolume not found: ${root}/${vol}") unless(check_vol($root, $vol));
|
|
unless($dryrun)
|
|
{
|
|
my $dir = "${root}/${src_snapshot_dir}";
|
|
unless(-d $dir) {
|
|
print "creating directory: $dir\n";
|
|
make_path("${root}/${src_snapshot_dir}");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub check_rootvol($)
|
|
{
|
|
my $vol = shift;
|
|
my $ret = run_cmd("/sbin/btrfs subvolume show $vol", 1);
|
|
if($ret eq "$vol is btrfs root") {
|
|
DEBUG "rootvol check passed: $vol";
|
|
return 1;
|
|
}
|
|
DEBUG "rootvol check failed: $vol";
|
|
return 0;
|
|
}
|
|
|
|
sub parse_config($)
|
|
{
|
|
my $file = shift;
|
|
DEBUG "parsing config file: $file";
|
|
tie my %cfg, "Tie::IxHash";
|
|
open(FILE, '<', $file) or die $!;
|
|
while (<FILE>) {
|
|
chomp;
|
|
next if /^\s*#/; # ignore comments
|
|
DEBUG "parse_config: parsing line: $_";
|
|
if(/^\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/)
|
|
{
|
|
my %job = ( type => "subvol_backup",
|
|
sroot => $1,
|
|
svol => $2,
|
|
droot => $3,
|
|
dvol => $4,
|
|
options => [ split(/,/, $5) ],
|
|
);
|
|
DEBUG(Dumper \%job);
|
|
$job{sroot} =~ s/\/+$//; # remove trailing slash
|
|
$job{sroot} =~ s/^\/+/\//; # sanitize leading slash
|
|
$job{svol} =~ s/\/+$//; # remove trailing slash
|
|
$job{svol} =~ s/^\/+//; # remove leading slash
|
|
die("svol contains slashes: $job{svol}") if($job{svol} =~ /\//);
|
|
|
|
$job{droot} =~ s/\/+$//; # remove trailing slash
|
|
$job{droot} =~ s/^\/+/\//; # sanitize leading slash
|
|
$job{dvol} =~ s/\/+$//; # remove trailing slash
|
|
$job{dvol} =~ s/^\/+//; # remove leading slash
|
|
die("dvol contains slashes: $job{svol}") if($job{svol} =~ /\//);
|
|
|
|
$job{mountpoint} = $job{sroot}; # TODO: honor this, automount
|
|
|
|
DEBUG "parse_config: adding job \"$job{type}\": $job{sroot}/$job{svol} -> $job{droot}/$job{dvol}";
|
|
$cfg{"$job{sroot}/$job{svol}"} //= [];
|
|
push @{$cfg{"$job{sroot}/$job{svol}"}}, \%job;
|
|
}
|
|
}
|
|
close FILE;
|
|
return \%cfg;
|
|
}
|
|
|
|
sub btr_tree($)
|
|
{
|
|
my $vol = shift;
|
|
die("btr_tree: \"$vol\" is not btrfs root!") unless(check_rootvol($vol));
|
|
my $ret = run_cmd("/sbin/btrfs subvolume list -p -a $vol", 1);
|
|
my %tree;
|
|
foreach (split(/\n/, $ret))
|
|
{
|
|
# ID <ID> top level <ID> path <path> where path is the relative path
|
|
# of the subvolume to the top level subvolume. The subvolume?s ID may
|
|
# be used by the subvolume set-default command, or at mount time via
|
|
# the subvolid= option. If -p is given, then parent <ID> is added to
|
|
# the output between ID and top level. The parent?s ID may be used at
|
|
# mount time via the subvolrootid= option.
|
|
die("Failed to parse line: \"$_\"") unless(/^ID ([0-9]+) gen ([0-9]+) parent ([0-9]+) top level ([0-9]+) path (.+)$/);
|
|
my %node = ( ID => $1,
|
|
gen => $2,
|
|
parent => $3,
|
|
top_level => $4,
|
|
path => $5
|
|
);
|
|
$tree{$node{ID}} = \%node;
|
|
DEBUG "btr_tree: processing subvolid=$node{ID}";
|
|
|
|
# set FS_PATH
|
|
#
|
|
# NOTE: these substitutions are only valid if $root is a
|
|
# absolute path to a btrfs root volume (mounted with
|
|
# subvolumeid=0)
|
|
DEBUG "btr_tree: original path: $node{path}";
|
|
$node{FS_PATH} = $node{path};
|
|
if($node{FS_PATH} =~ s/^<FS_TREE>\///) {
|
|
DEBUG "btr_tree: removed <FS_TREE> portion subvolume path: $node{FS_PATH}";
|
|
}
|
|
|
|
$node{SUBVOL_PATH} = $node{FS_PATH};
|
|
DEBUG "btr_tree: set SUBVOL_PATH: $node{FS_PATH}";
|
|
|
|
$node{FS_PATH} = $vol . "/" . $node{FS_PATH};
|
|
DEBUG "btr_tree: set FS_PATH: $node{FS_PATH}";
|
|
|
|
if($node{top_level} != 5)
|
|
{
|
|
# man btrfs-subvolume:
|
|
# Also every btrfs filesystem has a default subvolume as its initially
|
|
# top-level subvolume, whose subvolume id is 5(FS_TREE).
|
|
|
|
# set child/parent node
|
|
die unless exists($tree{$node{top_level}});
|
|
# $tree{$node{top_level}}->{SUBVOL}->{$node{ID}} = \%node;
|
|
$tree{$node{ID}}->{PARENT_NODE} = $tree{$node{top_level}};
|
|
}
|
|
}
|
|
return \%tree;
|
|
}
|
|
|
|
sub btrfs_snapshot($$)
|
|
{
|
|
my $src = shift;
|
|
my $dst = shift;
|
|
INFO "[btrfs] snapshot (ro):";
|
|
INFO "[btrfs] source: $src";
|
|
INFO "[btrfs] dest : $dst";
|
|
run_cmd("/sbin/btrfs subvolume snapshot -r $src $dst");
|
|
}
|
|
|
|
sub btrfs_send_receive($$;$$)
|
|
{
|
|
my $src = shift;
|
|
my $dst = shift;
|
|
my $parent = shift // "";
|
|
my $changelog = shift // "";
|
|
my $now = localtime;
|
|
my @info;
|
|
push @info, "[btrfs] send_receive" . ($parent ? " (incremental)" : " (INIT)") . ":";
|
|
push @info, "[btrfs] source: $src";
|
|
push @info, "[btrfs] parent: $parent" if($parent);
|
|
push @info, "[btrfs] dest : $dst";
|
|
push @info, "[btrfs] log : $changelog" if($changelog);
|
|
INFO $_ foreach(@info);
|
|
|
|
my $parent_option = $parent ? "-p $parent" : "";
|
|
my $receive_option = "";
|
|
$receive_option = "-v" if($changelog || $verbose);
|
|
$receive_option = "-v -v" if($parent && $changelog);
|
|
my $cmd = "/sbin/btrfs send $parent_option $src | /sbin/btrfs receive $receive_option $dst/ 2>&1";
|
|
my $ret = run_cmd($cmd);
|
|
# run_cmd("/bin/sync");
|
|
if($changelog && (not $dryrun))
|
|
{
|
|
INFO "--- writing changelog: $changelog";
|
|
if(open(LOGFILE, '>>', $changelog)) {
|
|
print LOGFILE "<<< START btrfs_send_receive: $now >>>\n";
|
|
print LOGFILE "$_\n" foreach(@info);
|
|
print LOGFILE "[btrfs] cmd : $cmd\n";
|
|
print LOGFILE "[btrfs] cmd output:\n" . $ret;
|
|
print LOGFILE "\n<<< END btrfs_send_receive: $now >>>\n";
|
|
close(LOGFILE);
|
|
}
|
|
else {
|
|
WARN "Failed to open changelog file: $!";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub get_latest_common($$$$)
|
|
{
|
|
my $sroot = shift;
|
|
my $svol = shift;
|
|
my $droot = shift;
|
|
my $dvol = shift;
|
|
|
|
die("source subvolume info not present: $sroot") unless(exists($vol_info{$sroot}));
|
|
die("target subvolume info not present: $droot") unless(exists($vol_info{$droot}));
|
|
my $latest;
|
|
my @svol_list;
|
|
foreach (values %{$vol_info{$sroot}}) {
|
|
my $v = $_->{SUBVOL_PATH};
|
|
DEBUG "get_latest_common(): checking source volume: $v";
|
|
next unless($v =~ s/^$src_snapshot_dir\/$svol\./$svol\./);
|
|
DEBUG "get_latest_common(): found source snapshot: $v";
|
|
push @svol_list, $v;
|
|
}
|
|
|
|
foreach (values %{$vol_info{$droot}}) {
|
|
my $v = $_->{SUBVOL_PATH};
|
|
DEBUG "get_latest_common(): checking dest volume: $v";
|
|
next unless($v =~ s/^$dvol\///);
|
|
if(grep {$_ eq $v} @svol_list) {
|
|
DEBUG "get_latest_common(): found matching dest snapshot: $v";
|
|
$latest = $v if((not defined($latest)) || ($latest lt $v));
|
|
}
|
|
else {
|
|
DEBUG "get_latest_common(): found non-matching dest snapshot: $v";
|
|
}
|
|
}
|
|
WARN("no common snapshots for \"${svol}.*\" found in src=$sroot/$src_snapshot_dir/ dst=$droot/$dvol/") unless($latest);
|
|
DEBUG "get_latest_common(): latest common snapshot: " . ($latest ? "latest" : "<no_match>");
|
|
return $latest;
|
|
}
|
|
|
|
MAIN:
|
|
{
|
|
$ENV{PATH} = '';
|
|
$Getopt::Std::STANDARD_HELP_VERSION = 1;
|
|
$Data::Dumper::Sortkeys = 1;
|
|
|
|
my %opts;
|
|
getopts('hc:vdp', \%opts);
|
|
# my $sroot = shift @ARGV;
|
|
# my $svol = shift @ARGV;
|
|
# my $droot = shift @ARGV;
|
|
# my $dvol = shift @ARGV;
|
|
|
|
# assign command line options
|
|
$dryrun = $opts{p}; # TODO: rename to $pretend
|
|
$debug = $opts{d};
|
|
$verbose = $opts{v} || $debug;
|
|
# my $incremental = $opts{i};
|
|
my $config = $opts{c};
|
|
|
|
# check command line options
|
|
if($opts{h} || (not $config)) {
|
|
VERSION_MESSAGE();
|
|
HELP_MESSAGE(0);
|
|
exit 0;
|
|
}
|
|
my $jobs = parse_config($config);
|
|
my $postfix = '.' . strftime($time_format, localtime);
|
|
my %snapshots_created;
|
|
|
|
foreach my $job_key (keys %$jobs)
|
|
{
|
|
# INFO "========================================";
|
|
# INFO "job_key: $job_key";
|
|
# INFO "========================================";
|
|
foreach (@{$jobs->{$job_key}})
|
|
{
|
|
my $sroot = $_->{sroot};
|
|
my $svol = $_->{svol};;
|
|
my $droot = $_->{droot};
|
|
my $dvol = $_->{dvol};
|
|
my $type = $_->{type};
|
|
my @job_opts = @{$_->{options}};
|
|
|
|
$vol_info{$sroot} //= btr_tree($sroot);
|
|
$vol_info{$droot} //= btr_tree($droot);
|
|
|
|
INFO "***";
|
|
INFO "*** $type\[" . join(',', @job_opts) . "]";
|
|
INFO "*** source: $sroot/$svol";
|
|
INFO "*** dest : $droot/$dvol";
|
|
INFO "***";
|
|
DEBUG(Data::Dumper->Dump([\%vol_info], ["vol_info"]));
|
|
|
|
my $ssnap = "${src_snapshot_dir}/${svol}${postfix}";
|
|
check_src($sroot, $svol);
|
|
|
|
unless($snapshots_created{"${sroot}/${svol}"})
|
|
{
|
|
# make snapshot of svol, if not already created by another job
|
|
die("snapshot source does not exists: $sroot/$svol") unless check_vol($sroot, $svol);
|
|
die("snapshot destination already exists: $sroot/$ssnap") if check_vol($sroot, $ssnap);
|
|
btrfs_snapshot("$sroot/$svol", "$sroot/$ssnap");
|
|
$snapshots_created{"$sroot/$svol"} = "$sroot/$ssnap";
|
|
}
|
|
else {
|
|
INFO "--- reusing snapshot: $ssnap";
|
|
}
|
|
|
|
die("snapshot already exists at destination: $droot") if(check_vol($droot, "${svol}${postfix}"));
|
|
my $changelog = "";
|
|
if(grep(/^log/, @job_opts))
|
|
{
|
|
if(my @res = grep(/^log=\S+$/, @job_opts)) {
|
|
die if(scalar(@res) != 1);
|
|
$changelog = $res[0];
|
|
$changelog =~ s/^log=//;
|
|
}
|
|
else {
|
|
# log defaults to sidecar of destination snapshot
|
|
$changelog = "$droot/$dvol/${svol}${postfix}.btrbk.log";
|
|
}
|
|
}
|
|
if(grep(/incremental/, @job_opts))
|
|
{
|
|
INFO "--- processing option=incremental";
|
|
my $latest_common = get_latest_common($sroot, $svol, $droot, $dvol);
|
|
if($latest_common)
|
|
{
|
|
INFO "--- found common parent: $latest_common";
|
|
my $parent_snap = "$src_snapshot_dir/$latest_common";
|
|
die("snapshot parent source does not exists: $sroot/$parent_snap") unless check_vol($sroot, $parent_snap);
|
|
btrfs_send_receive("$sroot/$ssnap", "$droot/$dvol", "$sroot/$parent_snap", $changelog);
|
|
}
|
|
elsif(grep(/init/, @job_opts)) {
|
|
if(check_vol($droot, $dvol)) {
|
|
INFO "--- no common parent subvolume found, making new snapshot copy (option=init)";
|
|
btrfs_send_receive("$sroot/$ssnap", "$droot/$dvol", undef, $changelog);
|
|
}
|
|
else {
|
|
WARN "backup to $droot failed: target subvolume not found: $droot/$dvol";
|
|
}
|
|
}
|
|
else {
|
|
WARN "backup to $droot failed: no common parent subvolume found, and job option \"create\" is not set";
|
|
}
|
|
}
|
|
elsif(grep(/create/, @job_opts))
|
|
{
|
|
INFO "<$type> making new snapshot copy (option=create))";
|
|
btrfs_send_receive("${sroot}/${ssnap}", "${droot}/${dvol}", undef, $changelog);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
1;
|