aboutsummaryrefslogtreecommitdiff
path: root/tests/libtest/test613.pl
blob: ba9ed32e9025157664ba1d551cc1be83bd87a564 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
#!/usr/bin/env perl
# Prepare a directory with known files and clean up afterwards
use Time::Local;

if ( $#ARGV < 1 ) 
{
	print "Usage: $0 prepare|postprocess dir [logfile]\n";
	exit 1;
}

# <precheck> expects an error message on stdout
sub errout {
	print $_[0] . "\n";
	exit 1;
}

if ($ARGV[0] eq "prepare")
{
	my $dirname = $ARGV[1];
	mkdir $dirname || errout "$!";
	chdir $dirname;

	# Create the files in alphabetical order, to increase the chances
	# of receiving a consistent set of directory contents regardless
	# of whether the server alphabetizes the results or not.
	mkdir "asubdir" || errout "$!";
    	chmod 0777, "asubdir";

	open(FILE, ">plainfile.txt") || errout "$!";
	binmode FILE;
	print FILE "Test file to support curl test suite\n";
    	close(FILE);
    	utime time, timegm(0,0,12,1,0,100), "plainfile.txt";
    	chmod 0666, "plainfile.txt";

	open(FILE, ">rofile.txt") || errout "$!";
	binmode FILE;
	print FILE "Read-only test file to support curl test suite\n";
    	close(FILE);
    	utime time, timegm(0,0,12,31,11,100), "rofile.txt";
    	chmod 0444, "rofile.txt";

	exit 0;
}
elsif ($ARGV[0] eq "postprocess")
{
	my $dirname = $ARGV[1];
	my $logfile = $ARGV[2];

	# Clean up the test directory
	unlink "$dirname/rofile.txt";
	unlink "$dirname/plainfile.txt";
	rmdir "$dirname/asubdir";

	rmdir $dirname || die "$!";

	if ($logfile) {
		# Process the directory file to remove all information that
		# could be inconsistent from one test run to the next (e.g.
		# file date) or may be unsupported on some platforms (e.g.
		# Windows). Also, since 7.17.0, the sftp directory listing
		# format can be dependent on the server (with a recent
		# enough version of libssh2) so this script must also
		# canonicalize the format.  Here are examples of the general
		# format supported:
		# -r--r--r--   12 ausername grp            47 Dec 31  2000 rofile.txt
		# -r--r--r--   1  1234  4321         47 Dec 31  2000 rofile.txt
		# The "canonical" format is similar to the first (which is
		# the one generated on a typical Linux installation):
		# -r-?r-?r-?   12 U         U              47 Dec 31  2000 rofile.txt

		my @canondir;
		open(IN, "<$logfile") || die "$!";
		while (<IN>) {
			/^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)(.*)$/;
			if ($1 eq "d") {
				# Erase all directory metadata except for the name, as it is not
				# consistent for across all test systems and filesystems
				push @canondir, "d?????????    N U         U               N ???  N NN:NN$8\n";
			} elsif ($1 eq "-") {
				# Erase user and group names, as they are not consistent across
				# all test systems
				my $line = sprintf("%s%s?%s?%s?%5d U         U %15d %s%s\n", $1,$2,$3,$4,$5,$6,$7,$8);
				push @canondir, $line;
			} else {
				# Unexpected format; just pass it through and let the test fail
				push @canondir, $_;
			}
		}
		close(IN);

		@canondir = sort {substr($a,57) cmp substr($b,57)} @canondir;
		my $newfile = $logfile . ".new";
		open(OUT, ">$newfile") || die "$!";
		print OUT join('', @canondir);
		close(OUT);

		unlink $logfile;
		rename $newfile, $logfile;
	}

	exit 0;
}
print "Unsupported command $ARGV[0]\n";
exit 1;