t/t0021/rot13-filter.pl

   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
  33 use 5.008;
  34 sub 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 }
  49 use lib (gitperllib());
  50 use strict;
  51 use warnings;
  52 use IO::File;
  53 use Git::Packet;
  54
  55 my $MAX_PACKET_CONTENT_SIZE = 65516;
  56 my $log_file                = shift @ARGV;
  57 my @capabilities            = @ARGV;
  58
  59 open my $debug, ">>", $log_file or die "cannot open log file: $!";
  60
  61 my %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
  70 sub rot13 {
  71         my $str = shift;
  72         $str =~ y/A-Za-z/N-ZA-Mn-za-m/;
  73         return $str;
  74 }
  75
  76 print $debug "START\n";
  77 $debug->flush();
  78
  79 packet_initialize("git-filter", 2);
  80
  81 my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
  82 packet_check_and_write_capabilities(\%remote_caps, @capabilities);
  83
  84 print $debug "init handshake complete\n";
  85 $debug->flush();
  86
  87 while (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                         } elsif ($buffer =~ /^(ref|treeish|blob)=/) {
 139                                 print $debug " $buffer";
 140                         } else {
 141                                 # In general, filters need to be graceful about
 142                                 # new metadata, since it's documented that we
 143                                 # can pass any key-value pairs, but for tests,
 144                                 # let's be a little stricter.
 145                                 die "Unknown message '$buffer'";
 146                         }
 147
 148                         ( $done, $buffer ) = packet_txt_read();
 149                 }
 150                 if ( $done == -1 ) {
 151                         die "unexpected EOF after pathname '$pathname'";
 152                 }
 153
 154                 my $input = "";
 155                 {
 156                         binmode(STDIN);
 157                         my $buffer;
 158                         my $done = 0;
 159                         while ( !$done ) {
 160                                 ( $done, $buffer ) = packet_bin_read();
 161                                 $input .= $buffer;
 162                         }
 163                         if ( $done == -1 ) {
 164                                 die "unexpected EOF while reading input for '$pathname'";
 165                         }
 166                         print $debug " " . length($input) . " [OK] -- ";
 167                         $debug->flush();
 168                 }
 169
 170                 my $output;
 171                 if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
 172                         $output = $DELAY{$pathname}{"output"}
 173                 } elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
 174                         $output = "";
 175                 } elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
 176                         $output = rot13($input);
 177                 } elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
 178                         $output = rot13($input);
 179                 } else {
 180                         die "bad command '$command'";
 181                 }
 182
 183                 if ( $pathname eq "error.r" ) {
 184                         print $debug "[ERROR]\n";
 185                         $debug->flush();
 186                         packet_txt_write("status=error");
 187                         packet_flush();
 188                 } elsif ( $pathname eq "abort.r" ) {
 189                         print $debug "[ABORT]\n";
 190                         $debug->flush();
 191                         packet_txt_write("status=abort");
 192                         packet_flush();
 193                 } elsif ( $command eq "smudge" and
 194                         exists $DELAY{$pathname} and
 195                         $DELAY{$pathname}{"requested"} == 1 ) {
 196                         print $debug "[DELAYED]\n";
 197                         $debug->flush();
 198                         packet_txt_write("status=delayed");
 199                         packet_flush();
 200                         $DELAY{$pathname}{"requested"} = 2;
 201                         $DELAY{$pathname}{"output"} = $output;
 202                 } else {
 203                         packet_txt_write("status=success");
 204                         packet_flush();
 205
 206                         if ( $pathname eq "${command}-write-fail.r" ) {
 207                                 print $debug "[WRITE FAIL]\n";
 208                                 $debug->flush();
 209                                 die "${command} write error";
 210                         }
 211
 212                         print $debug "OUT: " . length($output) . " ";
 213                         $debug->flush();
 214
 215                         while ( length($output) > 0 ) {
 216                                 my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
 217                                 packet_bin_write($packet);
 218                                 # dots represent the number of packets
 219                                 print $debug ".";
 220                                 if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
 221                                         $output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
 222                                 } else {
 223                                         $output = "";
 224                                 }
 225                         }
 226                         packet_flush();
 227                         print $debug " [OK]\n";
 228                         $debug->flush();
 229                         packet_flush();
 230                 }
 231         }
 232 }