Skip to content

Commit 0fe8d51

Browse files
chriscoolgitster
chriscool
authored and
gitster
committed
Git/Packet.pm: extract parts of t0021/rot13-filter.pl for reuse
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 <[email protected]> Signed-off-by: Junio C Hamano <[email protected]>
1 parent f11c8ce commit 0fe8d51

File tree

3 files changed

+172
-137
lines changed

3 files changed

+172
-137
lines changed

‎perl/Git/Packet.pm

Lines changed: 168 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,168 @@
1+
package Git::Packet;
2+
use 5.008;
3+
use strict;
4+
use warnings;
5+
BEGIN {
6+
require Exporter;
7+
if ($] < 5.008003) {
8+
*import = \&Exporter::import;
9+
} else {
10+
# Exporter 5.57 which supports this invocation was
11+
# released with perl 5.8.3
12+
Exporter->import('import');
13+
}
14+
}
15+
16+
our @EXPORT = qw(
17+
packet_compare_lists
18+
packet_bin_read
19+
packet_txt_read
20+
packet_required_key_val_read
21+
packet_bin_write
22+
packet_txt_write
23+
packet_flush
24+
packet_initialize
25+
packet_read_capabilities
26+
packet_read_and_check_capabilities
27+
packet_check_and_write_capabilities
28+
);
29+
our @EXPORT_OK = @EXPORT;
30+
31+
sub packet_compare_lists {
32+
my ($expect, @result) = @_;
33+
my $ix;
34+
if (scalar @$expect != scalar @result) {
35+
return undef;
36+
}
37+
for ($ix = 0; $ix < $#result; $ix++) {
38+
if ($expect->[$ix] ne $result[$ix]) {
39+
return undef;
40+
}
41+
}
42+
return 1;
43+
}
44+
45+
sub packet_bin_read {
46+
my $buffer;
47+
my $bytes_read = read STDIN, $buffer, 4;
48+
if ( $bytes_read == 0 ) {
49+
# EOF - Git stopped talking to us!
50+
return ( -1, "" );
51+
} elsif ( $bytes_read != 4 ) {
52+
die "invalid packet: '$buffer'";
53+
}
54+
my $pkt_size = hex($buffer);
55+
if ( $pkt_size == 0 ) {
56+
return ( 1, "" );
57+
} elsif ( $pkt_size > 4 ) {
58+
my $content_size = $pkt_size - 4;
59+
$bytes_read = read STDIN, $buffer, $content_size;
60+
if ( $bytes_read != $content_size ) {
61+
die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
62+
}
63+
return ( 0, $buffer );
64+
} else {
65+
die "invalid packet size: $pkt_size";
66+
}
67+
}
68+
69+
sub remove_final_lf_or_die {
70+
my $buf = shift;
71+
unless ( $buf =~ s/\n$// ) {
72+
die "A non-binary line MUST be terminated by an LF.\n"
73+
. "Received: '$buf'";
74+
}
75+
return $buf;
76+
}
77+
78+
sub packet_txt_read {
79+
my ( $res, $buf ) = packet_bin_read();
80+
unless ( $res == -1 or $buf eq '' ) {
81+
$buf = remove_final_lf_or_die($buf);
82+
}
83+
return ( $res, $buf );
84+
}
85+
86+
sub packet_required_key_val_read {
87+
my ( $key ) = @_;
88+
my ( $res, $buf ) = packet_txt_read();
89+
unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
90+
die "bad $key: '$buf'";
91+
}
92+
return ( $res, $buf );
93+
}
94+
95+
sub packet_bin_write {
96+
my $buf = shift;
97+
print STDOUT sprintf( "%04x", length($buf) + 4 );
98+
print STDOUT $buf;
99+
STDOUT->flush();
100+
}
101+
102+
sub packet_txt_write {
103+
packet_bin_write( $_[0] . "\n" );
104+
}
105+
106+
sub packet_flush {
107+
print STDOUT sprintf( "%04x", 0 );
108+
STDOUT->flush();
109+
}
110+
111+
sub packet_initialize {
112+
my ($name, $version) = @_;
113+
114+
packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
115+
die "bad initialize";
116+
packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
117+
die "bad version";
118+
packet_compare_lists([1, ""], packet_bin_read()) ||
119+
die "bad version end";
120+
121+
packet_txt_write( $name . "-server" );
122+
packet_txt_write( "version=" . $version );
123+
packet_flush();
124+
}
125+
126+
sub packet_read_capabilities {
127+
my @cap;
128+
while (1) {
129+
my ( $res, $buf ) = packet_bin_read();
130+
if ( $res == -1 ) {
131+
die "unexpected EOF when reading capabilities";
132+
}
133+
return ( $res, @cap ) if ( $res != 0 );
134+
$buf = remove_final_lf_or_die($buf);
135+
unless ( $buf =~ s/capability=// ) {
136+
die "bad capability buf: '$buf'";
137+
}
138+
push @cap, $buf;
139+
}
140+
}
141+
142+
# Read remote capabilities and check them against capabilities we require
143+
sub packet_read_and_check_capabilities {
144+
my @required_caps = @_;
145+
my ($res, @remote_caps) = packet_read_capabilities();
146+
my %remote_caps = map { $_ => 1 } @remote_caps;
147+
foreach (@required_caps) {
148+
unless (exists($remote_caps{$_})) {
149+
die "required '$_' capability not available from remote" ;
150+
}
151+
}
152+
return %remote_caps;
153+
}
154+
155+
# Check our capabilities we want to advertise against the remote ones
156+
# and then advertise our capabilities
157+
sub packet_check_and_write_capabilities {
158+
my ($remote_caps, @our_caps) = @_;
159+
foreach (@our_caps) {
160+
unless (exists($remote_caps->{$_})) {
161+
die "our capability '$_' is not available from remote"
162+
}
163+
packet_txt_write( "capability=" . $_ );
164+
}
165+
packet_flush();
166+
}
167+
168+
1;

