# to the "list_available_blobs" response.
#
+use 5.008;
+sub gitperllib {
+ # Git assumes that all path lists are Unix-y colon-separated ones. But
+ # when the Git for Windows executes the test suite, its MSYS2 Bash
+ # calls git.exe, and colon-separated path lists are converted into
+ # Windows-y semicolon-separated lists of *Windows* paths (which
+ # naturally contain a colon after the drive letter, so splitting by
+ # colons simply does not cut it).
+ #
+ # Detect semicolon-separated path list and handle them appropriately.
+
+ if ($ENV{GITPERLLIB} =~ /;/) {
+ return split(/;/, $ENV{GITPERLLIB});
+ }
+ return split(/:/, $ENV{GITPERLLIB});
+}
+use lib (gitperllib());
use strict;
use warnings;
use IO::File;
+use Git::Packet;
my $MAX_PACKET_CONTENT_SIZE = 65516;
my $log_file = shift @ARGV;
return $str;
}
-sub packet_bin_read {
- my $buffer;
- my $bytes_read = read STDIN, $buffer, 4;
- if ( $bytes_read == 0 ) {
- # EOF - Git stopped talking to us!
- print $debug "STOP\n";
- exit();
- }
- elsif ( $bytes_read != 4 ) {
- die "invalid packet: '$buffer'";
- }
- my $pkt_size = hex($buffer);
- if ( $pkt_size == 0 ) {
- return ( 1, "" );
- }
- elsif ( $pkt_size > 4 ) {
- my $content_size = $pkt_size - 4;
- $bytes_read = read STDIN, $buffer, $content_size;
- if ( $bytes_read != $content_size ) {
- die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
- }
- return ( 0, $buffer );
- }
- else {
- die "invalid packet size: $pkt_size";
- }
-}
-
-sub packet_txt_read {
- my ( $res, $buf ) = packet_bin_read();
- unless ( $buf eq '' or $buf =~ s/\n$// ) {
- die "A non-binary line MUST be terminated by an LF.";
- }
- return ( $res, $buf );
-}
-
-sub packet_bin_write {
- my $buf = shift;
- print STDOUT sprintf( "%04x", length($buf) + 4 );
- print STDOUT $buf;
- STDOUT->flush();
-}
-
-sub packet_txt_write {
- packet_bin_write( $_[0] . "\n" );
-}
-
-sub packet_flush {
- print STDOUT sprintf( "%04x", 0 );
- STDOUT->flush();
-}
-
print $debug "START\n";
$debug->flush();
-( packet_txt_read() eq ( 0, "git-filter-client" ) ) || die "bad initialize";
-( packet_txt_read() eq ( 0, "version=2" ) ) || die "bad version";
-( packet_bin_read() eq ( 1, "" ) ) || die "bad version end";
-
-packet_txt_write("git-filter-server");
-packet_txt_write("version=2");
-packet_flush();
+packet_initialize("git-filter", 2);
-( packet_txt_read() eq ( 0, "capability=clean" ) ) || die "bad capability";
-( packet_txt_read() eq ( 0, "capability=smudge" ) ) || die "bad capability";
-( packet_txt_read() eq ( 0, "capability=delay" ) ) || die "bad capability";
-( packet_bin_read() eq ( 1, "" ) ) || die "bad capability end";
+my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
+packet_check_and_write_capabilities(\%remote_caps, @capabilities);
-foreach (@capabilities) {
- packet_txt_write( "capability=" . $_ );
-}
-packet_flush();
print $debug "init handshake complete\n";
$debug->flush();
while (1) {
- my ( $command ) = packet_txt_read() =~ /^command=(.+)$/;
+ my ( $res, $command ) = packet_key_val_read("command");
+ if ( $res == -1 ) {
+ print $debug "STOP\n";
+ exit();
+ }
print $debug "IN: $command";
$debug->flush();
if ( $command eq "list_available_blobs" ) {
# Flush
- packet_bin_read();
+ packet_compare_lists([1, ""], packet_bin_read()) ||
+ die "bad list_available_blobs end";
foreach my $pathname ( sort keys %DELAY ) {
if ( $DELAY{$pathname}{"requested"} >= 1 ) {
$debug->flush();
packet_txt_write("status=success");
packet_flush();
- }
- else {
- my ( $pathname ) = packet_txt_read() =~ /^pathname=(.+)$/;
+ } else {
+ my ( $res, $pathname ) = packet_key_val_read("pathname");
+ if ( $res == -1 ) {
+ die "unexpected EOF while expecting pathname";
+ }
print $debug " $pathname";
$debug->flush();
- if ( $pathname eq "" ) {
- die "bad pathname '$pathname'";
- }
-
# Read until flush
my ( $done, $buffer ) = packet_txt_read();
while ( $buffer ne '' ) {
( $done, $buffer ) = packet_txt_read();
}
+ if ( $done == -1 ) {
+ die "unexpected EOF after pathname '$pathname'";
+ }
my $input = "";
{
( $done, $buffer ) = packet_bin_read();
$input .= $buffer;
}
+ if ( $done == -1 ) {
+ die "unexpected EOF while reading input for '$pathname'";
+ }
print $debug " " . length($input) . " [OK] -- ";
$debug->flush();
}
my $output;
if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
$output = $DELAY{$pathname}{"output"}
- }
- elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
+ } elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
$output = "";
- }
- elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
+ } elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
$output = rot13($input);
- }
- elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
+ } elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
$output = rot13($input);
- }
- else {
+ } else {
die "bad command '$command'";
}
$debug->flush();
packet_txt_write("status=error");
packet_flush();
- }
- elsif ( $pathname eq "abort.r" ) {
+ } elsif ( $pathname eq "abort.r" ) {
print $debug "[ABORT]\n";
$debug->flush();
packet_txt_write("status=abort");
packet_flush();
- }
- elsif ( $command eq "smudge" and
+ } elsif ( $command eq "smudge" and
exists $DELAY{$pathname} and
- $DELAY{$pathname}{"requested"} == 1
- ) {
+ $DELAY{$pathname}{"requested"} == 1 ) {
print $debug "[DELAYED]\n";
$debug->flush();
packet_txt_write("status=delayed");
packet_flush();
$DELAY{$pathname}{"requested"} = 2;
$DELAY{$pathname}{"output"} = $output;
- }
- else {
+ } else {
packet_txt_write("status=success");
packet_flush();
print $debug ".";
if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
$output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
- }
- else {
+ } else {
$output = "";
}
}