mingw: handle GITPERLLIB in t0021 in a Windows-compatible way
[git/git.git] / t / t0021 / rot13-filter.pl
CommitLineData
edcc8581
LS
1#
2# Example implementation for the Git filter protocol version 2
3# See Documentation/gitattributes.txt, section "Filter Protocol"
4#
e1ec4721
LS
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).
edcc8581
LS
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.
2841e8f8
LS
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.
edcc8581
LS
31#
32
0fe8d516 33use 5.008;
3306f652
JS
34sub 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}
49use lib (gitperllib());
edcc8581
LS
50use strict;
51use warnings;
4821494e 52use IO::File;
0fe8d516 53use Git::Packet;
edcc8581
LS
54
55my $MAX_PACKET_CONTENT_SIZE = 65516;
e1ec4721 56my $log_file = shift @ARGV;
edcc8581
LS
57my @capabilities = @ARGV;
58
e1ec4721 59open my $debug, ">>", $log_file or die "cannot open log file: $!";
edcc8581 60
2841e8f8
LS
61my %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
edcc8581
LS
70sub rot13 {
71 my $str = shift;
72 $str =~ y/A-Za-z/N-ZA-Mn-za-m/;
73 return $str;
74}
75
edcc8581
LS
76print $debug "START\n";
77$debug->flush();
78
25cbfe34 79packet_initialize("git-filter", 2);
edcc8581 80
f11c8ce1
CC
81my %remote_caps = packet_read_and_check_capabilities("clean", "smudge", "delay");
82packet_check_and_write_capabilities(\%remote_caps, @capabilities);
83
edcc8581
LS
84print $debug "init handshake complete\n";
85$debug->flush();
86
87while (1) {
cb1c64b4 88 my ( $res, $command ) = packet_key_val_read("command");
2c9ea595
CC
89 if ( $res == -1 ) {
90 print $debug "STOP\n";
91 exit();
92 }
edcc8581
LS
93 print $debug "IN: $command";
94 $debug->flush();
95
2841e8f8
LS
96 if ( $command eq "list_available_blobs" ) {
97 # Flush
2c9ea595
CC
98 packet_compare_lists([1, ""], packet_bin_read()) ||
99 die "bad list_available_blobs end";
c6b0831c 100
2841e8f8
LS
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 }
edcc8581 115 }
edcc8581 116
edcc8581 117 packet_flush();
2841e8f8
LS
118
119 print $debug " [OK]\n";
edcc8581 120 $debug->flush();
2841e8f8 121 packet_txt_write("status=success");
edcc8581 122 packet_flush();
ed17d262 123 } else {
cb1c64b4 124 my ( $res, $pathname ) = packet_key_val_read("pathname");
2c9ea595
CC
125 if ( $res == -1 ) {
126 die "unexpected EOF while expecting pathname";
127 }
2841e8f8
LS
128 print $debug " $pathname";
129 $debug->flush();
130
2841e8f8
LS
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 } else {
139 die "Unknown message '$buffer'";
140 }
edcc8581 141
2841e8f8
LS
142 ( $done, $buffer ) = packet_txt_read();
143 }
2c9ea595
CC
144 if ( $done == -1 ) {
145 die "unexpected EOF after pathname '$pathname'";
146 }
2841e8f8
LS
147
148 my $input = "";
149 {
150 binmode(STDIN);
151 my $buffer;
152 my $done = 0;
153 while ( !$done ) {
154 ( $done, $buffer ) = packet_bin_read();
155 $input .= $buffer;
156 }
2c9ea595
CC
157 if ( $done == -1 ) {
158 die "unexpected EOF while reading input for '$pathname'";
159 }
2841e8f8 160 print $debug " " . length($input) . " [OK] -- ";
edcc8581 161 $debug->flush();
edcc8581
LS
162 }
163
2841e8f8
LS
164 my $output;
165 if ( exists $DELAY{$pathname} and exists $DELAY{$pathname}{"output"} ) {
166 $output = $DELAY{$pathname}{"output"}
ed17d262 167 } elsif ( $pathname eq "error.r" or $pathname eq "abort.r" ) {
2841e8f8 168 $output = "";
ed17d262 169 } elsif ( $command eq "clean" and grep( /^clean$/, @capabilities ) ) {
2841e8f8 170 $output = rot13($input);
ed17d262 171 } elsif ( $command eq "smudge" and grep( /^smudge$/, @capabilities ) ) {
2841e8f8 172 $output = rot13($input);
ed17d262 173 } else {
2841e8f8
LS
174 die "bad command '$command'";
175 }
176
177 if ( $pathname eq "error.r" ) {
178 print $debug "[ERROR]\n";
179 $debug->flush();
180 packet_txt_write("status=error");
181 packet_flush();
ed17d262 182 } elsif ( $pathname eq "abort.r" ) {
2841e8f8
LS
183 print $debug "[ABORT]\n";
184 $debug->flush();
185 packet_txt_write("status=abort");
186 packet_flush();
ed17d262 187 } elsif ( $command eq "smudge" and
2841e8f8 188 exists $DELAY{$pathname} and
ed17d262 189 $DELAY{$pathname}{"requested"} == 1 ) {
2841e8f8
LS
190 print $debug "[DELAYED]\n";
191 $debug->flush();
192 packet_txt_write("status=delayed");
193 packet_flush();
194 $DELAY{$pathname}{"requested"} = 2;
195 $DELAY{$pathname}{"output"} = $output;
ed17d262 196 } else {
2841e8f8
LS
197 packet_txt_write("status=success");
198 packet_flush();
17573334 199
2841e8f8
LS
200 if ( $pathname eq "${command}-write-fail.r" ) {
201 print $debug "[WRITE FAIL]\n";
202 $debug->flush();
203 die "${command} write error";
edcc8581 204 }
2841e8f8
LS
205
206 print $debug "OUT: " . length($output) . " ";
207 $debug->flush();
208
209 while ( length($output) > 0 ) {
210 my $packet = substr( $output, 0, $MAX_PACKET_CONTENT_SIZE );
211 packet_bin_write($packet);
212 # dots represent the number of packets
213 print $debug ".";
214 if ( length($output) > $MAX_PACKET_CONTENT_SIZE ) {
215 $output = substr( $output, $MAX_PACKET_CONTENT_SIZE );
ed17d262 216 } else {
2841e8f8
LS
217 $output = "";
218 }
edcc8581 219 }
2841e8f8
LS
220 packet_flush();
221 print $debug " [OK]\n";
222 $debug->flush();
223 packet_flush();
edcc8581 224 }
edcc8581
LS
225 }
226}