t/lib-chunk/corrupt-chunk-file.pl

   1 #!/usr/bin/perl
   2
   3 my ($chunk, $seek, $bytes) = @ARGV;
   4 $bytes =~ s/../chr(hex($&))/ge;
   5
   6 binmode STDIN;
   7 binmode STDOUT;
   8
   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;
  17 }
  18 sub copy {
  19         my $buf = get(@_);
  20         print $buf;
  21         return $buf;
  22 }
  23
  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.
  27 #
  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));
  32
  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;
  44                 }
  45                 print pack("Q>", $next - $len + length($bytes));
  46         } while (unpack("N", $id));
  47 }
  48
  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));
  59 }
  60
  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;
  66 }