]>
Commit | Line | Data |
---|---|---|
1 | # | |
2 | # Example implementation for the Git filter protocol version 2 | |
3 | # See Documentation/gitattributes.txt, section "Filter Protocol" | |
4 | # | |
5 | # The first argument defines a debug log file that the script write to. | |
6 | # All remaining arguments define a list of supported protocol | |
7 | # capabilities ("clean", "smudge", etc). | |
8 | # | |
9 | # This implementation supports special test cases: | |
10 | # (1) If data with the pathname "clean-write-fail.r" is processed with | |
11 | # a "clean" operation then the write operation will die. | |
12 | # (2) If data with the pathname "smudge-write-fail.r" is processed with | |
13 | # a "smudge" operation then the write operation will die. | |
14 | # (3) If data with the pathname "error.r" is processed with any | |
15 | # operation then the filter signals that it cannot or does not want | |
16 | # to process the file. | |
17 | # (4) If data with the pathname "abort.r" is processed with any | |
18 | # operation then the filter signals that it cannot or does not want | |
19 | # to process the file and any file after that is processed with the | |
20 | # same command. | |
21 | # (5) If data with a pathname that is a key in the DELAY hash is | |
22 | # requested (e.g. "test-delay10.a") then the filter responds with | |
23 | # a "delay" status and sets the "requested" field in the DELAY hash. | |
24 | # The filter will signal the availability of this object after | |
25 | # "count" (field in DELAY hash) "list_available_blobs" commands. | |
26 | # (6) If data with the pathname "missing-delay.a" is processed that the | |
27 | # filter will drop the path from the "list_available_blobs" response. | |
28 | # (7) If data with the pathname "invalid-delay.a" is processed that the | |
29 | # filter will add the path "unfiltered" which was not delayed before | |
30 | # to the "list_available_blobs" response. | |
31 | # | |
32 | ||
33 | use 5.008; | |
34 | sub gitperllib { | |
35 | # Git assumes that all path lists are Unix-y colon-separated ones. But | |
36 | # when the Git for Windows executes the test suite, its MSYS2 Bash | |
37 | # calls git.exe, and colon-separated path lists are converted into | |
38 | # Windows-y semicolon-separated lists of *Windows* paths (which | |
39 | # naturally contain a colon after the drive letter, so splitting by | |
40 | # colons simply does not cut it). | |
41 | # | |
42 | # Detect semicolon-separated path list and handle them appropriately. | |
43 | ||
44 | if ($ENV{GITPERLLIB} =~ /;/) { | |
45 | return split(/;/, $ENV{GITPERLLIB}); | |
46 | } | |
47 | return split(/:/, $ENV{GITPERLLIB}); | |
48 | } | |
49 | use lib (gitperllib()); | |
50 | use strict; | |
51 | use warnings; | |
52 | use IO::File; | |
53 | use Git::Packet; | |
54 | ||
55 | my $MAX_PACKET_CONTENT_SIZE = 65516; | |
56 | my $log_file = shift @ARGV; | |
57 | my @capabilities = @ARGV; | |
58 | ||
59 | open my $debug, ">>", $log_file or die "cannot open log file: $!"; | |
60 | ||
61 | my %DELAY = ( | |
62 | 'test-delay10.a' => { "requested" => 0, "count" => 1 }, | |
63 | 'test-delay11.a' => { "requested" => 0, "count" => 1 }, | |
64 | 'test-delay20.a' => { "requested" => 0, "count" => 2 }, | |
65 | 'test-delay10.b' => { "requested" => 0, "count" => 1 }, | |
66 | 'missing-delay.a' => { "requested" => 0, "count" => 1 }, | |
67 | 'invalid-delay.a' => { "requested" => 0, "count" => 1 }, | |
68 | ); | |
69 | ||
70 | sub rot13 { | |
71 | my $str = shift; | |
72 | $str =~ y/A-Za-z/N-ZA-Mn-za-m/; | |
73 | return $str; | |
74 | } | |
75 | ||
76 | print $debug "START\n"; | |
77 | $debug->flush(); | |
78 | ||
79 | packet_initialize("git-filter", 2); | |
80 | ||
81 | my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay"); | |
82 | packet_check_and_write_capabilities(\%remote_caps, @capabilities); | |
83 | ||
84 | print $debug "init handshake complete\n"; | |
85 | $debug->flush(); | |
86 | ||
87 | while (1) { | |
88 | my ( $res, $command ) = packet_key_val_read("command"); | |
89 | if ( $res == -1 ) { | |
90 | print $debug "STOP\n"; | |
91 | exit(); | |
92 | } | |
93 | print $debug "IN: $command"; | |
94 | $debug->flush(); | |
95 | ||
96 | if ( $command eq "list_available_blobs" ) { | |
97 | # Flush | |
98 | packet_compare_lists([1, ""], packet_bin_read()) || | |
99 | die "bad list_available_blobs end"; | |
100 | ||
101 | foreach my $pathname ( sort keys %DELAY ) { | |
102 | if ( $DELAY{$pathname}{"requested"} >= 1 ) { | |
103 | $DELAY{$pathname}{"count"} = $DELAY{$pathname}{"count"} - 1; | |
104 | if ( $pathname eq "invalid-delay.a" ) { | |
105 | # Send Git a pathname that was not delayed earlier | |
106 | packet_txt_write("pathname=unfiltered"); | |
107 | } | |
108 | if ( $pathname eq "missing-delay.a" ) { | |
109 | # Do not signal Git that this file is available | |
110 | } elsif ( $DELAY{$pathname}{"count"} == 0 ) { | |
111 | print $debug " $pathname"; | |
112 | packet_txt_write("pathname=$pathname"); | |
113 | } | |
114 | } | |
115 | } | |
116 | ||
117 | packet_flush(); | |
118 | ||
119 | print $debug " [OK]\n"; | |
120 | $debug->flush(); | |
121 | packet_txt_write("status=success"); | |
122 | packet_flush(); | |
123 | } else { | |
124 | my ( $res, $pathname ) = packet_key_val_read("pathname"); | |
125 | if ( $res == -1 ) { | |
126 | die "unexpected EOF while expecting pathname"; | |
127 | } | |
128 | print $debug " $pathname"; | |
129 | $debug->flush(); | |
130 | ||
131 | # Read until flush | |
132 | my ( $done, $buffer ) = packet_txt_read(); | |
133 | while ( $buffer ne '' ) { | |
134 | if ( $buffer eq "can-delay=1" ) { | |
135 | if ( exists $DELAY{$pathname} and $DELAY{$pathname}{"requested"} == 0 ) { | |
136 | $DELAY{$pathname}{"requested"} = 1; | |
137 | } | |
138 | } elsif ($buffer =~ /^(ref|treeish|blob)=/) { | |
139 | print $debug " $buffer"; | |
140 | } else { | |
141 | # In general, filters need to be graceful about | |
142 | # new metadata, since it's documented that we | |
143 | # can pass any key-value pairs, but for tests, | |
144 | # let's be a little stricter. | |
145 | die "Unknown message '$buffer'"; | |
146 | } | |
147 | ||
148 | ( $done, $buffer ) = packet_txt_read(); | |
149 | } | |
150 | if ( $done == -1 ) { | |
151 | die "unexpected EOF after pathname '$pathname'"; | |
152 | } | |
153 | ||
154 | my $input = ""; | |
155 | { | |
156 | binmode(STDIN); | |
157 | my $buffer; | |
158 | my $done = 0; | |
159 | while ( !$done ) { | |
160 | ( $done, $buffer ) = packet_bin_read(); | |
161 | $input .= $buffer; | |
162 | } | |
163 | if ( $done == -1 ) { | |
164 | die "unexpected EOF while reading input for '$pathname'"; | |
165 | } | |
166 | print $debug " " . length($input) . " [OK] -- "; | |
167 | $debug->flush(); | |
168 | } | |
169 | ||
170 | my $output; | |
171 | if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) { | |
172 | $output = $DELAY{$pathname}{"output"} | |
173 | } elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) { | |
174 | $output = ""; | |
175 | } elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) { | |
176 | $output = rot13($input); | |
177 | } elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) { | |
178 | $output = rot13($input); | |
179 | } else { | |
180 | die "bad command '$command'"; | |
181 | } | |
182 | ||
183 | if ( $pathname eq "error.r" ) { | |
184 | print $debug "[ERROR]\n"; | |
185 | $debug->flush(); | |
186 | packet_txt_write("status=error"); | |
187 | packet_flush(); | |
188 | } elsif ( $pathname eq "abort.r" ) { | |
189 | print $debug "[ABORT]\n"; | |
190 | $debug->flush(); | |
191 | packet_txt_write("status=abort"); | |
192 | packet_flush(); | |
193 | } elsif ( $command eq "smudge" and | |
194 | exists $DELAY{$pathname} and | |
195 | $DELAY{$pathname}{"requested"} == 1 ) { | |
196 | print $debug "[DELAYED]\n"; | |
197 | $debug->flush(); | |
198 | packet_txt_write("status=delayed"); | |
199 | packet_flush(); | |
200 | $DELAY{$pathname}{"requested"} = 2; | |
201 | $DELAY{$pathname}{"output"} = $output; | |
202 | } else { | |
203 | packet_txt_write("status=success"); | |
204 | packet_flush(); | |
205 | ||
206 | if ( $pathname eq "${command}-write-fail.r" ) { | |
207 | print $debug "[WRITE FAIL]\n"; | |
208 | $debug->flush(); | |
209 | die "${command} write error"; | |
210 | } | |
211 | ||
212 | print $debug "OUT: " . length($output) . " "; | |
213 | $debug->flush(); | |
214 | ||
215 | while ( length($output) > 0 ) { | |
216 | my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE ); | |
217 | packet_bin_write($packet); | |
218 | # dots represent the number of packets | |
219 | print $debug "."; | |
220 | if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) { | |
221 | $output = substr( $output, $MAX_PACKET_CONTENT_SIZE ); | |
222 | } else { | |
223 | $output = ""; | |
224 | } | |
225 | } | |
226 | packet_flush(); | |
227 | print $debug " [OK]\n"; | |
228 | $debug->flush(); | |
229 | packet_flush(); | |
230 | } | |
231 | } | |
232 | } |