blob: a57792047051c25334ef06d03213b7ddcdd9357c [file] [log] [blame]
#!/usr/bin/perl
# Copyright (C) 2012 STRATO. 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 v2 as published by the Free Software Foundation.
#
# 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, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 021110-1307, USA.
use strict;
use warnings;
use Getopt::Std;
use Time::HiRes qw(time);
use IPC::Open3;
use Symbol qw(gensym);
my @fs = qw(btrfs zfs);
my %opts = ();
my $ssh_chld = 0;
sub usage {
print STDERR <<EO_USAGE;
$0 -s source -d destination [...]
-d destination type:device (required; always local)
-f fuzz testing (number of tests, run after -t tests. -1: infinite)
-F single fuzz test with seed
-k keep temporary files
-p pedanctic mode (stop on error)
-q quiet
-r remote host (needs ssh root login)
-s source type:device (required; remote with -r, otherwise local)
-t test spec (e.g. "1,2,3", "1-3,6:1,7:2-4,8-12")
-v verbose
type must be one of: @fs
EO_USAGE
exit(shift);
}
sub out {
print @_ if !$opts{q};
}
sub verbose {
print @_ if $opts{v};
}
sub do_local {
my @out = capture_local(@_);
print map {"$_\n"} @out if $opts{v};
}
my $remote_host;
my $ssh_socket;
sub args_for_remote {
return @_ if !$remote_host;
return ("ssh", "-l", "root", "-S", $ssh_socket, $remote_host,
map {ref($_) ? $_ : quotemeta($_)} @_);
}
sub do_remote {
return do_local(args_for_remote(@_));
}
sub capture_local {
# we only open() to local handles and let perl do the close()s
my $args = pop if (ref $_[-1]);
verbose("running @_ ",
$args->{input} ? "< $args->{input} " : "",
$args->{output} ? "> $args->{output} " : "",
"... ");
my $t_start = time;
local (*OUTFILE, *INFILE, *DATAFILE);
my ($fd_in, $fd_out, $fd_out_err, $fd_infile) = ();
my $data = "";
if ($args->{input}) {
open(INFILE, "<", $args->{input})
or die "\nERROR from command: @_\ncannot redirect ".
"input from $args->{input}: $!\n";
$fd_infile = \*INFILE;
}
if ($args->{data}) {
open(DATAFILE, "<", $args->{data})
or die "\nERROR from command: @_\ncannot get input ".
"data from $args->{data}: $!\n";
}
if ($args->{output}) {
open(OUTFILE, ">", $args->{output})
or die "\nERROR from command: @_\ncannot redirect ".
"output to $args->{output}: $!\n";
$fd_out_err = gensym;
}
my $pid = open3($fd_in,
$args->{output} ? ">&OUTFILE" : $fd_out,
$fd_out_err, @_);
if (!$args->{input}) {
close($fd_in);
undef $fd_in;
}
$fd_out = $fd_out_err if $args->{output};
my ($rin, $win, $rout, $wout, @out) = ("", "");
vec($rin, fileno($fd_out), 1) = 1 if $fd_out;
vec($win, fileno($fd_in), 1) = 1 if $fd_in;
while ($fd_in || $fd_out) {
$rout = $rin;
$wout = $win;
select($fd_out ? $rout : undef, $fd_in ? $wout : undef,
undef, undef);
if ($fd_in && $wout eq $win) {
my $buf = <$fd_infile>;
if (defined $buf) {
syswrite($fd_in, $buf)
or die "\nERROR from command: @_\n".
"cannot write to it: $!\n";
} elsif ($args->{data} && $fd_infile != \*DATAFILE) {
my $ret = syswrite($fd_in, "\n__END__\n");
die if $ret != 9;
$fd_infile = \*DATAFILE;
} else {
undef $fd_in;
}
}
if ($fd_out && $rout eq $rin) {
my $ret = sysread($fd_out, $data, 8192, length($data));
if (!defined $ret) {
die "\nERROR from command: @_\ncannot ".
"read from it: $!\n";
}
undef $fd_out if !$ret;
}
}
waitpid($pid, 0);
if ($? && !$args->{mayfail}) {
die "\nERROR from command ($?): @_\noutput:\n$data\n";
}
my $t_elapsed = int((time - $t_start) * 100)/100;
verbose("done ($t_elapsed sec)\n");
return $data;
}
sub capture_remote {
return capture_local(args_for_remote(@_));
}
sub ignore_local {
capture_local(@_, {mayfail => 1});
}
sub ignore_remote {
return ignore_local(args_for_remote(@_));
}
sub check_blkdev {
my $dev = shift;
my $is_loop = 0;
if (!-b $dev) {
foreach (split /\n/, capture_local("losetup", "--all")) {
if (/^([^\s:]+):.*$dev/) {
ignore_local("umount", $1);
}
}
$dev = capture_local("losetup", "--show", "-f", $dev);
chomp $dev;
$is_loop = 1;
}
return ($dev, $is_loop);
}
my $p_refgen = "./refgen.pl";
my $p_refgen_actions = "./actions";
my $p_fssum = "fssum";
my $p_fardir = "/tmp/far-$$";
my $p_sumfile = "$p_fardir/fssum.out";
my $p_btrfs = "btrfs";
my $p_zfs = "zfs";
my $p_diff_outfile = "$p_fardir/send.far";
my $p_perl = "perl";
my $allok = getopts("d:f:F:hkpqr:s:t:v", \%opts);
if (!$opts{d}) {
print STDERR "missing -d destination\n";
$allok = 0;
}
if (!$opts{s}) {
print STDERR "missing -s source\n";
$allok = 0;
}
if (!$opts{t} && !$opts{f} && !$opts{F}) {
print STDERR "no test given, use -t, -f or -F\n";
$allok = 0;
} elsif ($opts{f} && $opts{F}) {
print STDERR "-f cannot be combined with -F\n";
$allok = 0;
}
my $allowed_fs = join("|", @fs);
if (!$allok || $opts{h}) {
usage(!$opts{h});
}
if ($opts{d} !~ /^([^:]+):(.*)$/) {
print STDERR "wrong format for -d destination ($opts{d})\n";
$allok = 0;
}
my ($dst_type, $dst_dev, $dst_is_loop) = ($1, check_blkdev($2));
if (!grep $dst_type, @fs) {
print STDERR "unsupported type for destination\n";
$allok = 0;
}
if ($opts{s} !~ /^([^:]+):(.*)$/) {
print STDERR "wrong format for -s source ($opts{s})\n";
$allok = 0;
}
my ($src_type, $src_dev, $src_is_loop) = ($1, $opts{r} ? $2 : check_blkdev($2));
if (!grep $src_type, @fs) {
print STDERR "unsupported type for source\n";
$allok = 0;
}
if ($dst_type eq "zfs") {
print STDERR "zfs destination type not implemented\n";
$allok = 0;
}
my $fuzz_test_seed = $opts{F};
my $fuzz_tests = $fuzz_test_seed ? 1 : $opts{f};
my $dst_mnt = "$p_fardir/mnt-dst";
my $src_mnt = "$p_fardir/mnt-src";
my $verbose = $opts{v} ? "-v" : "";
my $keep_temp = $opts{k};
$remote_host = $opts{r};
$ssh_socket = "$p_fardir/ssh_sock";
my ($src_type_opt, @p_send, $src_send, $dst_subvol, $send_incr_opt, @p_destroy);
if ($src_type eq "zfs") {
$src_type_opt = "-z";
@p_send = qw(zfs send -F);
@p_destroy = qw(zfs destroy -r);
$send_incr_opt = "-i";
$src_send = $src_dev;
$dst_subvol = $src_dev;
$dst_subvol =~ s{.*/}{};
} elsif ($src_type eq "btrfs") {
$src_type_opt = "-b";
@p_send = qw(btrfs send);
@p_destroy = qw();
$send_incr_opt = "-p";
$src_send = "$src_mnt/";
$dst_subvol = "";
} else {
die;
}
sub do_src_destroy {
ignore_remote("umount", $src_dev);
if ($src_type eq "zfs") {
ignore_remote(qw(zfs destroy -r), $src_dev);
}
}
sub do_src_create {
if ($src_type eq "zfs") {
do_remote(qw(zfs create -o), "mountpoint=$src_mnt", $src_dev);
} else {
do_remote("mkfs.btrfs", "-L", "fits", $src_dev);
do_remote("mount", $src_dev, $src_mnt);
}
}
sub get_src_snapshot_cmd {
my $snap = shift;
if ($src_type eq "zfs") {
return ("zfs", "snapshot", "$src_send\@$snap");
} else {
return (qw(btrfs subvol snap -r),
$src_send, "$src_send/\@$snap");
}
}
sub do_src_snapshot {
do_remote(get_src_snapshot_cmd(@_));
}
sub do_src_fsstress {
my $fuzz_test_seed = shift;
my $seed = capture_remote(
qw(fsstress -n 100 -d), "$src_mnt",
($fuzz_test_seed ? ("-s", $fuzz_test_seed) : ()),
"-x", join(" ", get_src_snapshot_cmd("base"))
);
$seed =~ /^seed = (\d+)/;
return $fuzz_test_seed ? $fuzz_test_seed : $1;
}
sub do_src_send {
my ($snap, $data_file) = @_;
if ($src_type eq "zfs") {
do_remote(@p_send, "$src_send\@$snap", {output => $data_file});
} else {
do_remote(@p_send, "$src_send\@$snap", {output => $data_file});
}
}
sub do_src_fssum {
my $snap = shift;
my @exclude = $src_type eq "zfs" ? () : @_;
do_remote($p_fssum, "-f", snapshot_path($snap),
(map { ("-x", "$src_mnt/\@$snap/\@$_") } @exclude),
{output => $p_sumfile});
}
sub do_src_send_incr {
my ($base, $incr, $data_file) = @_;
do_remote(@p_send, $send_incr_opt, "$src_send\@$base",
"$src_send\@$incr", {output => $data_file});
}
sub cleanup_temp {
if (!$keep_temp) {
ignore_local("umount", $dst_mnt);
ignore_remote("umount", $src_mnt);
ignore_local("rm", "-rf", $p_fardir);
if ($remote_host) {
ignore_remote("rm", "-rf", $p_fardir);
}
}
}
sub cleanup {
cleanup_temp();
if ($ssh_chld) {
kill "TERM", $ssh_chld;
unlink $ssh_socket;
}
if ($dst_is_loop) {
ignore_local("losetup", "-d", $dst_dev);
}
if ($src_is_loop) {
ignore_local("losetup", "-d", $src_dev);
}
}
local $SIG{INT} = sub {
$SIG{INT} = "DEFAULT";
cleanup();
kill "INT", $$;
};
local $SIG{PIPE} = "IGNORE";
sub snapshot_path {
return "$src_mnt/\@$_[0]" if ($src_type eq "btrfs");
return "$src_mnt/.zfs/snapshot/$_[0]" if ($src_type eq "zfs");
die;
}
sub parse_range {
my $range = shift;
if ($range !~ /^(\d+)(?:-(\d+))?$/) {
die qq{failed to parse test spec at "$range"};
}
my $start = $1;
my $end = defined $2 ? $2 : $start;
if ($start > $end) {
die qq{reverse range in test spec at "$range"};
}
return ($start, $end);
}
my $number_of_digits_in_expand = 3;
sub subtest_range {
my ($s_start, $s_end) = @_;
my $n = $number_of_digits_in_expand;
my $test_spec = ":(?:";
for ($s_start .. $s_end) {
$test_spec .= sprintf("%0${n}d", $_);
$test_spec .= "|";
}
chop $test_spec;
$test_spec .= ")-";
return $test_spec;
}
my $test_spec = "";
if ($opts{t} && $opts{t} eq "all") {
$test_spec = ".";
} elsif ($opts{t}) {
my $n = $number_of_digits_in_expand;
foreach (split /,/, $opts{t}) {
my ($tnum, $subtests) = split /:/;
my ($t_start, $t_end) = $tnum ? parse_range($tnum) : (1, 1);
my ($s_start, $s_end) = parse_range($subtests) if $subtests;
for ($t_start .. $t_end) {
$test_spec .= "^";
$test_spec .= $tnum ? sprintf("%0${n}d", $_) : "\\d+";
if ($subtests) {
$test_spec .= subtest_range($s_start, $s_end);
} else {
$test_spec .= ":";
}
$test_spec .= "|";
}
}
chop $test_spec;
eval {
$test_spec = qr{$test_spec};
};
if ($@) {
die "failed to compile regexp for test spec: $@"
}
}
if (!$test_spec && !$fuzz_tests) {
die qq{need either -t TESTSPEC|"all" or -f NUM\n};
}
mkdir($p_fardir) or die "mkdir for temp dir $p_fardir failed: $!\n";
mkdir($dst_mnt) or die "mkdir $dst_mnt failed: $!\n";
if ($remote_host) {
# setup shared socket
$ssh_chld = fork();
if (!defined $ssh_chld) {
die "fork failed: $!\n";
}
if (!$ssh_chld) {
close(STDIN);
close(STDOUT);
close(STDERR);
exec("ssh", "-M", "-N", "-l", "root", "-S",
$ssh_socket, $remote_host);
die "exec failed: $!\n";
}
verbose("ssh master has pid $ssh_chld, socket $ssh_socket\n");
do_remote("mkdir", $p_fardir);
do_remote("mkdir", $src_mnt);
} else {
mkdir($src_mnt) or die "mkdir $src_mnt failed: $!\n";
}
if ($fuzz_tests) {
verbose("checking for fsstress availablity\n");
my $out = capture_remote("fsstress", "-n", 0, "-d", $p_fardir);
}
ignore_local("umount", $dst_dev);
ignore_remote("umount", $src_dev);
my @files = split /\n/, capture_local("ls", $p_refgen_actions);
my @failed_tests = ();
my $cnt = 0;
my $ex_ret = 0;
foreach my $action_file (@files) {
if (!$test_spec) {
last;
}
if ($action_file !~ $test_spec) {
next;
}
my $i = 0;
my $n_snaps = 0;
my $t_start = time;
eval {
out("running check $action_file... ");
if ($cnt++) {
do_local("umount", $dst_mnt);
do_remote("umount", $src_mnt);
}
do_local("mkfs.btrfs", "-L", "fits", $dst_dev);
do_local("mount", "-o", "noatime", $dst_dev, $dst_mnt);
do_remote($p_perl, "-", "-p", $src_mnt, $src_type_opt, $src_dev,
($verbose ? $verbose : ()), {
input => $p_refgen,
data => "$p_refgen_actions/$action_file",
});
$n_snaps = capture_local("grep", "-c", "^snapshot\$",
"$p_refgen_actions/$action_file");
chomp $n_snaps;
my @exclude = ();
for ($i = 1; $i <= $n_snaps; $i++) {
my ($data_file);
if ($i == 1) {
$data_file = $p_diff_outfile.".full";
do_remote(@p_send, "$src_send\@1",
{output => $data_file});
} else {
my $prev = $i - 1;
$data_file = $p_diff_outfile.".incr.$prev-$i";
do_remote(@p_send, $send_incr_opt,
"$src_send\@$prev", "$src_send\@$i",
{output => $data_file});
}
do_local($p_btrfs, "receive",
($verbose ? $verbose : ()),
$dst_mnt, {input => $data_file});
my @x = map { ("-x", "$src_mnt/\@$i/\@$_") } @exclude
if $src_type eq "btrfs";
do_remote($p_fssum, @x, "-f", snapshot_path($i),
{output => $p_sumfile});
do_local($p_fssum, "-r", $p_sumfile,
"$dst_mnt/$dst_subvol\@$i");
verbose("done\n");
push @exclude, $i;
}
};
if ($@) {
die($@) if $opts{p};
out($i ? "step $i/$n_snaps" : "preparation", " failed\n")
if !$verbose;
verbose($@);
$ex_ret++;
push @failed_tests, $action_file;
} else {
my $t_elapsed = int((time - $t_start) * 100)/100;
out("ok ($t_elapsed sec)\n");
}
}
for (my $i = 1; $fuzz_tests == -1 || $i <= $fuzz_tests; ++$i) {
my $seed;
my $t_start = time;
eval {
out("running fuzz check $i... ");
ignore_local("umount", $dst_mnt);
do_local("mkfs.btrfs", "-L", "fits", $dst_dev);
do_local("mount", "-o", "noatime", $dst_dev, $dst_mnt);
do_src_destroy();
do_src_create();
$seed = do_src_fsstress($fuzz_test_seed);
out("(seed $seed) ");
do_src_snapshot("incr");
my $data_file = $p_diff_outfile.".full";
do_src_send("base", $data_file);
do_local($p_btrfs, "receive", ($verbose ? $verbose : ()),
$dst_mnt, {input => $data_file});
do_src_fssum("base");
do_local($p_fssum, "-r", $p_sumfile,
"$dst_mnt/$dst_subvol\@base");
$data_file = $p_diff_outfile.".incr.0-1";
do_src_send_incr("base", "incr", $data_file);
do_local($p_btrfs, "receive", ($verbose ? $verbose : ()),
$dst_mnt, {input => $data_file});
do_src_fssum("incr", "base");
do_local($p_fssum, "-r", $p_sumfile,
"$dst_mnt/$dst_subvol\@incr");
};
if ($@) {
die($@) if $opts{p};
out(" failed\n");
verbose($@);
$ex_ret++;
push @failed_tests, "fuzz test seed $seed";
} else {
my $t_elapsed = int((time - $t_start) * 100)/100;
out("ok ($t_elapsed sec)\n");
}
}
if (@failed_tests) {
print "\nFailed tests: ", join(", ", @failed_tests), "\n";
} else {
print "\nAll tests ok\n";
}
exit($ex_ret);
END {
cleanup();
};