test613.pl (5389B)
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 26 use Time::Local; 27 28 if($#ARGV < 1) { 29 print "Usage: $0 prepare|postprocess dir [logfile]\n"; 30 exit 1; 31 } 32 33 # <precheck> expects an error message on stdout 34 sub errout { 35 print $_[0] . "\n"; 36 exit 1; 37 } 38 39 if($ARGV[0] eq "prepare") { 40 my $dirname = $ARGV[1]; 41 mkdir $dirname || errout "$!"; 42 chdir $dirname; 43 44 # Create the files in alphabetical order, to increase the chances 45 # of receiving a consistent set of directory contents regardless 46 # of whether the server alphabetizes the results or not. 47 mkdir "asubdir" || errout "$!"; 48 chmod 0777, "asubdir"; 49 50 open(FILE, ">plainfile.txt") || errout "$!"; 51 binmode FILE; 52 print FILE "Test file to support curl test suite\n"; 53 close(FILE); 54 # The mtime is specifically chosen to be an even number so that it can be 55 # represented exactly on a FAT filesystem. 56 utime time, timegm(0,0,12,1,0,100), "plainfile.txt"; 57 chmod 0666, "plainfile.txt"; 58 59 open(FILE, ">rofile.txt") || errout "$!"; 60 binmode FILE; 61 print FILE "Read-only test file to support curl test suite\n"; 62 close(FILE); 63 # The mtime is specifically chosen to be an even number so that it can be 64 # represented exactly on a FAT filesystem. 65 utime time, timegm(0,0,12,31,11,100), "rofile.txt"; 66 chmod 0444, "rofile.txt"; 67 if($^O eq 'cygwin') { 68 system "chattr +r rofile.txt"; 69 } 70 71 exit 0; 72 } 73 elsif($ARGV[0] eq "postprocess") { 74 my $dirname = $ARGV[1]; 75 my $logfile = $ARGV[2]; 76 77 # Clean up the test directory 78 if($^O eq 'cygwin') { 79 system "chattr -r $dirname/rofile.txt"; 80 } 81 chmod 0666, "$dirname/rofile.txt"; 82 unlink "$dirname/rofile.txt"; 83 unlink "$dirname/plainfile.txt"; 84 rmdir "$dirname/asubdir"; 85 86 rmdir $dirname || die "$!"; 87 88 if($logfile && -s $logfile) { 89 # Process the directory file to remove all information that 90 # could be inconsistent from one test run to the next (e.g. 91 # file date) or may be unsupported on some platforms (e.g. 92 # Windows). Also, since 7.17.0, the sftp directory listing 93 # format can be dependent on the server (with a recent 94 # enough version of libssh2) so this script must also 95 # canonicalize the format. Here are examples of the general 96 # format supported: 97 # -r--r--r-- 12 ausername grp 47 Dec 31 2000 rofile.txt 98 # -r--r--r-- 1 1234 4321 47 Dec 31 2000 rofile.txt 99 # The "canonical" format is similar to the first (which is 100 # the one generated on a typical Linux installation): 101 # -r-?r-?r-? 12 U U 47 Dec 31 2000 rofile.txt 102 103 my @canondir; 104 open(IN, "<$logfile") || die "$!"; 105 while(<IN>) { 106 /^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)\s+(.*)$/; 107 if($1 eq "d") { 108 # Skip current and parent directory listing, because some SSH 109 # servers (eg. OpenSSH for Windows) are not listing those 110 if($8 eq "." || $8 eq "..") { 111 next; 112 } 113 # Erase all directory metadata except for the name, as it is not 114 # consistent for across all test systems and filesystems 115 push @canondir, "d????????? N U U N ??? N NN:NN $8\n"; 116 } elsif($1 eq "-") { 117 # Ignore group and other permissions, because these may vary on 118 # some systems (e.g. on Windows) 119 # Erase user and group names, as they are not consistent across 120 # all test systems 121 my $line = sprintf("%s%s???????%5d U U %15d %s %s\n", $1,$2,$5,$6,$7,$8); 122 push @canondir, $line; 123 } else { 124 # Unexpected format; just pass it through and let the test fail 125 push @canondir, $_; 126 } 127 } 128 close(IN); 129 130 @canondir = sort {substr($a,57) cmp substr($b,57)} @canondir; 131 my $newfile = $logfile . ".new"; 132 open(OUT, ">$newfile") || die "$!"; 133 print OUT join('', @canondir); 134 close(OUT); 135 136 unlink $logfile; 137 rename $newfile, $logfile; 138 } 139 140 exit 0; 141 } 142 print "Unsupported command $ARGV[0]\n"; 143 exit 1;