tests

#!/usr/bin/env perl

use strict;
use warnings;
no warnings qw(newline);

use File::ExtAttr ':all';
use Test::More qw(no_plan); # for the is() and isnt() functions
use IPC::Run3 qw(run3);
use File::Path qw(make_path remove_tree);
use FindBin;
my $testee = "$FindBin::Bin/rk";

################################################################################
# Test constants

my $v1 = 'abcdefghijklmnopqrstuvwxyz';
my $v2 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
my $v3 = '0123456789';

my $h1 = 'c3fcd3d76192e4007dfb496cca67e13b';
my $h2 = '437bba8e0bf58337674f4539e75186ac';
my $h3 = '781e5e245d69b566979b86e28d23f2c7';

# Test filenames
my $fn_suffix = "-\\\'\"\`\n\$\@-#~:;<>!%&|*?()+=[]{}.testfile\r";
my $f1 = "1$fn_suffix";
my $f2 = "2$fn_suffix";
my $f3 = "3$fn_suffix";

# Printed versions of the above from stdout
$fn_suffix =~ s/\n/\\n/g; # Escape newline
my $p1 = "1$fn_suffix";
my $p2 = "2$fn_suffix";
my $p3 = "3$fn_suffix";

################################################################################
# Testing program

foreach my $base (@ARGV) {
	&test_nx     ($base);
	&test_nv     ($base);
	&test_ivu    ($base);
	&test_e      ($base);
	&test_symlink($base);
	&test_recrel ($base);
	&test_future ($base);
	&test_qs     ($base);
}

exit 0;

################################################################################

