1#!/usr/bin/env perl
2# Prepare a directory with known files and clean up afterwards
3use Time::Local;
4
5if ( $#ARGV < 1 )
6{
7    print "Usage: $0 prepare|postprocess dir [logfile]\n";
8    exit 1;
9}
10
11# <precheck> expects an error message on stdout
12sub errout {
13    print $_[0] . "\n";
14    exit 1;
15}
16
17if ($ARGV[0] eq "prepare")
18{
19    my $dirname = $ARGV[1];
20    mkdir $dirname || errout "$!";
21    chdir $dirname;
22
23    # Create the files in alphabetical order, to increase the chances
24    # of receiving a consistent set of directory contents regardless
25    # of whether the server alphabetizes the results or not.
26    mkdir "asubdir" || errout "$!";
27    chmod 0777, "asubdir";
28
29    open(FILE, ">plainfile.txt") || errout "$!";
30    binmode FILE;
31    print FILE "Test file to support curl test suite\n";
32    close(FILE);
33    utime time, timegm(0,0,12,1,0,100), "plainfile.txt";
34    chmod 0666, "plainfile.txt";
35
36    open(FILE, ">rofile.txt") || errout "$!";
37    binmode FILE;
38    print FILE "Read-only test file to support curl test suite\n";
39    close(FILE);
40    utime time, timegm(0,0,12,31,11,100), "rofile.txt";
41    chmod 0444, "rofile.txt";
42
43    exit 0;
44}
45elsif ($ARGV[0] eq "postprocess")
46{
47    my $dirname = $ARGV[1];
48    my $logfile = $ARGV[2];
49
50    # Clean up the test directory
51    unlink "$dirname/rofile.txt";
52    unlink "$dirname/plainfile.txt";
53    rmdir "$dirname/asubdir";
54
55    rmdir $dirname || die "$!";
56
57    if ($logfile) {
58        # Process the directory file to remove all information that
59        # could be inconsistent from one test run to the next (e.g.
60        # file date) or may be unsupported on some platforms (e.g.
61        # Windows). Also, since 7.17.0, the sftp directory listing
62        # format can be dependent on the server (with a recent
63        # enough version of libssh2) so this script must also
64        # canonicalize the format.  Here are examples of the general
65        # format supported:
66        # -r--r--r--   12 ausername grp            47 Dec 31  2000 rofile.txt
67        # -r--r--r--   1  1234  4321         47 Dec 31  2000 rofile.txt
68        # The "canonical" format is similar to the first (which is
69        # the one generated on a typical Linux installation):
70        # -r-?r-?r-?   12 U         U              47 Dec 31  2000 rofile.txt
71
72        my @canondir;
73        open(IN, "<$logfile") || die "$!";
74        while (<IN>) {
75            /^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)(.*)$/;
76            if ($1 eq "d") {
77                # Erase all directory metadata except for the name, as it is not
78                # consistent for across all test systems and filesystems
79                push @canondir, "d?????????    N U         U               N ???  N NN:NN$8\n";
80            } elsif ($1 eq "-") {
81                # Erase user and group names, as they are not consistent across
82                # all test systems
83                my $line = sprintf("%s%s?%s?%s?%5d U         U %15d %s%s\n", $1,$2,$3,$4,$5,$6,$7,$8);
84                push @canondir, $line;
85            } else {
86                # Unexpected format; just pass it through and let the test fail
87                push @canondir, $_;
88            }
89        }
90        close(IN);
91
92        @canondir = sort {substr($a,57) cmp substr($b,57)} @canondir;
93        my $newfile = $logfile . ".new";
94        open(OUT, ">$newfile") || die "$!";
95        print OUT join('', @canondir);
96        close(OUT);
97
98        unlink $logfile;
99        rename $newfile, $logfile;
100    }
101
102    exit 0;
103}
104print "Unsupported command $ARGV[0]\n";
105exit 1;
106