mirror of https://github.com/digint/btrbk
btrbk: use arrays as arguments for run_cmd(), making it compatible with the adaptions in the open3 branch
Axel Burri
parent
a802674d11
commit
fd94bc25fc
202
btrbk
202
btrbk
|
|
@ -47,7 +47,7 @@ use Date::Calc qw(Today Delta_Days Day_of_Week);
|
|||
use Getopt::Std;
|
||||
use Data::Dumper;
|
||||
|
||||
our $VERSION = "0.19.3";
|
||||
our $VERSION = "0.20.0-dev";
|
||||
our $AUTHOR = 'Axel Burri <axel@tty0.ch>';
|
||||
our $PROJECT_HOME = '<http://www.digint.ch/btrbk/>';
|
||||
|
||||
|
|
@ -156,47 +156,57 @@ sub WARN { my $t = shift; print STDERR "WARNING: $t\n" if($loglevel >= 1); }
|
|||
sub ERROR { my $t = shift; print STDERR "ERROR: $t\n"; }
|
||||
|
||||
|
||||
sub run_cmd($;@)
|
||||
sub run_cmd(@)
|
||||
{
|
||||
my $cmd = shift || die;
|
||||
my %opts = @_;
|
||||
my $ret = "";
|
||||
$cmd =~ s/^\s+//;
|
||||
$cmd =~ s/\s+$//;
|
||||
$cmd .= ' 2>&1' if($opts{catch_stderr});
|
||||
my @commands = (ref($_[0]) eq "HASH") ? @_ : { @_ };
|
||||
$err = "";
|
||||
if($opts{non_destructive} || (not $dryrun)) {
|
||||
DEBUG "### $cmd";
|
||||
$ret = `$cmd`;
|
||||
chomp($ret);
|
||||
TRACE "Command output:\n$ret";
|
||||
if($?) {
|
||||
my $exitcode= $? >> 8;
|
||||
my $signal = $? & 127;
|
||||
DEBUG "Command execution failed (exitcode=$exitcode" . ($signal ? ", signal=$signal" : "") . "): \"$cmd\"";
|
||||
|
||||
if($opts{catch_stderr}) {
|
||||
if($ret =~ /ssh command rejected/) {
|
||||
# catch errors from ssh_filter_btrbk.sh
|
||||
$err = "ssh command rejected (please fix ssh_filter_btrbk.sh)";
|
||||
}
|
||||
elsif($ret =~ /^ERROR: (.*)/) {
|
||||
# catch errors from btrfs command
|
||||
$err = $1;
|
||||
}
|
||||
else {
|
||||
DEBUG "Unparseable error: $ret";
|
||||
$err = "unparseable error";
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
my $cmd = "";
|
||||
my $name = "";
|
||||
my $destructive = 0;
|
||||
my $pipe = "";
|
||||
my $catch_stderr = 0;
|
||||
my $filter_stderr = undef;
|
||||
foreach (@commands) {
|
||||
$_->{rsh} //= [];
|
||||
$_->{cmd} = [ @{$_->{rsh}}, @{$_->{cmd}} ];
|
||||
$_->{cmd_text} = join(' ', map { s/\n/\\n/g; "'$_'" } @{$_->{cmd}}); # ugly escape of \n, do we need to escape others?
|
||||
$name = $_->{name} // $_->{cmd_text};
|
||||
$_->{_buf} = '';
|
||||
$cmd .= $pipe . $_->{cmd_text};
|
||||
$pipe = ' | ';
|
||||
if($_->{catch_stderr}) {
|
||||
$cmd .= ' 2>&1';
|
||||
$catch_stderr = 1;
|
||||
$filter_stderr = $_->{filter_stderr};
|
||||
}
|
||||
else {
|
||||
DEBUG "Command execution successful";
|
||||
$destructive = 1 unless($_->{non_destructive});
|
||||
}
|
||||
|
||||
if($dryrun && $destructive) {
|
||||
DEBUG "### (dryrun) $cmd";
|
||||
return "";
|
||||
}
|
||||
DEBUG "### $cmd";
|
||||
|
||||
my $ret = "";
|
||||
$ret = `$cmd`;
|
||||
chomp($ret);
|
||||
TRACE "Command output:\n$ret";
|
||||
if($?) {
|
||||
my $exitcode= $? >> 8;
|
||||
my $signal = $? & 127;
|
||||
DEBUG "Command execution failed (exitcode=$exitcode" . ($signal ? ", signal=$signal" : "") . "): \"$cmd\"";
|
||||
|
||||
if($catch_stderr) {
|
||||
$_ = $ret;
|
||||
&{$filter_stderr} ($cmd) if($filter_stderr);
|
||||
ERROR "[$cmd] $_" if($_);
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
else {
|
||||
DEBUG "### (dryrun) $cmd";
|
||||
DEBUG "Command execution successful";
|
||||
}
|
||||
return $ret;
|
||||
}
|
||||
|
|
@ -218,9 +228,9 @@ sub vinfo($$)
|
|||
my ($host, $path) = ($1, $2);
|
||||
my $ssh_user = config_key($config, "ssh_user");
|
||||
my $ssh_identity = config_key($config, "ssh_identity");
|
||||
my $ssh_options = "";
|
||||
my @ssh_options;
|
||||
if($ssh_identity) {
|
||||
$ssh_options .= "-i $ssh_identity ";
|
||||
@ssh_options = ('-i', $ssh_identity);
|
||||
}
|
||||
else {
|
||||
WARN "No SSH identity provided (option ssh_identity is not set) for: $url";
|
||||
|
|
@ -233,7 +243,7 @@ sub vinfo($$)
|
|||
RSH_TYPE => "ssh",
|
||||
SSH_USER => $ssh_user,
|
||||
SSH_IDENTITY => $ssh_identity,
|
||||
RSH => "/usr/bin/ssh $ssh_options" . $ssh_user . '@' . $host,
|
||||
RSH => ['/usr/bin/ssh', @ssh_options, $ssh_user . '@' . $host ],
|
||||
);
|
||||
}
|
||||
elsif(($url =~ /^\//) && ($url =~ /^$file_match$/)) {
|
||||
|
|
@ -586,7 +596,9 @@ sub parse_config(@)
|
|||
|
||||
sub btrfs_filesystem_show_all_local()
|
||||
{
|
||||
return run_cmd("btrfs filesystem show", non_destructive => 1);
|
||||
return run_cmd( cmd => [ qw(btrfs filesystem show) ],
|
||||
non_destructive => 1
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -594,8 +606,10 @@ sub btrfs_filesystem_show($)
|
|||
{
|
||||
my $vol = shift || die;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
return run_cmd("$rsh btrfs filesystem show '$path'", non_destructive => 1);
|
||||
return run_cmd( cmd => [ qw(btrfs filesystem show), $path ],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -603,8 +617,10 @@ sub btrfs_filesystem_df($)
|
|||
{
|
||||
my $vol = shift || die;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
return run_cmd("$rsh btrfs filesystem df '$path'", non_destructive => 1);
|
||||
return run_cmd( cmd => [qw(btrfs filesystem df), $path],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -612,8 +628,10 @@ sub btrfs_filesystem_usage($)
|
|||
{
|
||||
my $vol = shift || die;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
return run_cmd("$rsh btrfs filesystem usage '$path'", non_destructive => 1);
|
||||
return run_cmd( cmd => [ qw(btrfs filesystem usage), $path ],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -621,8 +639,28 @@ sub btrfs_subvolume_detail($)
|
|||
{
|
||||
my $vol = shift || die;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
my $ret = run_cmd("$rsh btrfs subvolume show '$path'", non_destructive => 1, catch_stderr => 1);
|
||||
my $ret = run_cmd(cmd => [ qw(btrfs subvolume show), $path],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1,
|
||||
catch_stderr => 1, # hack for shell-based run_cmd()
|
||||
filter_stderr => sub {
|
||||
if(/ssh command rejected/) {
|
||||
# catch errors from ssh_filter_btrbk.sh
|
||||
$err = "ssh command rejected (please fix ssh_filter_btrbk.sh)";
|
||||
}
|
||||
elsif(/^ERROR: (.*)/) {
|
||||
# catch errors from btrfs command
|
||||
$err = $1;
|
||||
}
|
||||
else {
|
||||
DEBUG "Unparsed error: $_";
|
||||
$err = $_;
|
||||
}
|
||||
# consume stderr line, as $err will be displayed as a user-friendly WARNING
|
||||
$_ = undef;
|
||||
}
|
||||
);
|
||||
|
||||
return undef unless(defined($ret));
|
||||
|
||||
# workaround for btrfs-progs < 3.17.3 (returns exit status 0 on errors)
|
||||
|
|
@ -643,7 +681,7 @@ sub btrfs_subvolume_detail($)
|
|||
}
|
||||
my %detail = ( REAL_PATH => $real_path );
|
||||
|
||||
if($ret eq "$real_path is btrfs root") {
|
||||
if($ret =~ /^\Q$real_path\E is btrfs root/) {
|
||||
DEBUG "found btrfs root: $vol->{PRINT}";
|
||||
$detail{id} = 5;
|
||||
$detail{is_root} = 1;
|
||||
|
|
@ -690,13 +728,15 @@ sub btrfs_subvolume_list($;@)
|
|||
my $vol = shift || die;
|
||||
my %opts = @_;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
my $btrfs_progs_compat = $vol->{BTRFS_PROGS_COMPAT} || $opts{btrfs_progs_compat};
|
||||
my $filter_option = "-a";
|
||||
$filter_option = "-o" if($opts{subvol_only});
|
||||
my $display_options = "-c -u -q";
|
||||
$display_options .= " -R" unless($btrfs_progs_compat);
|
||||
my $ret = run_cmd("$rsh btrfs subvolume list $filter_option $display_options '$path'", non_destructive => 1);
|
||||
my @filter_options = ('-a');
|
||||
push(@filter_options, '-o') if($opts{subvol_only});
|
||||
my @display_options = ('-c', '-u', '-q');
|
||||
push(@display_options, '-R') unless($btrfs_progs_compat);
|
||||
my $ret = run_cmd(cmd => [ qw(btrfs subvolume list), @filter_options, @display_options, $path ],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1,
|
||||
);
|
||||
return undef unless(defined($ret));
|
||||
|
||||
my @nodes;
|
||||
|
|
@ -754,9 +794,11 @@ sub btrfs_subvolume_find_new($$;$)
|
|||
{
|
||||
my $vol = shift || die;
|
||||
my $path = $vol->{PATH} // die;
|
||||
my $rsh = $vol->{RSH} || "";
|
||||
my $lastgen = shift // die;
|
||||
my $ret = run_cmd("$rsh btrfs subvolume find-new '$path' $lastgen", non_destructive => 1);
|
||||
my $ret = run_cmd(cmd => [ qw(btrfs subvolume find-new), $path, $lastgen ],
|
||||
rsh => $vol->{RSH},
|
||||
non_destructive => 1,
|
||||
);
|
||||
unless(defined($ret)) {
|
||||
ERROR "Failed to fetch modified files for: $vol->{PRINT}";
|
||||
return undef;
|
||||
|
|
@ -813,13 +855,14 @@ sub btrfs_subvolume_snapshot($$)
|
|||
my $svol = shift || die;
|
||||
my $target_path = shift // die;
|
||||
my $src_path = $svol->{PATH} // die;
|
||||
my $rsh = $svol->{RSH} || "";
|
||||
DEBUG "[btrfs] snapshot (ro):";
|
||||
DEBUG "[btrfs] host : $svol->{HOST}" if($svol->{HOST});
|
||||
DEBUG "[btrfs] source: $src_path";
|
||||
DEBUG "[btrfs] target: $target_path";
|
||||
INFO ">>> " . ($svol->{HOST} ? "{$svol->{HOST}}" : "") . $target_path;
|
||||
my $ret = run_cmd("$rsh btrfs subvolume snapshot -r '$src_path' '$target_path'");
|
||||
my $ret = run_cmd(cmd => [ qw(btrfs subvolume snapshot), '-r', $src_path, $target_path ],
|
||||
rsh => $svol->{RSH},
|
||||
);
|
||||
ERROR "Failed to create btrfs subvolume snapshot: $svol->{PRINT} -> $target_path" unless(defined($ret));
|
||||
return defined($ret) ? $target_path : undef;
|
||||
}
|
||||
|
|
@ -833,17 +876,21 @@ sub btrfs_subvolume_delete($@)
|
|||
die if($commit && ($commit ne "after") && ($commit ne "each"));
|
||||
$targets = [ $targets ] unless(ref($targets) eq "ARRAY");
|
||||
return 0 unless(scalar(@$targets));
|
||||
my $rsh = $targets->[0]->{RSH} || "";
|
||||
my $rsh = $targets->[0]->{RSH};
|
||||
my $rsh_host_check = $targets->[0]->{HOST} || "";
|
||||
foreach (@$targets) {
|
||||
# make sure all targets share same RSH
|
||||
my $rsh_check = $_->{RSH} || "";
|
||||
die if($rsh ne $rsh_check);
|
||||
# make sure all targets share same HOST
|
||||
my $host = $_->{HOST} || "";
|
||||
die if($rsh_host_check ne $host);
|
||||
}
|
||||
DEBUG "[btrfs] delete" . ($commit ? " (commit-$commit):" : ":");
|
||||
DEBUG "[btrfs] subvolume: $_->{PRINT}" foreach(@$targets);
|
||||
my $options = "";
|
||||
$options = "--commit-$commit " if($commit);
|
||||
my $ret = run_cmd("$rsh btrfs subvolume delete $options" . join(' ', map( { "'$_->{PATH}'" } @$targets)));
|
||||
my @options;
|
||||
@options = ("--commit-$commit") if($commit);
|
||||
my @target_paths = map( { $_->{PATH} } @$targets);
|
||||
my $ret = run_cmd(cmd => [ qw(btrfs subvolume delete), @options, @target_paths ],
|
||||
rsh => $rsh,
|
||||
);
|
||||
ERROR "Failed to delete btrfs subvolumes: " . join(' ', map( { $_->{PRINT} } @$targets)) unless(defined($ret));
|
||||
return defined($ret) ? scalar(@$targets) : undef;
|
||||
}
|
||||
|
|
@ -855,9 +902,9 @@ sub btrfs_send_receive($$$)
|
|||
my $target = shift || die;
|
||||
my $parent = shift;
|
||||
my $snapshot_path = $snapshot->{PATH} // die;
|
||||
my $snapshot_rsh = $snapshot->{RSH} || "";
|
||||
my $snapshot_rsh = $snapshot->{RSH};
|
||||
my $target_path = $target->{PATH} // die;
|
||||
my $target_rsh = $target->{RSH} || "";
|
||||
my $target_rsh = $target->{RSH};
|
||||
my $parent_path = $parent ? $parent->{PATH} : undef;
|
||||
|
||||
my $snapshot_name = $snapshot_path;
|
||||
|
|
@ -869,11 +916,24 @@ sub btrfs_send_receive($$$)
|
|||
DEBUG "[btrfs] parent: $parent->{PRINT}" if($parent);
|
||||
DEBUG "[btrfs] target: $target->{PRINT}";
|
||||
|
||||
my $parent_option = $parent_path ? "-p '$parent_path'" : "";
|
||||
my $receive_option = "";
|
||||
$receive_option = "-v" if($loglevel >= 3);
|
||||
my @send_options;
|
||||
my @receive_options;
|
||||
push(@send_options, '-p', $parent_path) if($parent_path);
|
||||
push(@send_options, '-v') if($loglevel >= 3);
|
||||
push(@receive_options, '-v') if($loglevel >= 3);
|
||||
|
||||
my $ret = run_cmd("$snapshot_rsh btrfs send $parent_option '$snapshot_path' | $target_rsh btrfs receive $receive_option '$target_path/'");
|
||||
my $ret = run_cmd(
|
||||
{
|
||||
cmd => [ qw(btrfs send), @send_options, $snapshot_path ],
|
||||
rsh => $snapshot_rsh,
|
||||
name => "btrfs send",
|
||||
},
|
||||
{
|
||||
cmd => [ qw(btrfs receive), @receive_options, $target_path . '/' ],
|
||||
rsh => $target_rsh,
|
||||
name => "btrfs receive",
|
||||
},
|
||||
);
|
||||
unless(defined($ret)) {
|
||||
ERROR "Failed to send/receive btrfs subvolume: $snapshot->{PRINT} " . ($parent_path ? "[$parent_path]" : "") . " -> $target->{PRINT}";
|
||||
return undef;
|
||||
|
|
|
|||
Loading…
Reference in New Issue