xref: /curl/tests/libtest/test613.pl (revision a2b4391a) 
1#!/usr/bin/env perl
2#***************************************************************************
3#                                  _   _ ____  _
4#  Project                     ___| | | |  _ \| |
5#                             / __| | | | |_) | |
6#                            | (__| |_| |  _ <| |___
7#                             \___|\___/|_| \_\_____|
8#
9# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
10#
11# This software is licensed as described in the file COPYING, which
12# you should have received as part of this distribution. The terms
13# are also available at https://curl.se/docs/copyright.html.
14#
15# You may opt to use, copy, modify, merge, publish, distribute and/or sell
16# copies of the Software, and permit persons to whom the Software is
17# furnished to do so, under the terms of the COPYING file.
18#
19# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
20# KIND, either express or implied.
21#
22# SPDX-License-Identifier: curl
23#
24###########################################################################
25# Prepare a directory with known files and clean up afterwards
26use Time::Local;
27
28if ( $#ARGV < 1 )
29{
30    print "Usage: $0 prepare|postprocess dir [logfile]\n";
31    exit 1;
32}
33
34# <precheck> expects an error message on stdout
35sub errout {
36    print $_[0] . "\n";
37    exit 1;
38}
39
40if ($ARGV[0] eq "prepare")
41{
42    my $dirname = $ARGV[1];
43    mkdir $dirname || errout "$!";
44    chdir $dirname;
45
46    # Create the files in alphabetical order, to increase the chances
47    # of receiving a consistent set of directory contents regardless
48    # of whether the server alphabetizes the results or not.
49    mkdir "asubdir" || errout "$!";
50    chmod 0777, "asubdir";
51
52    open(FILE, ">plainfile.txt") || errout "$!";
53    binmode FILE;
54    print FILE "Test file to support curl test suite\n";
55    close(FILE);
56    # The mtime is specifically chosen to be an even number so that it can be
57    # represented exactly on a FAT filesystem.
58    utime time, timegm(0,0,12,1,0,100), "plainfile.txt";
59    chmod 0666, "plainfile.txt";
60
61    open(FILE, ">rofile.txt") || errout "$!";
62    binmode FILE;
63    print FILE "Read-only test file to support curl test suite\n";
64    close(FILE);
65    # The mtime is specifically chosen to be an even number so that it can be
66    # represented exactly on a FAT filesystem.
67    utime time, timegm(0,0,12,31,11,100), "rofile.txt";
68    chmod 0444, "rofile.txt";
69
70    exit 0;
71}
72elsif ($ARGV[0] eq "postprocess")
73{
74    my $dirname = $ARGV[1];
75    my $logfile = $ARGV[2];
76
77    # Clean up the test directory
78    unlink "$dirname/rofile.txt";
79    unlink "$dirname/plainfile.txt";
80    rmdir "$dirname/asubdir";
81
82    rmdir $dirname || die "$!";
83
84    if ($logfile && -s $logfile) {
85        # Process the directory file to remove all information that
86        # could be inconsistent from one test run to the next (e.g.
87        # file date) or may be unsupported on some platforms (e.g.
88        # Windows). Also, since 7.17.0, the sftp directory listing
89        # format can be dependent on the server (with a recent
90        # enough version of libssh2) so this script must also
91        # canonicalize the format.  Here are examples of the general
92        # format supported:
93        # -r--r--r--   12 ausername grp            47 Dec 31  2000 rofile.txt
94        # -r--r--r--   1  1234  4321         47 Dec 31  2000 rofile.txt
95        # The "canonical" format is similar to the first (which is
96        # the one generated on a typical Linux installation):
97        # -r-?r-?r-?   12 U         U              47 Dec 31  2000 rofile.txt
98
99        my @canondir;
100        open(IN, "<$logfile") || die "$!";
101        while (<IN>) {
102            /^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)\s+(.*)$/;
103            if ($1 eq "d") {
104                # Skip current and parent directory listing, because some SSH
105                # servers (eg. OpenSSH for Windows) are not listing those
106                if ($8 eq "." || $8 eq "..") {
107                    next;
108                }
109                # Erase all directory metadata except for the name, as it is not
110                # consistent for across all test systems and filesystems
111                push @canondir, "d?????????    N U         U               N ???  N NN:NN $8\n";
112            } elsif ($1 eq "-") {
113                # Replace missing group and other permissions with user
114                # permissions (eg. on Windows) due to them being shown as *
115                my ($u, $g, $o) = ($2, $3, $4);
116                if($g eq "**") {
117                    $g = $u;
118                }
119                if($o eq "**") {
120                    $o = $u;
121                }
122                # Erase user and group names, as they are not consistent across
123                # all test systems
124                my $line = sprintf("%s%s?%s?%s?%5d U         U %15d %s %s\n", $1,$u,$g,$o,$5,$6,$7,$8);
125                push @canondir, $line;
126            } else {
127                # Unexpected format; just pass it through and let the test fail
128                push @canondir, $_;
129            }
130        }
131        close(IN);
132
133        @canondir = sort {substr($a,57) cmp substr($b,57)} @canondir;
134        my $newfile = $logfile . ".new";
135        open(OUT, ">$newfile") || die "$!";
136        print OUT join('', @canondir);
137        close(OUT);
138
139        unlink $logfile;
140        rename $newfile, $logfile;
141    }
142
143    exit 0;
144}
145print "Unsupported command $ARGV[0]\n";
146exit 1;
147