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