#!/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;