diff options
Diffstat (limited to 'Utilities/cmcurl-7.19.0/tests/libtest/test613.pl')
-rwxr-xr-x | Utilities/cmcurl-7.19.0/tests/libtest/test613.pl | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/Utilities/cmcurl-7.19.0/tests/libtest/test613.pl b/Utilities/cmcurl-7.19.0/tests/libtest/test613.pl new file mode 100755 index 0000000..ba9ed32 --- /dev/null +++ b/Utilities/cmcurl-7.19.0/tests/libtest/test613.pl @@ -0,0 +1,105 @@ +#!/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; |