t / t0021 / rot13-filter.plon commit git-p4: do not pass '-r 0' to p4 commands (bc23352)
   1#
   2# Example implementation for the Git filter protocol version 2
   3# See Documentation/gitattributes.txt, section "Filter Protocol"
   4#
   5# The script takes the list of supported protocol capabilities as
   6# arguments ("clean", "smudge", etc).
   7#
   8# This implementation supports special test cases:
   9# (1) If data with the pathname "clean-write-fail.r" is processed with
  10#     a "clean" operation then the write operation will die.
  11# (2) If data with the pathname "smudge-write-fail.r" is processed with
  12#     a "smudge" operation then the write operation will die.
  13# (3) If data with the pathname "error.r" is processed with any
  14#     operation then the filter signals that it cannot or does not want
  15#     to process the file.
  16# (4) If data with the pathname "abort.r" is processed with any
  17#     operation then the filter signals that it cannot or does not want
  18#     to process the file and any file after that is processed with the
  19#     same command.
  20#
  21
  22use strict;
  23use warnings;
  24use IO::File;
  25
  26my $MAX_PACKET_CONTENT_SIZE = 65516;
  27my @capabilities            = @ARGV;
  28
  29open my $debug, ">>", "rot13-filter.log" or die "cannot open log file: $!";
  30
  31sub rot13 {
  32        my $str = shift;
  33        $str =~ y/A-Za-z/N-ZA-Mn-za-m/;
  34        return $str;
  35}
  36
  37sub packet_bin_read {
  38        my $buffer;
  39        my $bytes_read = read STDIN, $buffer, 4;
  40        if ( $bytes_read == 0 ) {
  41                # EOF - Git stopped talking to us!
  42                print $debug "STOP\n";
  43                exit();
  44        }
  45        elsif ( $bytes_read != 4 ) {
  46                die "invalid packet: '$buffer'";
  47        }
  48        my $pkt_size = hex($buffer);
  49        if ( $pkt_size == 0 ) {
  50                return ( 1, "" );
  51        }
  52        elsif ( $pkt_size > 4 ) {
  53                my $content_size = $pkt_size - 4;
  54                $bytes_read = read STDIN, $buffer, $content_size;
  55                if ( $bytes_read != $content_size ) {
  56                        die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
  57                }
  58                return ( 0, $buffer );
  59        }
  60        else {
  61                die "invalid packet size: $pkt_size";
  62        }
  63}
  64
  65sub packet_txt_read {
  66        my ( $res, $buf ) = packet_bin_read();
  67        unless ( $buf =~ s/\n$// ) {
  68                die "A non-binary line MUST be terminated by an LF.";
  69        }
  70        return ( $res, $buf );
  71}
  72
  73sub packet_bin_write {
  74        my $buf = shift;
  75        print STDOUT sprintf( "%04x", length($buf) + 4 );
  76        print STDOUT $buf;
  77        STDOUT->flush();
  78}
  79
  80sub packet_txt_write {
  81        packet_bin_write( $_[0] . "\n" );
  82}
  83
  84sub packet_flush {
  85        print STDOUT sprintf( "%04x", 0 );
  86        STDOUT->flush();
  87}
  88
  89print $debug "START\n";
  90$debug->flush();
  91
  92( packet_txt_read() eq ( 0, "git-filter-client" ) ) || die "bad initialize";
  93( packet_txt_read() eq ( 0, "version=2" ) )         || die "bad version";
  94( packet_bin_read() eq ( 1, "" ) )                  || die "bad version end";
  95
  96packet_txt_write("git-filter-server");
  97packet_txt_write("version=2");
  98packet_flush();
  99
 100( packet_txt_read() eq ( 0, "capability=clean" ) )  || die "bad capability";
 101( packet_txt_read() eq ( 0, "capability=smudge" ) ) || die "bad capability";
 102( packet_bin_read() eq ( 1, "" ) )                  || die "bad capability end";
 103
 104foreach (@capabilities) {
 105        packet_txt_write( "capability=" . $_ );
 106}
 107packet_flush();
 108print $debug "init handshake complete\n";
 109$debug->flush();
 110
 111while (1) {
 112        my ($command) = packet_txt_read() =~ /^command=([^=]+)$/;
 113        print $debug "IN: $command";
 114        $debug->flush();
 115
 116        my ($pathname) = packet_txt_read() =~ /^pathname=([^=]+)$/;
 117        print $debug " $pathname";
 118        $debug->flush();
 119
 120        # Flush
 121        packet_bin_read();
 122
 123        my $input = "";
 124        {
 125                binmode(STDIN);
 126                my $buffer;
 127                my $done = 0;
 128                while ( !$done ) {
 129                        ( $done, $buffer ) = packet_bin_read();
 130                        $input .= $buffer;
 131                }
 132                print $debug " " . length($input) . " [OK] -- ";
 133                $debug->flush();
 134        }
 135
 136        my $output;
 137        if ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
 138                $output = "";
 139        }
 140        elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
 141                $output = rot13($input);
 142        }
 143        elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
 144                $output = rot13($input);
 145        }
 146        else {
 147                die "bad command '$command'";
 148        }
 149
 150        print $debug "OUT: " . length($output) . " ";
 151        $debug->flush();
 152
 153        if ( $pathname eq "error.r" ) {
 154                print $debug "[ERROR]\n";
 155                $debug->flush();
 156                packet_txt_write("status=error");
 157                packet_flush();
 158        }
 159        elsif ( $pathname eq "abort.r" ) {
 160                print $debug "[ABORT]\n";
 161                $debug->flush();
 162                packet_txt_write("status=abort");
 163                packet_flush();
 164        }
 165        else {
 166                packet_txt_write("status=success");
 167                packet_flush();
 168
 169                if ( $pathname eq "${command}-write-fail.r" ) {
 170                        print $debug "[WRITE FAIL]\n";
 171                        $debug->flush();
 172                        die "${command} write error";
 173                }
 174
 175                while ( length($output) > 0 ) {
 176                        my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
 177                        packet_bin_write($packet);
 178                        # dots represent the number of packets
 179                        print $debug ".";
 180                        if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
 181                                $output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
 182                        }
 183                        else {
 184                                $output = "";
 185                        }
 186                }
 187                packet_flush();
 188                print $debug " [OK]\n";
 189                $debug->flush();
 190                packet_flush();
 191        }
 192}