‎perl/Makefile

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ instdir_SQ = $(subst ','\'',$(prefix)/lib)
3030
modules += Git
3131
modules += Git/I18N
3232
modules += Git/IndexInfo
33+
modules += Git/Packet
3334
modules += Git/SVN
3435
modules += Git/SVN/Memoize/YAML
3536
modules += Git/SVN/Fetcher

‎t/t0021/rot13-filter.pl

Lines changed: 3 additions & 137 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,12 @@
3030
# to the "list_available_blobs" response.
3131
#
3232

33+
use 5.008;
34+
use lib (split(/:/, $ENV{GITPERLLIB}));
3335
use strict;
3436
use warnings;
3537
use IO::File;
38+
use Git::Packet;
3639

3740
my $MAX_PACKET_CONTENT_SIZE = 65516;
3841
my $log_file = shift @ARGV;
@@ -55,143 +58,6 @@ sub rot13 {
5558
return $str;
5659
}
5760

58-
sub packet_compare_lists {
59-
my ($expect, @result) = @_;
60-
my $ix;
61-
if (scalar @$expect != scalar @result) {
62-
return undef;
63-
}
64-
for ($ix = 0; $ix < $#result; $ix++) {
65-
if ($expect->[$ix] ne $result[$ix]) {
66-
return undef;
67-
}
68-
}
69-
return 1;
70-
}
71-
72-
sub packet_bin_read {
73-
my $buffer;
74-
my $bytes_read = read STDIN, $buffer, 4;
75-
if ( $bytes_read == 0 ) {
76-
# EOF - Git stopped talking to us!
77-
return ( -1, "" );
78-
} elsif ( $bytes_read != 4 ) {
79-
die "invalid packet: '$buffer'";
80-
}
81-
my $pkt_size = hex($buffer);
82-
if ( $pkt_size == 0 ) {
83-
return ( 1, "" );
84-
} elsif ( $pkt_size > 4 ) {
85-
my $content_size = $pkt_size - 4;
86-
$bytes_read = read STDIN, $buffer, $content_size;
87-
if ( $bytes_read != $content_size ) {
88-
die "invalid packet ($content_size bytes expected; $bytes_read bytes read)";
89-
}
90-
return ( 0, $buffer );
91-
} else {
92-
die "invalid packet size: $pkt_size";
93-
}
94-
}
95-
96-
sub remove_final_lf_or_die {
97-
my $buf = shift;
98-
unless ( $buf =~ s/\n$// ) {
99-
die "A non-binary line MUST be terminated by an LF.\n"
100-
. "Received: '$buf'";
101-
}
102-
return $buf;
103-
}
104-
105-
sub packet_txt_read {
106-
my ( $res, $buf ) = packet_bin_read();
107-
unless ( $res == -1 or $buf eq '' ) {
108-
$buf = remove_final_lf_or_die($buf);
109-
}
110-
return ( $res, $buf );
111-
}
112-
113-
sub packet_required_key_val_read {
114-
my ( $key ) = @_;
115-
my ( $res, $buf ) = packet_txt_read();
116-
unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) {
117-
die "bad $key: '$buf'";
118-
}
119-
return ( $res, $buf );
120-
}
121-
122-
sub packet_bin_write {
123-
my $buf = shift;
124-
print STDOUT sprintf( "%04x", length($buf) + 4 );
125-
print STDOUT $buf;
126-
STDOUT->flush();
127-
}
128-
129-
sub packet_txt_write {
130-
packet_bin_write( $_[0] . "\n" );
131-
}
132-
133-
sub packet_flush {
134-
print STDOUT sprintf( "%04x", 0 );
135-
STDOUT->flush();
136-
}
137-
138-
sub packet_initialize {
139-
my ($name, $version) = @_;
140-
141-
packet_compare_lists([0, $name . "-client"], packet_txt_read()) ||
142-
die "bad initialize";
143-
packet_compare_lists([0, "version=" . $version], packet_txt_read()) ||
144-
die "bad version";
145-
packet_compare_lists([1, ""], packet_bin_read()) ||
146-
die "bad version end";
147-
148-
packet_txt_write( $name . "-server" );
149-
packet_txt_write( "version=" . $version );
150-
packet_flush();
151-
}
152-
153-
sub packet_read_capabilities {
154-
my @cap;
155-
while (1) {
156-
my ( $res, $buf ) = packet_bin_read();
157-
if ( $res == -1 ) {
158-
die "unexpected EOF when reading capabilities";
159-
}
160-
return ( $res, @cap ) if ( $res != 0 );
161-
$buf = remove_final_lf_or_die($buf);
162-
unless ( $buf =~ s/capability=// ) {
163-
die "bad capability buf: '$buf'";
164-
}
165-
push @cap, $buf;
166-
}
167-
}
168-
169-
# Read remote capabilities and check them against capabilities we require
170-
sub packet_read_and_check_capabilities {
171-
my @required_caps = @_;
172-
my ($res, @remote_caps) = packet_read_capabilities();
173-
my %remote_caps = map { $_ => 1 } @remote_caps;
174-
foreach (@required_caps) {
175-
unless (exists($remote_caps{$_})) {
176-
die "required '$_' capability not available from remote" ;
177-
}
178-
}
179-
return %remote_caps;
180-
}
181-
182-
# Check our capabilities we want to advertise against the remote ones
183-
# and then advertise our capabilities
184-
sub packet_check_and_write_capabilities {
185-
my ($remote_caps, @our_caps) = @_;
186-
foreach (@our_caps) {
187-
unless (exists($remote_caps->{$_})) {
188-
die "our capability '$_' is not available from remote"
189-
}
190-
packet_txt_write( "capability=" . $_ );
191-
}
192-
packet_flush();
193-
}
194-
19561
print $debug "START\n";
19662
$debug->flush();
19763

0 commit comments

Comments
 (0)