[PATCH v2 0/8] Create Git/Packet.pm

[PATCH v2 0/8] Create Git/Packet.pm

[Christian Couder]

Goal
~~~~

Packet related functions in Perl can be useful to write new filters or
to debug or test existing filters. They might also in the future be
used by other software using the same packet line protocol. So instead
of having them in t0021/rot13-filter.pl, let's extract them into a new
Git/Packet.pm module.

Changes since the previous version
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  - Patch 1/8 is new. It fixes a list comparison bug that existed
    since the beginning of t0021/rot13-filter.pl.

  - Patch 2/8 is much improved. It now checks for unexpected EOF in
    all the code paths and introduces a new
    packet_required_key_val_read() function.

  - Patchs 3/8, 4/8 and 5/8 have not changed since v1.

  - Patch 6/8 is new. It adds a small helper function.

  - Patch 7/8 is much improved. It now describe better all the changes
    and better check that the capabilities we advertise are supported
    by the remote.

  - Patch 8/8 has been improved. It contains the Makefile change
    suggested by Dscho.

Links
~~~~~

This patch series is on the following branch:

https://github.com/chriscool/git/commits/gl-prep-external-odb

Version 1 of this patch series is on the mailing list here:

https://public-inbox.org/git/20171019123030.17338-1-chriscool@tuxfamily.org/

It is also available in the following branch:

https://github.com/chriscool/git/commits/gl-prep-external-odb1

This patch series was extracted from previous "Add initial
experimental external ODB support" patch series.

Version 1, 2, 3, 4, 5 and 6 of this previous series are on the mailing
list here:

https://public-inbox.org/git/20160613085546.11784-1-chriscool@tuxfamily.org/
https://public-inbox.org/git/20160628181933.24620-1-chriscool@tuxfamily.org/
https://public-inbox.org/git/20161130210420.15982-1-chriscool@tuxfamily.org/
https://public-inbox.org/git/20170620075523.26961-1-chriscool@tuxfamily.org/
https://public-inbox.org/git/20170803091926.1755-1-chriscool@tuxfamily.org/
https://public-inbox.org/git/20170916080731.13925-1-chriscool@tuxfamily.org/

They are also available in the following branches:

https://github.com/chriscool/git/commits/gl-external-odb12
https://github.com/chriscool/git/commits/gl-external-odb22
https://github.com/chriscool/git/commits/gl-external-odb61
https://github.com/chriscool/git/commits/gl-external-odb239
https://github.com/chriscool/git/commits/gl-external-odb373
https://github.com/chriscool/git/commits/gl-external-odb411


Christian Couder (8):
  t0021/rot13-filter: fix list comparison
  t0021/rot13-filter: refactor packet reading functions
  t0021/rot13-filter: improve 'if .. elsif .. else' style
  t0021/rot13-filter: improve error message
  t0021/rot13-filter: add packet_initialize()
  t0021/rot13-filter: refactor checking final lf
  t0021/rot13-filter: add capability functions
  Add Git/Packet.pm from parts of t0021/rot13-filter.pl

 perl/Git/Packet.pm      | 168 ++++++++++++++++++++++++++++++++++++++++++++++++
 perl/Makefile           |   1 +
 t/t0021/rot13-filter.pl | 127 ++++++++++--------------------------
 3 files changed, 202 insertions(+), 94 deletions(-)
 create mode 100644 perl/Git/Packet.pm

-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 1/8] t0021/rot13-filter: fix list comparison

[Christian Couder]

