t / t0021 / rot13-filter.plon commit t: send verbose test-helper output to fd 4 (03aa378)
   1#
   2# Example implementation for the Git filter protocol version 2
   3# See Documentation/gitattributes.txt, section "Filter Protocol"
   4#
   5# The first argument defines a debug log file that the script write to.
   6# All remaining arguments define a list of supported protocol
   7# capabilities ("clean", "smudge", etc).
   8#
   9# This implementation supports special test cases:
  10# (1) If data with the pathname "clean-write-fail.r" is processed with
  11#     a "clean" operation then the write operation will die.
  12# (2) If data with the pathname "smudge-write-fail.r" is processed with
  13#     a "smudge" operation then the write operation will die.
  14# (3) If data with the pathname "error.r" is processed with any
  15#     operation then the filter signals that it cannot or does not want
  16#     to process the file.
  17# (4) If data with the pathname "abort.r" is processed with any
  18#     operation then the filter signals that it cannot or does not want
  19#     to process the file and any file after that is processed with the
  20#     same command.
  21# (5) If data with a pathname that is a key in the DELAY hash is
  22#     requested (e.g. "test-delay10.a") then the filter responds with
  23#     a "delay" status and sets the "requested" field in the DELAY hash.
  24#     The filter will signal the availability of this object after
  25#     "count" (field in DELAY hash) "list_available_blobs" commands.
  26# (6) If data with the pathname "missing-delay.a" is processed that the
  27#     filter will drop the path from the "list_available_blobs" response.
  28# (7) If data with the pathname "invalid-delay.a" is processed that the
  29#     filter will add the path "unfiltered" which was not delayed before
  30#     to the "list_available_blobs" response.
  31#
  32
  33use 5.008;
  34sub gitperllib {
  35        # Git assumes that all path lists are Unix-y colon-separated ones. But
  36        # when the Git for Windows executes the test suite, its MSYS2 Bash
  37        # calls git.exe, and colon-separated path lists are converted into
  38        # Windows-y semicolon-separated lists of *Windows* paths (which
  39        # naturally contain a colon after the drive letter, so splitting by
  40        # colons simply does not cut it).
  41        #
  42        # Detect semicolon-separated path list and handle them appropriately.
  43
  44        if ($ENV{GITPERLLIB} =~ /;/) {
  45                return split(/;/, $ENV{GITPERLLIB});
  46        }
  47        return split(/:/, $ENV{GITPERLLIB});
  48}
  49use lib (gitperllib());
  50use strict;
  51use warnings;
  52use IO::File;
  53use Git::Packet;
  54
  55my $MAX_PACKET_CONTENT_SIZE = 65516;
  56my $log_file                = shift @ARGV;
  57my @capabilities            = @ARGV;
  58
  59open my $debug, ">>", $log_file or die "cannot open log file: $!";
  60
  61my %DELAY = (
  62        'test-delay10.a' => { "requested" => 0, "count" => 1 },
  63        'test-delay11.a' => { "requested" => 0, "count" => 1 },
  64        'test-delay20.a' => { "requested" => 0, "count" => 2 },
  65        'test-delay10.b' => { "requested" => 0, "count" => 1 },
  66        'missing-delay.a' => { "requested" => 0, "count" => 1 },
  67        'invalid-delay.a' => { "requested" => 0, "count" => 1 },
  68);
  69
  70sub rot13 {
  71        my $str = shift;
  72        $str =~ y/A-Za-z/N-ZA-Mn-za-m/;
  73        return $str;
  74}
  75
  76print $debug "START\n";
  77$debug->flush();
  78
  79packet_initialize("git-filter", 2);
  80
  81my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
  82packet_check_and_write_capabilities(\%remote_caps, @capabilities);
  83
  84print $debug "init handshake complete\n";
  85$debug->flush();
  86
  87while (1) {
  88        my ( $res, $command ) = packet_key_val_read("command");
  89        if ( $res == -1 ) {
  90                print $debug "STOP\n";
  91                exit();
  92        }
  93        print $debug "IN: $command";
  94        $debug->flush();
  95
  96        if ( $command eq "list_available_blobs" ) {
  97                # Flush
  98                packet_compare_lists([1, ""], packet_bin_read()) ||
  99                        die "bad list_available_blobs end";
 100
 101                foreach my $pathname ( sort keys %DELAY ) {
 102                        if ( $DELAY{$pathname}{"requested"} >= 1 ) {
 103                                $DELAY{$pathname}{"count"} = $DELAY{$pathname}{"count"} - 1;
 104                                if ( $pathname eq "invalid-delay.a" ) {
 105                                        # Send Git a pathname that was not delayed earlier
 106                                        packet_txt_write("pathname=unfiltered");
 107                                }
 108                                if ( $pathname eq "missing-delay.a" ) {
 109                                        # Do not signal Git that this file is available
 110                                } elsif ( $DELAY{$pathname}{"count"} == 0 ) {
 111                                        print $debug " $pathname";
 112                                        packet_txt_write("pathname=$pathname");
 113                                }
 114                        }
 115                }
 116
 117                packet_flush();
 118
 119                print $debug " [OK]\n";
 120                $debug->flush();
 121                packet_txt_write("status=success");
 122                packet_flush();
 123        } else {
 124                my ( $res, $pathname ) = packet_key_val_read("pathname");
 125                if ( $res == -1 ) {
 126                        die "unexpected EOF while expecting pathname";
 127                }
 128                print $debug " $pathname";
 129                $debug->flush();
 130
 131                # Read until flush
 132                my ( $done, $buffer ) = packet_txt_read();
 133                while ( $buffer ne '' ) {
 134                        if ( $buffer eq "can-delay=1" ) {
 135                                if ( exists $DELAY{$pathname} and $DELAY{$pathname}{"requested"} == 0 ) {
 136                                        $DELAY{$pathname}{"requested"} = 1;
 137                                }
 138                        } else {
 139                                die "Unknown message '$buffer'";
 140                        }
 141
 142                        ( $done, $buffer ) = packet_txt_read();
 143                }
 144                if ( $done == -1 ) {
 145                        die "unexpected EOF after pathname '$pathname'";
 146                }
 147
 148                my $input = "";
 149                {
 150                        binmode(STDIN);
 151                        my $buffer;
 152                        my $done = 0;
 153                        while ( !$done ) {
 154                                ( $done, $buffer ) = packet_bin_read();
 155                                $input .= $buffer;
 156                        }
 157                        if ( $done == -1 ) {
 158                                die "unexpected EOF while reading input for '$pathname'";
 159                        }                       
 160                        print $debug " " . length($input) . " [OK] -- ";
 161                        $debug->flush();
 162                }
 163
 164                my $output;
 165                if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
 166                        $output = $DELAY{$pathname}{"output"}
 167                } elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
 168                        $output = "";
 169                } elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
 170                        $output = rot13($input);
 171                } elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
 172                        $output = rot13($input);
 173                } else {
 174                        die "bad command '$command'";
 175                }
 176
 177                if ( $pathname eq "error.r" ) {
 178                        print $debug "[ERROR]\n";
 179                        $debug->flush();
 180                        packet_txt_write("status=error");
 181                        packet_flush();
 182                } elsif ( $pathname eq "abort.r" ) {
 183                        print $debug "[ABORT]\n";
 184                        $debug->flush();
 185                        packet_txt_write("status=abort");
 186                        packet_flush();
 187                } elsif ( $command eq "smudge" and
 188                        exists $DELAY{$pathname} and
 189                        $DELAY{$pathname}{"requested"} == 1 ) {
 190                        print $debug "[DELAYED]\n";
 191                        $debug->flush();
 192                        packet_txt_write("status=delayed");
 193                        packet_flush();
 194                        $DELAY{$pathname}{"requested"} = 2;
 195                        $DELAY{$pathname}{"output"} = $output;
 196                } else {
 197                        packet_txt_write("status=success");
 198                        packet_flush();
 199
 200                        if ( $pathname eq "${command}-write-fail.r" ) {
 201                                print $debug "[WRITE FAIL]\n";
 202                                $debug->flush();
 203                                die "${command} write error";
 204                        }
 205
 206                        print $debug "OUT: " . length($output) . " ";
 207                        $debug->flush();
 208
 209                        while ( length($output) > 0 ) {
 210                                my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
 211                                packet_bin_write($packet);
 212                                # dots represent the number of packets
 213                                print $debug ".";
 214                                if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
 215                                        $output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
 216                                } else {
 217                                        $output = "";
 218                                }
 219                        }
 220                        packet_flush();
 221                        print $debug " [OK]\n";
 222                        $debug->flush();
 223                        packet_flush();
 224                }
 225        }
 226}