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