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) { 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