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 <chriscool@tuxfamily.org> Signed-off-by: Junio C Hamano <gitster@pobox.com>
Christian Couder committed
Nov 5, 2017 at 22:38 UTC
0fe8d516bb70c675fc9cea9339247b01f7e96cad
3 files changed
+172
-137
perl/Git/Packet.pm
new
+168
@@ -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
+1
@@ -30,6 +30,7 @@ instdir_SQ = $(subst ','\'',$(prefix)/lib)
30
modules += Git
31
modules += Git/I18N
32
modules += Git/IndexInfo
33
+modules += Git/Packet
34
modules += Git/SVN
35
modules += Git/SVN/Memoize/YAML
36
modules += Git/SVN/Fetcher
t/t0021/rot13-filter.pl
+3
-137
@@ -30,9 +30,12 @@
30
# to the "list_available_blobs" response.
31
#
32
33
+use 5.008;
34
+use lib (split(/:/, $ENV{GITPERLLIB}));
35
use strict;
36
use warnings;
37
use IO::File;
38
+use Git::Packet;
39
40
my $MAX_PACKET_CONTENT_SIZE = 65516;
41
my $log_file = shift @ARGV;
@@ -55,143 +58,6 @@ sub rot13 {
58
return $str;
59
}
60
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
-
61
print $debug "START\n";
62
$debug->flush();
63