summaryrefslogtreecommitdiffstats
path: root/Utilities/cmcurl-7.19.0/tests/libtest/test613.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Utilities/cmcurl-7.19.0/tests/libtest/test613.pl')
-rwxr-xr-xUtilities/cmcurl-7.19.0/tests/libtest/test613.pl105
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;