Return to test613.pl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests / libtest

Annotation of embedaddon/curl/tests/libtest/test613.pl, revision 1.1.1.1

1.1       misho       1: #!/usr/bin/env perl
                      2: #***************************************************************************
                      3: #                                  _   _ ____  _
                      4: #  Project                     ___| | | |  _ \| |
                      5: #                             / __| | | | |_) | |
                      6: #                            | (__| |_| |  _ <| |___
                      7: #                             \___|\___/|_| \_\_____|
                      8: #
                      9: # Copyright (C) 1998 - 2020, 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.haxx.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: ###########################################################################
                     23: # Prepare a directory with known files and clean up afterwards
                     24: use Time::Local;
                     25: 
                     26: if ( $#ARGV < 1 )
                     27: {
                     28:     print "Usage: $0 prepare|postprocess dir [logfile]\n";
                     29:     exit 1;
                     30: }
                     31: 
                     32: # <precheck> expects an error message on stdout
                     33: sub errout {
                     34:     print $_[0] . "\n";
                     35:     exit 1;
                     36: }
                     37: 
                     38: if ($ARGV[0] eq "prepare")
                     39: {
                     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: 
                     68:     exit 0;
                     69: }
                     70: elsif ($ARGV[0] eq "postprocess")
                     71: {
                     72:     my $dirname = $ARGV[1];
                     73:     my $logfile = $ARGV[2];
                     74: 
                     75:     # Clean up the test directory
                     76:     unlink "$dirname/rofile.txt";
                     77:     unlink "$dirname/plainfile.txt";
                     78:     rmdir "$dirname/asubdir";
                     79: 
                     80:     rmdir $dirname || die "$!";
                     81: 
                     82:     if ($logfile) {
                     83:         # Process the directory file to remove all information that
                     84:         # could be inconsistent from one test run to the next (e.g.
                     85:         # file date) or may be unsupported on some platforms (e.g.
                     86:         # Windows). Also, since 7.17.0, the sftp directory listing
                     87:         # format can be dependent on the server (with a recent
                     88:         # enough version of libssh2) so this script must also
                     89:         # canonicalize the format.  Here are examples of the general
                     90:         # format supported:
                     91:         # -r--r--r--   12 ausername grp            47 Dec 31  2000 rofile.txt
                     92:         # -r--r--r--   1  1234  4321         47 Dec 31  2000 rofile.txt
                     93:         # The "canonical" format is similar to the first (which is
                     94:         # the one generated on a typical Linux installation):
                     95:         # -r-?r-?r-?   12 U         U              47 Dec 31  2000 rofile.txt
                     96: 
                     97:         my @canondir;
                     98:         open(IN, "<$logfile") || die "$!";
                     99:         while (<IN>) {
                    100:             /^(.)(..).(..).(..).\s*(\S+)\s+\S+\s+\S+\s+(\S+)\s+(\S+\s+\S+\s+\S+)(.*)$/;
                    101:             if ($1 eq "d") {
                    102:                 # Erase all directory metadata except for the name, as it is not
                    103:                 # consistent for across all test systems and filesystems
                    104:                 push @canondir, "d?????????    N U         U               N ???  N NN:NN$8\n";
                    105:             } elsif ($1 eq "-") {
                    106:                 # Erase user and group names, as they are not consistent across
                    107:                 # all test systems
                    108:                 my $line = sprintf("%s%s?%s?%s?%5d U         U %15d %s%s\n", $1,$2,$3,$4,$5,$6,$7,$8);
                    109:                 push @canondir, $line;
                    110:             } else {
                    111:                 # Unexpected format; just pass it through and let the test fail
                    112:                 push @canondir, $_;
                    113:             }
                    114:         }
                    115:         close(IN);
                    116: 
                    117:         @canondir = sort {substr($a,57) cmp substr($b,57)} @canondir;
                    118:         my $newfile = $logfile . ".new";
                    119:         open(OUT, ">$newfile") || die "$!";
                    120:         print OUT join('', @canondir);
                    121:         close(OUT);
                    122: 
                    123:         unlink $logfile;
                    124:         rename $newfile, $logfile;
                    125:     }
                    126: 
                    127:     exit 0;
                    128: }
                    129: print "Unsupported command $ARGV[0]\n";
                    130: exit 1;