test.pl: added fuzz testing (options -f and -F)

Fuzz testing can be used to generate a lot of weird send streams and check
for a successful transfer. Requires fsstress to be installed on the source
machine (i.e. remote for remote testing).
diff --git a/test.pl b/test.pl
index 5b78e58..a577920 100755
--- a/test.pl
+++ b/test.pl
@@ -31,6 +31,8 @@
 	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
@@ -182,7 +184,7 @@
 my $p_diff_outfile = "$p_fardir/send.far";
 my $p_perl = "perl";
 
-my $allok = getopts("d:hkpqr:s:t:v", \%opts);
+my $allok = getopts("d:f:F:hkpqr:s:t:v", \%opts);
 
 if (!$opts{d}) {
 	print STDERR "missing -d destination\n";
@@ -194,6 +196,14 @@
 	$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}) {
@@ -222,6 +232,9 @@
 	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" : "";
@@ -229,10 +242,11 @@
 $remote_host = $opts{r};
 $ssh_socket = "$p_fardir/ssh_sock";
 
-my ($src_type_opt, @p_send, $src_send, $dst_subvol, $send_incr_opt);
+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;
@@ -240,13 +254,78 @@
 } elsif ($src_type eq "btrfs") {
 	$src_type_opt = "-b";
 	@p_send = qw(btrfs send);
-	$send_incr_opt = "-i";
+	@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);
@@ -271,11 +350,13 @@
 		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");
@@ -311,7 +392,9 @@
 }
 
 my $test_spec = "";
-if ($opts{t}) {
+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 /:/;
@@ -336,6 +419,9 @@
 		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";
@@ -359,6 +445,10 @@
 } 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);
@@ -368,7 +458,10 @@
 my $cnt = 0;
 my $ex_ret = 0;
 foreach my $action_file (@files) {
-	if ($test_spec && $action_file !~ $test_spec) {
+	if (!$test_spec) {
+		last;
+	}
+	if ($action_file !~ $test_spec) {
 		next;
 	}
 	my $i = 0;
@@ -436,6 +529,52 @@
 	}
 }
 
+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 {