chiark - git - mdw - dvdrip/blob - checkimg

   1 #! /usr/bin/perl
   2
   3 use autodie;
   4
   5 (my $prog = $0) =~ s!^.*/!!;
   6
   7 die "usage: $prog ORIG COPY\n" unless @ARGV == 2;
   8 my ($orig, $copy) = @ARGV;
   9
  10 open my $ofh, "<", $orig; binmode $ofh;
  11 open my $cfh, "<", $copy; binmode $cfh;
  12
  13 my $SECSZ = 2048;
  14 my $ZERO = "\0" x $SECSZ;
  15
  16 my $rc = 0;
  17 sub bad ($) {
  18   my ($msg) = @_;
  19   print STDERR "$prog: $msg\n";
  20   $rc = 2 unless $rc > 2;
  21 }
  22
  23 my ($obuf, $cbuf);
  24 my $i = 0;
  25 my $report = "";
  26 my $prev = undef;
  27 my $st = undef;
  28 sub update ($) {
  29   my ($newst) = @_;
  30   if ($newst ne $st) {
  31     if (defined $st) {
  32       $report .= ", " if $report;
  33       if ($st eq 'copy') { $report .= "$prev .. $i"; }
  34       elsif ($st eq 'zero') { $report .= "[$prev .. $i]"; }
  35       else { $report .= "($st: $prev .. $i)"; }
  36     }
  37     $st = $newst; $prev = $i;
  38   }
  39 }
  40 SECTOR: for (;;) {
  41   my $on = read $ofh, $obuf, $SECSZ;
  42   my $cn = read $cfh, $cbuf, $SECSZ;
  43   if ($on < $SECSZ || $cn < $SECSZ) {
  44     if ($on == $SECSZ) {
  45       if (!$cn) { bad "premature end at sector #$i in `$copy'"; }
  46       else { bad "short sector #$i in `$copy'"; }
  47     } elsif (!on) {
  48       bad "continuation from sector #$i in `$copy'";
  49     } elsif ($on == $cn) {
  50       bad "final short sector #$i in both files" if $on;
  51       if ($cbuf eq $obuf) { $newst = 'copy'; }
  52       elsif ($cbuf eq "\0" x $on) { $newst = 'zero'; }
  53       else { bad "corrupted short sector #$i in `$copy'"; }
  54     } else {
  55       bad "short sector #$i in both files"
  56     }
  57     last SECTOR;
  58   }
  59
  60   my $newst;
  61   if ($cbuf eq $obuf) { $newst = 'copy'; }
  62   elsif ($cbuf eq $ZERO) { $newst = 'zero'; }
  63   else { bad "corrupted sector #$i in `$copy'"; $newst = 'bogus'; }
  64   update $newst; $i++;
  65 }
  66 update 'end';
  67 print $report, "\n";
  68 exit $rc;