tests/libtest/test613.pl

   1 #!/usr/bin/env perl
   2 # Prepare a directory with known files and clean up afterwards
   3 use Time::Local;
   4
   5 if ( $#ARGV < 1 )
   6 {
   7     print "Usage: $0 prepare|postprocess dir [logfile]\n";
   8     exit 1;
   9 }
  10
  11 # <precheck> expects an error message on stdout
  12 sub errout {
  13     print $_[0] . "\n";
  14     exit 1;
  15 }
  16
  17 if ($ARGV[0] eq "prepare")
  18 {
  19     my $dirname = $ARGV[1];
  20     mkdir $dirname || errout "$!";
  21     chdir $dirname;
  22
  23     # Create the files in alphabetical order, to increase the chances
  24     # of receiving a consistent set of directory contents regardless
  25     # of whether the server alphabetizes the results or not.
  26     mkdir "asubdir" || errout "$!";
  27     chmod 0777, "asubdir";
  28
  29     open(FILE, ">plainfile.txt") || errout "$!";
  30     binmode FILE;
  31     print FILE "Test file to support curl test suite\n";
  32     close(FILE);
  33     # The mtime is specifically chosen to be an even number so that it can be
  34     # represented exactly on a FAT filesystem.
  35     utime time, timegm(0,0,12,1,0,100), "plainfile.txt";
  36     chmod 0666, "plainfile.txt";
  37
  38     open(FILE, ">rofile.txt") || errout "$!";
  39     binmode FILE;
  40     print FILE "Read-only test file to support curl test suite\n";
  41     close(FILE);
  42     # The mtime is specifically chosen to be an even number so that it can be
  43     # represented exactly on a FAT filesystem.
  44     utime time, timegm(0,0,12,31,11,100), "rofile.txt";
  45     chmod 0444, "rofile.txt";
  46
  47     exit 0;
  48 }
  49 elsif ($ARGV[0] eq "postprocess")
  50 {
  51     my $dirname = $ARGV[1];
  52     my $logfile = $ARGV[2];
  53
  54     # Clean up the test directory
  55     unlink "$dirname/rofile.txt";
  56     unlink "$dirname/plainfile.txt";
  57     rmdir "$dirname/asubdir";
  58
  59     rmdir $dirname || die "$!";
  60
  61     if ($logfile) {
  62         # Process the directory file to remove all information that
  63         # could be inconsistent from one test run to the next (e.g.
  64         # file date) or may be unsupported on some platforms (e.g.
  65         # Windows). Also, since 7.17.0, the sftp directory listing
  66         # format can be dependent on the server (with a recent
  67         # enough version of libssh2) so this script must also
  68         # canonicalize the format.  Here are examples of the general
  69         # format supported:
  70         # -r--r--r--   12 ausername grp            47 Dec 31  2000 rofile.txt
  71         # -r--r--r--   1  1234  4321         47 Dec 31  2000 rofile.txt
  72         # The "canonical" format is similar to the first (which is
  73         # the one generated on a typical Linux installation):
  74         # -r-?r-?r-?   12 U         U              47 Dec 31  2000 rofile.txt
  75
  76         my @canondir;
  77         open(IN, "<$logfile") || die "$!";
  78         while (<IN>) {
  79             /^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)(.*)$/;
  80             if ($1 eq "d") {
  81                 # Erase all directory metadata except for the name, as it is not
  82                 # consistent for across all test systems and filesystems
  83                 push @canondir, "d?????????    N U         U               N ???  N NN:NN$8\n";
  84             } elsif ($1 eq "-") {
  85                 # Erase user and group names, as they are not consistent across
  86                 # all test systems
  87                 my $line = sprintf("%s%s?%s?%s?%5d U         U %15d %s%s\n", $1,$2,$3,$4,$5,$6,$7,$8);
  88                 push @canondir, $line;
  89             } else {
  90                 # Unexpected format; just pass it through and let the test fail
  91                 push @canondir, $_;
  92             }
  93         }
  94         close(IN);
  95
  96         @canondir = sort {substr($a,57) cmp substr($b,57)} @canondir;
  97         my $newfile = $logfile . ".new";
  98         open(OUT, ">$newfile") || die "$!";
  99         print OUT join('', @canondir);
 100         close(OUT);
 101
 102         unlink $logfile;
 103         rename $newfile, $logfile;
 104     }
 105
 106     exit 0;
 107 }
 108 print "Unsupported command $ARGV[0]\n";
 109 exit 1;