sub test_nx() {
	my ($base) = @_;
	my %meta;

	&write_file("$base/$f1", $v1);

	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	&is(&invoke(0, 'i', "$base/$f1"), "N $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);

	my $htime = $meta{htime};

	&is(&invoke(0, 'i', "$base/$f1"), "I $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);

	sleep(1); # Make sure timestamp changes
	&clobber_file("$base/$f1", $v2);

	&is(&invoke(0, 'x', "$base/$f1"), "- $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	unlink "$base/$f1";
}

sub test_nv() {
	my ($base) = @_;
	my %meta;

	&write_file("$base/$f1", $v1);

	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	&is(&invoke(0, 'V', "$base/$f1"), "- $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	&is(&invoke(0, 'v', "$base/$f1"), "- $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	&is(&invoke(0, 'i', "$base/$f1"), "N $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);

	my $htime = $meta{htime};

	sleep(1); # Make sure timestamp changes

	&is(&invoke(0, 'V', "$base/$f1"), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);

	&is(&invoke(0, 'v', "$base/$f1"), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&cmp_ok($meta{vtime}, 'gt', $htime);

	my $vtime = $meta{vtime};

	# Simulate spontaneous corruption
	my $mtime = file_mtime("$base/$f1");
	&clobber_file("$base/$f1", $v2);
	utime($mtime, $mtime, "$base/$f1");

	&is(&invoke(1, 'V', "$base/$f1"), "X $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&cmp_ok($meta{vtime}, 'gt', $htime);

	&is(&invoke(1, 'v', "$base/$f1"), "X $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'X');
	&is($meta{vtime}, $vtime);

	unlink "$base/$f1";
}

sub test_ivu() {
	my ($base) = @_;
	my %meta;

	&write_file("$base/$f1", $v1);

	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	# Init
	&is(&invoke(0, 'ivu', "$base/$f1"), "N $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);
	my $htime = $meta{htime};

	# Verify
	&is(&invoke(0, 'ivu', "$base/$f1"), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&cmp_ok($meta{vtime}, 'ge', $htime);

	my $vtime = $meta{vtime};

	# Verify: will fail stale
	sleep(1); # Make sure timestamp changes
	&clobber_file("$base/$f1", $v2);
	&is(&invoke(1, 'iv', "$base/$f1"), "S $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&is($meta{vtime}, $vtime);

	# Update
	&clobber_file("$base/$f1", $v2);
	&is(&invoke(0, 'ivu', "$base/$f1"), "U $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h2);
	&cmp_ok($meta{htime}, 'gt', $vtime);
	&is($meta{state}, 'V');
	&is($meta{vtime}, $vtime);

	$htime = $meta{htime};

	sleep(1); # Make sure timestamp changes
	# Verify again
	&is(&invoke(0, 'ivu', "$base/$f1"), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h2);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&cmp_ok($meta{vtime}, 'ge', $htime);

	unlink "$base/$f1";
}

sub test_e {
	my ($base) = @_;
	my %meta;

	&write_file("$base/$f1", $v1);

	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta,0);

	&is(&invoke(0, 'e', "$base/$f1"), "        26  --------------------------------  $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta,0);

	&is(&invoke(0, 'iv', "$base/$f1"), "N $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta,2);
	&is($meta{md5},$h1);
	&is(length($meta{htime}),19);

	&is(&invoke(0, 'e', "$base/$f1"), "        26  $h1  $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta,2);
	&is($meta{md5},$h1);
	&is(length($meta{htime}),19);

	unlink "$base/$f1";
}

sub test_symlink {
	my ($base) = @_;
	my %meta;

	&write_file("$base/$f1", $v1);

	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta,0);

	symlink($f1, "$base/$f2") or die "Couldn't create symlink!";

	%meta = %{&meta_get("$base/$f2")};
	&is(scalar keys %meta,0);

	&is(&invoke(0, 'i', "$base/$f2"), '');
	%meta = %{&meta_get("$base/$f2")};
	&is(scalar keys %meta,0);

	# These are for when no_follow_file_symlinks=0
#	&is(scalar keys %meta, 2);
#	&is($meta{md5}, $h1);
#	&is(length($meta{htime}), 19);

#	my $htime = $meta{htime};

#	%meta = %{&meta_get("$base/$f1")};
#	&is(scalar keys %meta, 2);
#	&is($meta{md5}, $h1);
#	&is($meta{htime}, $htime);

	unlink "$base/$f1","$base/$f2";
}

sub test_recrel() {
	my ($base) = @_;

	make_path("$base/dir1/dir2","$base/dir1/dir3");

	&write_file("$base/dir1/$f1", $v1);
	&write_file("$base/dir1/dir2/$f1", $v1);
	&write_file("$base/dir1/dir2/$f2", $v2);
	&write_file("$base/dir1/dir3/$f1", $v1);
	&write_file("$base/dir1/dir3/$f3", $v3);

	my @expected = sort(
		"- $base/dir1/dir2/$p1",
		"- $base/dir1/dir3/$p1",
		"- $base/dir1/$p1"     ,
		"- $base/dir1/dir2/$p2",
		"- $base/dir1/dir3/$p3");

	my @expected_rel = sort(
		"- dir2/$p1",
		"- dir3/$p1",
		"- $p1"     ,
		"- dir2/$p2",
		"- dir3/$p3");

	my @got = sort(split(/\n/, &invoke(0, '', "./$base/dir1")));
	&is_deeply(\@got,\@expected);

	@got = sort(split(/\n/, &invoke(0, 'r', "./$base/dir1")));
	&is_deeply(\@got,\@expected_rel);

	remove_tree(
		"$base/dir1",
		{
			verbose => 0,
			safe => 1,
		});
}

sub test_future {
	my ($base) = @_;
	my %meta;

	my $goodTime = time;
	my $badTime = 9999999999;

	# Create test file with future mtime
	&write_file("$base/$f1", $v1);
	utime($badTime, $badTime, "$base/$f1");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	# Init should work
	&is(&invoke(0, 'i', ("$base/$f1")), "N $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);
	my $htime = $meta{htime};

	# Verify should error
	&is(&invoke(1, 'V', ("$base/$f1")), "F $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is(length $meta{htime}, 19);

	&is(&invoke(1, 'v', ("$base/$f1")), "F $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);

	# Verify should work with a sensible mtime
	utime($goodTime, $goodTime, "$base/$f1");

	&is(&invoke(0, 'V', ("$base/$f1")), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 2);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);

	&is(&invoke(0, 'v', ("$base/$f1")), "V $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&cmp_ok($meta{vtime}, 'ge', $htime);
	my $vtime = $meta{vtime};

	# Update should error
	utime($badTime, $badTime, "$base/$f1");
	&is(&invoke(1, 'u', ("$base/$f1")), "F $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 4);
	&is($meta{md5}, $h1);
	&is($meta{htime}, $htime);
	&is($meta{state}, 'V');
	&is($meta{vtime}, $vtime);

	# Verify should still work
	&is(&invoke(0, 'x', ("$base/$f1")), "- $base/$p1\n");
	%meta = %{&meta_get("$base/$f1")};
	&is(scalar keys %meta, 0);

	unlink "$base/$f1";
}

sub test_qs {
	my ($base) = @_;

	# Control, all quiet, all skip, one quiet, one skip
	my @paths = ("$base/C", "$base/Q", "$base/S", "$base/q", "$base/s");
	my ($f1, $f2) = ("a", "b");

	##################################
	# Create dirs+files with metafiles

	foreach my $path (@paths)
	{
		make_path($path);
		&write_file("$path/$f1", $v1);
		&write_file("$path/$f2", $v2);
	}

	&write_file("$paths[1]/.rk.quiet", '');
	&write_file("$paths[2]/.rk.skip" , '');
	&write_file("$paths[3]/.rk.quiet", "$f1");
	&write_file("$paths[4]/.rk.skip" , "$f1");

	########################
	# Verify what was logged

	my @expected_log = sort(
		"N $base/q/.rk.quiet",
		"N $base/s/.rk.skip",
		"N $base/C/a",
		"N $base/C/b",
		"N $base/q/$f2",
		"N $base/s/$f2");

	&is_deeply(
		[sort(split(/\n/, &invoke(0, 'i', "./$base")))],
		\@expected_log);

	#########################
	# Verify what was touched

	my %md_count;
	foreach my $path (@paths)
	{
		foreach my $name ($f1, $f2)
		{
			my $file = "$path/$name";
			$md_count{$file}  =  scalar %{meta_get($file)};
		}
	}

	my %expected_mdc=
	(
		"$base/C/a" => 2,
		"$base/C/b" => 2,
		"$base/Q/a" => 2,
		"$base/Q/b" => 2,
		"$base/S/a" => 0,
		"$base/S/b" => 0,
		"$base/q/a" => 2,
		"$base/q/b" => 2,
		"$base/s/a" => 0,
		"$base/s/b" => 2,
	);

	&is_deeply(\%md_count, \%expected_mdc);

	####################################
	# Verify quiet and unquiet overrides

	&is(&invoke(0, 'q', "./$base"), ''); # Quiet override: no output!

	# Unquiet override: everything except skipped output
	@expected_log = sort(
		"I $base/Q/.rk.quiet",
		"I $base/q/.rk.quiet",
		"I $base/s/.rk.skip",
		"I $base/C/a",
		"I $base/C/b",
		"I $base/Q/a",
		"I $base/Q/b",
		"I $base/q/a",
		"I $base/q/b",
		"I $base/s/b");

	&is_deeply(
		[sort(split(/\n/, &invoke(0, 'Q', "./$base")))],
		\@expected_log);

	#########
	# Tidy up

	remove_tree(
		@paths,
		{
			verbose => 0,
			safe => 1,
		});
}

################################################################################
# Test helpers

sub meta_get() {
	my ($file) = @_;

	my $out;

	my %fields;

	foreach ('md5', 'htime', 'state', 'vtime') {
		my $value = &getfattr($file, "rk.$_");
		$fields{$_} = $value if (defined $value);
	}

	# Individual validation
	die 'Bad hash!'  if defined $fields{md5}  and  $fields{md5} !~ /^[\da-f]{32}$/;
	die 'Bad htime!' if defined $fields{htime}  and  $fields{htime} !~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}/;
	die 'Bad state!' if defined $fields{state}  and  $fields{state} !~ /[VX]/;
	die 'Bad htime!' if defined $fields{vtime}  and  $fields{vtime} !~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}/;

	# Collective validation: md5 and htime must appear together, and neither state nor vtime must appear without them
	delete @fields{'md5', 'htime', 'state', 'vtime'} unless defined $fields{md5}  and  defined $fields{htime};
	delete @fields{'state', 'vtime'} unless defined $fields{state};

	return \%fields;
}

sub file_mtime {
	my ($file) = @_;

	my @stat = (stat($file));
	die "$file: cannot stat!" unless scalar(@stat) > 9; # This should never happen™

	return $stat[9];
}

sub invoke {
	my ($result, $mode, @files) = (@_);

	my @args = ($testee, "-$mode", @files);

	splice(@args, 1, 1) if $args[1] eq '-';

	die unless run3 \@args, undef, \my $out, undef;
	die unless $? == $result<<8;
	return $out;
}

sub clobber_file {
	my ($file, $content) = @_;
	run3 [ 'echo', '-n', $content ], undef, $file, undef or die;
}

sub write_file {
	my ($file, $content) = @_;

	die 'Test file already exists!' if (-e $file);
	&clobber_file($file, $content);
}