Merge branch 'rc/trace-upload-pack'
[alt-git.git] / t / lib-chunk / corrupt-chunk-file.pl
blobcd6d386fef512653bfa8d4c8e6037ff75cbfd266
1 #!/usr/bin/perl
3 my ($chunk, $seek, $bytes) = @ARGV;
4 $bytes =~ s/../chr(hex($&))/ge;
6 binmode STDIN;
7 binmode STDOUT;
9 # A few helpers to read bytes, or read and copy them to the
10 # output.
11 sub get {
12 my $n = shift;
13 return unless $n;
14 read(STDIN, my $buf, $n)
15 or die "read error or eof: $!\n";
16 return $buf;
18 sub copy {
19 my $buf = get(@_);
20 print $buf;
21 return $buf;
24 # read until we find table-of-contents entry for chunk;
25 # note that we cheat a bit by assuming 4-byte alignment and
26 # that no ToC entry will accidentally look like a header.
28 # If we don't find the entry, copy() will hit EOF and exit
29 # (which should cause the caller to fail the test).
30 while (copy(4) ne $chunk) { }
31 my $offset = unpack("Q>", copy(8));
33 # In clear mode, our length will change. So figure out
34 # the length by comparing to the offset of the next chunk, and
35 # then adjust that offset (and all subsequent) ones.
36 my $len;
37 if ($seek eq "clear") {
38 my $id;
39 do {
40 $id = copy(4);
41 my $next = unpack("Q>", get(8));
42 if (!defined $len) {
43 $len = $next - $offset;
45 print pack("Q>", $next - $len + length($bytes));
46 } while (unpack("N", $id));
49 # and now copy up to our existing chunk data
50 copy($offset - tell(STDIN));
51 if ($seek eq "clear") {
52 # if clearing, skip past existing data
53 get($len);
54 } else {
55 # otherwise, copy up to the requested offset,
56 # and skip past the overwritten bytes
57 copy($seek);
58 get(length($bytes));
61 # now write out the requested bytes, along
62 # with any other remaining data
63 print $bytes;
64 while (read(STDIN, my $buf, 4096)) {
65 print $buf;