Since edcc8581 ("convert: add filter.<driver>.process
option", 2016-10-16) when t0021/rot13-filter.pl was created, list
comparison in this perl script have been quite broken.

packet_txt_read() returns a 2-element list, and the right hand
side of "eq" also has a list with (two, elements), but "eq" takes
the last element of the list on each side, and compares them. The
first elements (0 or 1) on the right hand side lists do not matter,
which means we do not require to see a flush at the end of the
version -- a simple empty string or an EOF would do, which is
definitely not what we want.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 35 ++++++++++++++++++++++++++++-------
 1 file changed, 28 insertions(+), 7 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index ad685d92f8..4b2d9087d4 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -55,6 +55,20 @@ sub rot13 {
 	return $str;
 }
 
+sub packet_compare_lists {
+	my ($expect, @result) = @_;
+	my $ix;
+	if (scalar @$expect != scalar @result) {
+		return undef;
+	}
+	for ($ix = 0; $ix < $#result; $ix++) {
+		if ($expect->[$ix] ne $result[$ix]) {
+			return undef;
+		}
+	}
+	return 1;
+}
+
 sub packet_bin_read {
 	my $buffer;
 	my $bytes_read = read STDIN, $buffer, 4;
@@ -110,18 +124,25 @@ sub packet_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_compare_lists([0, "git-filter-client"], packet_txt_read()) ||
+	die "bad initialize";
+packet_compare_lists([0, "version=2"], packet_txt_read()) ||
+	die "bad version";
+packet_compare_lists([1, ""], packet_bin_read()) ||
+	die "bad version end";
 
 packet_txt_write("git-filter-server");
 packet_txt_write("version=2");
 packet_flush();
 
-( 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";
+packet_compare_lists([0, "capability=clean"], packet_txt_read()) ||
+	die "bad capability";
+packet_compare_lists([0, "capability=smudge"], packet_txt_read()) ||
+	die "bad capability";
+packet_compare_lists([0, "capability=delay"], packet_txt_read()) ||
+	die "bad capability";
+packet_compare_lists([1, ""], packet_bin_read()) ||
+	die "bad capability end";
 
 foreach (@capabilities) {
 	packet_txt_write( "capability=" . $_ );
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 2/8] t0021/rot13-filter: refactor packet reading functions

[Christian Couder]

To make it possible in a following commit to move packet
reading and writing functions into a Packet.pm module,
let's refactor these functions, so they don't handle
printing debug output and exiting.

While at it let's create packet_required_key_val_read()
to still handle erroring out in a common case.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 38 ++++++++++++++++++++++++++++----------
 1 file changed, 28 insertions(+), 10 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index 4b2d9087d4..c025518c0a 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -74,8 +74,7 @@ sub packet_bin_read {
 	my $bytes_read = read STDIN, $buffer, 4;
 	if ( $bytes_read == 0 ) {
 		# EOF - Git stopped talking to us!
-		print $debug "STOP\n";
-		exit();
+		return ( -1, "" );
 	}
 	elsif ( $bytes_read != 4 ) {
 		die "invalid packet: '$buffer'";
@@ -99,12 +98,21 @@ sub packet_bin_read {
 
 sub packet_txt_read {
 	my ( $res, $buf ) = packet_bin_read();
-	unless ( $buf eq '' or $buf =~ s/\n$// ) {
+	unless ( $res == -1 or $buf eq '' or $buf =~ s/\n$// ) {
 		die "A non-binary line MUST be terminated by an LF.";
 	}
 	return ( $res, $buf );
 }
 
+sub packet_required_key_val_read {
+	my ( $key ) = @_;
+	my ( $res, $buf ) = packet_txt_read();
+	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
+		die "bad $key: '$buf'";
+	}
+	return ( $res, $buf );
+}
+
 sub packet_bin_write {
 	my $buf = shift;
 	print STDOUT sprintf( "%04x", length($buf) + 4 );
@@ -152,13 +160,18 @@ print $debug "init handshake complete\n";
 $debug->flush();
 
 while (1) {
-	my ( $command ) = packet_txt_read() =~ /^command=(.+)$/;
+	my ( $res, $command ) = packet_required_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 ) {
@@ -184,14 +197,13 @@ while (1) {
 		packet_flush();
 	}
 	else {
-		my ( $pathname ) = packet_txt_read() =~ /^pathname=(.+)$/;
+		my ( $res, $pathname ) = packet_required_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 '' ) {
@@ -205,6 +217,9 @@ while (1) {
 
 			( $done, $buffer ) = packet_txt_read();
 		}
+		if ( $done == -1 ) {
+			die "unexpected EOF after pathname '$pathname'";
+		}
 
 		my $input = "";
 		{
@@ -215,6 +230,9 @@ while (1) {
 				( $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();
 		}
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 3/8] t0021/rot13-filter: improve 'if .. elsif .. else' style

[Christian Couder]

Before further refactoring the "t0021/rot13-filter.pl" script,
let's modernize the style of its 'if .. elsif .. else' clauses
to improve its readability by making it more similar to our
other perl scripts.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 39 +++++++++++++--------------------------
 1 file changed, 13 insertions(+), 26 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index c025518c0a..37cecd8654 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -75,23 +75,20 @@ sub packet_bin_read {
 	if ( $bytes_read == 0 ) {
 		# EOF - Git stopped talking to us!
 		return ( -1, "" );
-	}
-	elsif ( $bytes_read != 4 ) {
+	} elsif ( $bytes_read != 4 ) {
 		die "invalid packet: '$buffer'";
 	}
 	my $pkt_size = hex($buffer);
 	if ( $pkt_size == 0 ) {
 		return ( 1, "" );
-	}
-	elsif ( $pkt_size > 4 ) {
+	} 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 {
+	} else {
 		die "invalid packet size: $pkt_size";
 	}
 }
@@ -195,8 +192,7 @@ while (1) {
 		$debug->flush();
 		packet_txt_write("status=success");
 		packet_flush();
-	}
-	else {
+	} else {
 		my ( $res, $pathname ) = packet_required_key_val_read("pathname");
 		if ( $res == -1 ) {
 			die "unexpected EOF while expecting pathname";
@@ -240,17 +236,13 @@ while (1) {
 		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'";
 		}
 
@@ -259,25 +251,21 @@ while (1) {
 			$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();
 
@@ -297,8 +285,7 @@ while (1) {
 				print $debug ".";
 				if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
 					$output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
-				}
-				else {
+				} else {
 					$output = "";
 				}
 			}
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 4/8] t0021/rot13-filter: improve error message

[Christian Couder]

If there is no new line at the end of something it receives,
the packet_txt_read() function die()s, but it's difficult to
debug without much context.

Let's give a bit more information when that happens.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index 37cecd8654..f31ff595fe 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -96,7 +96,8 @@ sub packet_bin_read {
 sub packet_txt_read {
 	my ( $res, $buf ) = packet_bin_read();
 	unless ( $res == -1 or $buf eq '' or $buf =~ s/\n$// ) {
-		die "A non-binary line MUST be terminated by an LF.";
+		die "A non-binary line MUST be terminated by an LF.\n"
+		    . "Received: '$buf'";
 	}
 	return ( $res, $buf );
 }
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 5/8] t0021/rot13-filter: add packet_initialize()

[Christian Couder]

Let's refactor the code to initialize communication into its own
packet_initialize() function, so that we can reuse this
functionality in following patches.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index f31ff595fe..2f74ab2e45 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -127,19 +127,25 @@ sub packet_flush {
 	STDOUT->flush();
 }
 
+sub packet_initialize {
+	my ($name, $version) = @_;
+
+	packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
+		die "bad initialize";
+	packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
+		die "bad version";
+	packet_compare_lists([1, ""], packet_bin_read()) ||
+		die "bad version end";
+
+	packet_txt_write( $name . "-server" );
+	packet_txt_write( "version=" . $version );
+	packet_flush();
+}
+
 print $debug "START\n";
 $debug->flush();
 
-packet_compare_lists([0, "git-filter-client"], packet_txt_read()) ||
-	die "bad initialize";
-packet_compare_lists([0, "version=2"], packet_txt_read()) ||
-	die "bad version";
-packet_compare_lists([1, ""], packet_bin_read()) ||
-	die "bad version end";
-
-packet_txt_write("git-filter-server");
-packet_txt_write("version=2");
-packet_flush();
+packet_initialize("git-filter", 2);
 
 packet_compare_lists([0, "capability=clean"], packet_txt_read()) ||
 	die "bad capability";
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 6/8] t0021/rot13-filter: refactor checking final lf

[Christian Couder]

As checking for a lf character at the end of a buffer
will be useful in another function, let's refactor this
functionality into a small remove_final_lf_or_die()
helper function.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index 2f74ab2e45..d47b7f5666 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -93,12 +93,20 @@ sub packet_bin_read {
 	}
 }
 
-sub packet_txt_read {
-	my ( $res, $buf ) = packet_bin_read();
-	unless ( $res == -1 or $buf eq '' or $buf =~ s/\n$// ) {
+sub remove_final_lf_or_die {
+	my $buf = shift;
+	unless ( $buf =~ s/\n$// ) {
 		die "A non-binary line MUST be terminated by an LF.\n"
 		    . "Received: '$buf'";
 	}
+	return $buf;
+}
+
+sub packet_txt_read {
+	my ( $res, $buf ) = packet_bin_read();
+	unless ( $res == -1 or $buf eq '' ) {
+		$buf = remove_final_lf_or_die($buf);
+	}
 	return ( $res, $buf );
 }
 
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 7/8] t0021/rot13-filter: add capability functions

[Christian Couder]

These function help read and write capabilities.

To make them more generic and make it easy to reuse them,
the following changes are made:

- we don't require capabilities to come in a fixed order,
- we allow duplicates,
- we check that the remote supports the capabilities we
  advertise,
- we don't check if the remote declares any capability we
  don't know about.

The reason behind the last change is that the protocol
should work using only the capabilities that both ends
support, and it should not stop working if one end starts
to advertise a new capability.

Despite those changes, we can still require a set of
capabilities, and die if one of them is not supported.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 t/t0021/rot13-filter.pl | 58 ++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 45 insertions(+), 13 deletions(-)

diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index d47b7f5666..f919d798a6 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -150,24 +150,56 @@ sub packet_initialize {
 	packet_flush();
 }
 
+sub packet_read_capabilities {
+	my @cap;
+	while (1) {
+		my ( $res, $buf ) = packet_bin_read();
+		if ( $res == -1 ) {
+			die "unexpected EOF when reading capabilities";
+		}
+		return ( $res, @cap ) if ( $res != 0 );
+		$buf = remove_final_lf_or_die($buf);
+		unless ( $buf =~ s/capability=// ) {
+			die "bad capability buf: '$buf'";
+		}
+		push @cap, $buf;
+	}
+}
+
+# Read remote capabilities and check them against capabilities we require
+sub packet_read_and_check_capabilities {
+	my @required_caps = @_;
+	my ($res, @remote_caps) = packet_read_capabilities();
+	my %remote_caps = map { $_ => 1 } @remote_caps;
+	foreach (@required_caps) {
+		unless (exists($remote_caps{$_})) {
+			die "required '$_' capability not available from remote" ;
+		}
+	}
+	return %remote_caps;
+}
+
+# Check our capabilities we want to advertise against the remote ones
+# and then advertise our capabilities
+sub packet_check_and_write_capabilities {
+	my ($remote_caps, @our_caps) = @_;
+	foreach (@our_caps) {
+		unless (exists($remote_caps->{$_})) {
+			die "our capability '$_' is not available from remote"
+		}
+		packet_txt_write( "capability=" . $_ );
+	}
+	packet_flush();
+}
+
 print $debug "START\n";
 $debug->flush();
 
 packet_initialize("git-filter", 2);
 
-packet_compare_lists([0, "capability=clean"], packet_txt_read()) ||
-	die "bad capability";
-packet_compare_lists([0, "capability=smudge"], packet_txt_read()) ||
-	die "bad capability";
-packet_compare_lists([0, "capability=delay"], packet_txt_read()) ||
-	die "bad capability";
-packet_compare_lists([1, ""], packet_bin_read()) ||
-	die "bad capability end";
-
-foreach (@capabilities) {
-	packet_txt_write( "capability=" . $_ );
-}
-packet_flush();
+my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
+packet_check_and_write_capabilities(\%remote_caps, @capabilities);
+
 print $debug "init handshake complete\n";
 $debug->flush();
 
-- 
2.15.0.7.ga9ff306ed9.dirty

[PATCH v2 8/8] Add Git/Packet.pm from parts of t0021/rot13-filter.pl

[Christian Couder]

And while at it let's simplify t0021/rot13-filter.pl by
using Git/Packet.pm.

This will make it possible to reuse packet related
functions in other test scripts.

Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
---
 perl/Git/Packet.pm      | 168 ++++++++++++++++++++++++++++++++++++++++++++++++
 perl/Makefile           |   1 +
 t/t0021/rot13-filter.pl | 140 +---------------------------------------
 3 files changed, 172 insertions(+), 137 deletions(-)
 create mode 100644 perl/Git/Packet.pm

diff --git a/perl/Git/Packet.pm b/perl/Git/Packet.pm
new file mode 100644
index 0000000000..255b28c098
--- /dev/null
+++ b/perl/Git/Packet.pm
@@ -0,0 +1,168 @@
+package Git::Packet;
+use 5.008;
+use strict;
+use warnings;
+BEGIN {
+	require Exporter;
+	if ($] < 5.008003) {
+		*import = \&Exporter::import;
+	} else {
+		# Exporter 5.57 which supports this invocation was
+		# released with perl 5.8.3
+		Exporter->import('import');
+	}
+}
+
+our @EXPORT = qw(
+			packet_compare_lists
+			packet_bin_read
+			packet_txt_read
+			packet_required_key_val_read
+			packet_bin_write
+			packet_txt_write
+			packet_flush
+			packet_initialize
+			packet_read_capabilities
+			packet_read_and_check_capabilities
+			packet_check_and_write_capabilities
+		);
+our @EXPORT_OK = @EXPORT;
+
+sub packet_compare_lists {
+	my ($expect, @result) = @_;
+	my $ix;
+	if (scalar @$expect != scalar @result) {
+		return undef;
+	}
+	for ($ix = 0; $ix < $#result; $ix++) {
+		if ($expect->[$ix] ne $result[$ix]) {
+			return undef;
+		}
+	}
+	return 1;
+}
+
+sub packet_bin_read {
+	my $buffer;
+	my $bytes_read = read STDIN, $buffer, 4;
+	if ( $bytes_read == 0 ) {
+		# EOF - Git stopped talking to us!
+		return ( -1, "" );
+	} 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 remove_final_lf_or_die {
+	my $buf = shift;
+	unless ( $buf =~ s/\n$// ) {
+		die "A non-binary line MUST be terminated by an LF.\n"
+		    . "Received: '$buf'";
+	}
+	return $buf;
+}
+
+sub packet_txt_read {
+	my ( $res, $buf ) = packet_bin_read();
+	unless ( $res == -1 or $buf eq '' ) {
+		$buf = remove_final_lf_or_die($buf);
+	}
+	return ( $res, $buf );
+}
+
+sub packet_required_key_val_read {
+	my ( $key ) = @_;
+	my ( $res, $buf ) = packet_txt_read();
+	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
+		die "bad $key: '$buf'";
+	}
+	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();
+}
+
+sub packet_initialize {
+	my ($name, $version) = @_;
+
+	packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
+		die "bad initialize";
+	packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
+		die "bad version";
+	packet_compare_lists([1, ""], packet_bin_read()) ||
+		die "bad version end";
+
+	packet_txt_write( $name . "-server" );
+	packet_txt_write( "version=" . $version );
+	packet_flush();
+}
+
+sub packet_read_capabilities {
+	my @cap;
+	while (1) {
+		my ( $res, $buf ) = packet_bin_read();
+		if ( $res == -1 ) {
+			die "unexpected EOF when reading capabilities";
+		}
+		return ( $res, @cap ) if ( $res != 0 );
+		$buf = remove_final_lf_or_die($buf);
+		unless ( $buf =~ s/capability=// ) {
+			die "bad capability buf: '$buf'";
+		}
+		push @cap, $buf;
+	}
+}
+
+# Read remote capabilities and check them against capabilities we require
+sub packet_read_and_check_capabilities {
+	my @required_caps = @_;
+	my ($res, @remote_caps) = packet_read_capabilities();
+	my %remote_caps = map { $_ => 1 } @remote_caps;
+	foreach (@required_caps) {
+		unless (exists($remote_caps{$_})) {
+			die "required '$_' capability not available from remote" ;
+		}
+	}
+	return %remote_caps;
+}
+
+# Check our capabilities we want to advertise against the remote ones
+# and then advertise our capabilities
+sub packet_check_and_write_capabilities {
+	my ($remote_caps, @our_caps) = @_;
+	foreach (@our_caps) {
+		unless (exists($remote_caps->{$_})) {
+			die "our capability '$_' is not available from remote"
+		}
+		packet_txt_write( "capability=" . $_ );
+	}
+	packet_flush();
+}
+
+1;
diff --git a/perl/Makefile b/perl/Makefile
index 15d96fcc7a..f657de20e3 100644
--- a/perl/Makefile
+++ b/perl/Makefile
@@ -30,6 +30,7 @@ instdir_SQ = $(subst ','\'',$(prefix)/lib)
 modules += Git
 modules += Git/I18N
 modules += Git/IndexInfo
+modules += Git/Packet
 modules += Git/SVN
 modules += Git/SVN/Memoize/YAML
 modules += Git/SVN/Fetcher
diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
index f919d798a6..6fd7fa476b 100644
--- a/t/t0021/rot13-filter.pl
+++ b/t/t0021/rot13-filter.pl
@@ -30,9 +30,12 @@
 #     to the "list_available_blobs" response.
 #
 
+use 5.008;
+use lib (split(/:/, $ENV{GITPERLLIB}));
 use strict;
 use warnings;
 use IO::File;
+use Git::Packet;
 
 my $MAX_PACKET_CONTENT_SIZE = 65516;
 my $log_file                = shift @ARGV;
@@ -55,143 +58,6 @@ sub rot13 {
 	return $str;
 }
 
-sub packet_compare_lists {
-	my ($expect, @result) = @_;
-	my $ix;
-	if (scalar @$expect != scalar @result) {
-		return undef;
-	}
-	for ($ix = 0; $ix < $#result; $ix++) {
-		if ($expect->[$ix] ne $result[$ix]) {
-			return undef;
-		}
-	}
-	return 1;
-}
-
-sub packet_bin_read {
-	my $buffer;
-	my $bytes_read = read STDIN, $buffer, 4;
-	if ( $bytes_read == 0 ) {
-		# EOF - Git stopped talking to us!
-		return ( -1, "" );
-	} 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 remove_final_lf_or_die {
-	my $buf = shift;
-	unless ( $buf =~ s/\n$// ) {
-		die "A non-binary line MUST be terminated by an LF.\n"
-		    . "Received: '$buf'";
-	}
-	return $buf;
-}
-
-sub packet_txt_read {
-	my ( $res, $buf ) = packet_bin_read();
-	unless ( $res == -1 or $buf eq '' ) {
-		$buf = remove_final_lf_or_die($buf);
-	}
-	return ( $res, $buf );
-}
-
-sub packet_required_key_val_read {
-	my ( $key ) = @_;
-	my ( $res, $buf ) = packet_txt_read();
-	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
-		die "bad $key: '$buf'";
-	}
-	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();
-}
-
-sub packet_initialize {
-	my ($name, $version) = @_;
-
-	packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
-		die "bad initialize";
-	packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
-		die "bad version";
-	packet_compare_lists([1, ""], packet_bin_read()) ||
-		die "bad version end";
-
-	packet_txt_write( $name . "-server" );
-	packet_txt_write( "version=" . $version );
-	packet_flush();
-}
-
-sub packet_read_capabilities {
-	my @cap;
-	while (1) {
-		my ( $res, $buf ) = packet_bin_read();
-		if ( $res == -1 ) {
-			die "unexpected EOF when reading capabilities";
-		}
-		return ( $res, @cap ) if ( $res != 0 );
-		$buf = remove_final_lf_or_die($buf);
-		unless ( $buf =~ s/capability=// ) {
-			die "bad capability buf: '$buf'";
-		}
-		push @cap, $buf;
-	}
-}
-
-# Read remote capabilities and check them against capabilities we require
-sub packet_read_and_check_capabilities {
-	my @required_caps = @_;
-	my ($res, @remote_caps) = packet_read_capabilities();
-	my %remote_caps = map { $_ => 1 } @remote_caps;
-	foreach (@required_caps) {
-		unless (exists($remote_caps{$_})) {
-			die "required '$_' capability not available from remote" ;
-		}
-	}
-	return %remote_caps;
-}
-
-# Check our capabilities we want to advertise against the remote ones
-# and then advertise our capabilities
-sub packet_check_and_write_capabilities {
-	my ($remote_caps, @our_caps) = @_;
-	foreach (@our_caps) {
-		unless (exists($remote_caps->{$_})) {
-			die "our capability '$_' is not available from remote"
-		}
-		packet_txt_write( "capability=" . $_ );
-	}
-	packet_flush();
-}
-
 print $debug "START\n";
 $debug->flush();
 
-- 
2.15.0.7.ga9ff306ed9.dirty

Re: [PATCH v2 1/8] t0021/rot13-filter: fix list comparison

[Junio C Hamano]

Christian Couder <christian.couder@gmail.com> writes:

> +sub packet_compare_lists {
> +	my ($expect, @result) = @_;
> +	my $ix;
> +	if (scalar @$expect != scalar @result) {
> +		return undef;
> +	}
> +	for ($ix = 0; $ix < $#result; $ix++) {
> +		if ($expect->[$ix] ne $result[$ix]) {
> +			return undef;
> +		}
> +	}
> +	return 1;
> +}
> +
>  sub packet_bin_read {
>  	my $buffer;
>  	my $bytes_read = read STDIN, $buffer, 4;
> @@ -110,18 +124,25 @@ sub packet_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_compare_lists([0, "git-filter-client"], packet_txt_read()) ||
> +	die "bad initialize";

For now this should do, but the "packet_compare_lists" may later
want to become more specific to the needs of these callers.  It
tries to be a generic comparison function for list of strings, but
what these callers feed is always two-element tuple, whose first
element is an integer (not just a random thing that can be made into
a string to be compared with "ne") and whose second element is a
string.

Re: [PATCH v2 2/8] t0021/rot13-filter: refactor packet reading functions

[Junio C Hamano]

Christian Couder <christian.couder@gmail.com> writes:

> +sub packet_required_key_val_read {
> +	my ( $key ) = @_;
> +	my ( $res, $buf ) = packet_txt_read();
> +	unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
> +		die "bad $key: '$buf'";
> +	}
> +	return ( $res, $buf );
> +}

The function calls itself "required", but it does not die when it
sees an unexpected EOF or an empty line.  Neither of these cases
gives it a key (nor val), but it is not treated as an error.

That is curious, isn't it?

By the way, is it just me who finds this "unless" even less
unerstandable than the original in packet_txt_read() you modeled
this one after?  The original depended on packet_bin_read() to die
on an unexpected EOF, so its "unless" made some sense (we know we
got some input, and it is an error for the input not to end with LF
unless it is an empty string).  Negating the condition and making it
"if" may make it easier to understand, perhaps.  I dunno.

Re: [PATCH v2 6/8] t0021/rot13-filter: refactor checking final lf

[Junio C Hamano]

Christian Couder <christian.couder@gmail.com> writes:

> As checking for a lf character at the end of a buffer
> will be useful in another function, let's refactor this
> functionality into a small remove_final_lf_or_die()
> helper function.
>
> Signed-off-by: Christian Couder <chriscool@tuxfamily.org>
> ---
>  t/t0021/rot13-filter.pl | 14 +++++++++++---
>  1 file changed, 11 insertions(+), 3 deletions(-)
>
> diff --git a/t/t0021/rot13-filter.pl b/t/t0021/rot13-filter.pl
> index 2f74ab2e45..d47b7f5666 100644
> --- a/t/t0021/rot13-filter.pl
> +++ b/t/t0021/rot13-filter.pl
> @@ -93,12 +93,20 @@ sub packet_bin_read {
>  	}
>  }
>  
> -sub packet_txt_read {
> -	my ( $res, $buf ) = packet_bin_read();
> -	unless ( $res == -1 or $buf eq '' or $buf =~ s/\n$// ) {
> +sub remove_final_lf_or_die {
> +	my $buf = shift;
> +	unless ( $buf =~ s/\n$// ) {
>  		die "A non-binary line MUST be terminated by an LF.\n"
>  		    . "Received: '$buf'";
>  	}
> +	return $buf;
> +}
> +
> +sub packet_txt_read {
> +	my ( $res, $buf ) = packet_bin_read();
> +	unless ( $res == -1 or $buf eq '' ) {
> +		$buf = remove_final_lf_or_die($buf);
> +	}

After patch 2/8 I found the "unless" in packet_txt_read impossible
to read, but this makes it a bit more understandable.

Re: [PATCH v2 7/8] t0021/rot13-filter: add capability functions

[Junio C Hamano]

Christian Couder <christian.couder@gmail.com> writes:

>  t/t0021/rot13-filter.pl | 58 ++++++++++++++++++++++++++++++++++++++-----------
>  1 file changed, 45 insertions(+), 13 deletions(-)

Makes sense.

Re: [PATCH v2 2/8] t0021/rot13-filter: refactor packet reading functions

[Christian Couder]

On Tue, Nov 7, 2017 at 2:15 AM, Junio C Hamano <gitster@pobox.com> wrote:
> Christian Couder <christian.couder@gmail.com> writes:
>
>> +sub packet_required_key_val_read {
>> +     my ( $key ) = @_;
>> +     my ( $res, $buf ) = packet_txt_read();
>> +     unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
>> +             die "bad $key: '$buf'";
>> +     }
>> +     return ( $res, $buf );
>> +}
>
> The function calls itself "required", but it does not die when it
> sees an unexpected EOF or an empty line.

If $res is not -1, it will die if $buf is empty.

> Neither of these cases
> gives it a key (nor val), but it is not treated as an error.
>
> That is curious, isn't it?

Yeah it is a bit strange for the unexpected EOF case.
I think I will remove "required" from the name and add a comment
before the function.

> By the way, is it just me who finds this "unless" even less
> unerstandable than the original in packet_txt_read() you modeled
> this one after?  The original depended on packet_bin_read() to die
> on an unexpected EOF, so its "unless" made some sense (we know we
> got some input, and it is an error for the input not to end with LF
> unless it is an empty string).  Negating the condition and making it
> "if" may make it easier to understand, perhaps.  I dunno.

I can remove the "unless" and make it easier to understand like this:

  if ( $res == -1 ) {
          return ( $res, $buf );
  }
  if ( $buf =~ s/^$key=// and $buf ne '' ) ) {
          return ( $res, $buf );
  }
  die "bad $key: '$buf'";

Or to keep it short just:

  if ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
          return ( $res, $buf );
  }
  die "bad $key: '$buf'";