checkimg, distill: A couple of scripts useful for testing and debugging.
authorMark Wooding <mdw@distorted.org.uk>
Fri, 18 Feb 2022 23:01:13 +0000 (23:01 +0000)
committerMark Wooding <mdw@distorted.org.uk>
Fri, 18 Feb 2022 23:01:13 +0000 (23:01 +0000)
checkimg [new file with mode: 0755]
distill [new file with mode: 0755]

diff --git a/checkimg b/checkimg
new file mode 100755 (executable)
index 0000000..b4d71bd
--- /dev/null
+++ b/checkimg
@@ -0,0 +1,68 @@
+#! /usr/bin/perl
+
+use autodie;
+
+(my $prog = $0) =~ s!^.*/!!;
+
+die "usage: $prog ORIG COPY\n" unless @ARGV == 2;
+my ($orig, $copy) = @ARGV;
+
+open my $ofh, "<", $orig; binmode $ofh;
+open my $cfh, "<", $copy; binmode $cfh;
+
+my $SECSZ = 2048;
+my $ZERO = "\0" x $SECSZ;
+
+my $rc = 0;
+sub bad ($) {
+  my ($msg) = @_;
+  print STDERR "$prog: $msg\n";
+  $rc = 2 unless $rc > 2;
+}
+
+my ($obuf, $cbuf);
+my $i = 0;
+my $report = "";
+my $prev = undef;
+my $st = undef;
+sub update ($) {
+  my ($newst) = @_;
+  if ($newst ne $st) {
+    if (defined $st) {
+      $report .= ", " if $report;
+      if ($st eq 'copy') { $report .= "$prev .. $i"; }
+      elsif ($st eq 'zero') { $report .= "[$prev .. $i]"; }
+      else { $report .= "($st: $prev .. $i)"; }
+    }
+    $st = $newst; $prev = $i;
+  }
+}
+SECTOR: for (;;) {
+  my $on = read $ofh, $obuf, $SECSZ;
+  my $cn = read $cfh, $cbuf, $SECSZ;
+  if ($on < $SECSZ || $cn < $SECSZ) {
+    if ($on == $SECSZ) {
+      if (!$cn) { bad "premature end at sector #$i in `$copy'"; }
+      else { bad "short sector #$i in `$copy'"; }
+    } elsif (!on) {
+      bad "continuation from sector #$i in `$copy'";
+    } elsif ($on == $cn) {
+      bad "final short sector #$i in both files" if $on;
+      if ($cbuf eq $obuf) { $newst = 'copy'; }
+      elsif ($cbuf eq "\0" x $on) { $newst = 'zero'; }
+      else { bad "corrupted short sector #$i in `$copy'"; }
+    } else {
+      bad "short sector #$i in both files"
+    }
+    last SECTOR;
+  }
+
+  my $newst;
+  if ($cbuf eq $obuf) { $newst = 'copy'; }
+  elsif ($cbuf eq $ZERO) { $newst = 'zero'; }
+  else { bad "corrupted sector #$i in `$copy'"; $newst = 'bogus'; }
+  update $newst; $i++;
+}
+update 'end';
+print $report, "\n";
+exit $rc;
diff --git a/distill b/distill
new file mode 100755 (executable)
index 0000000..31793fd
--- /dev/null
+++ b/distill
@@ -0,0 +1,17 @@
+#! /usr/bin/perl
+
+use autodie;
+
+my $ZERO = "\0" x 2048;
+for my $f (@ARGV) {
+  open my $fh, "<", $f; binmode $fh;
+  my $buf;
+  my $i = 0;
+  SECTOR: for (;;) {
+    my $n = read $fh, $buf, 2048; last SECTOR if $n < 2048;
+    my $head;
+    if ($buf eq $ZERO) { $head = "---"; }
+    else { $head = unpack "H*", substr $buf, 0, 16; }
+    printf "%8d: %s\n", $i++, $head;
+  }
+}