50 lines
1.0 KiB
Perl
50 lines
1.0 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use File::Sync qw(fsync);
|
|
use Fcntl qw(:DEFAULT O_ASYNC O_DIRECT);
|
|
|
|
my $device = $ARGV[0];
|
|
my $logfn = $ARGV[1];
|
|
if (!$logfn)
|
|
{
|
|
print "USAGE: perl r20.pl DEVICE LOGFILE\n";
|
|
exit;
|
|
}
|
|
|
|
my $last = {};
|
|
my $logfd;
|
|
open $logfd, $logfn or die $!;
|
|
my $i = 0;
|
|
while (my $s = <$logfd>)
|
|
{
|
|
$s =~ s/[\x0d\x0a]+$//;
|
|
my ($pos, $hex) = split / /, $s, 2;
|
|
$last->{$pos} = $i++;
|
|
}
|
|
|
|
my $fd;
|
|
sysopen $fd, $device, O_RDONLY or die $!;
|
|
my $buffer = " " x 4096;
|
|
my $fact;
|
|
$i = 0;
|
|
seek $logfd, 0, 0 or die $!;
|
|
while (my $s = <$logfd>)
|
|
{
|
|
$s =~ s/[\x0d\x0a]+$//;
|
|
my ($pos, $hex) = split / /, $s, 2;
|
|
next if $last->{$pos} != $i; # only check last overwrite
|
|
$hex = pack("H*", $hex);
|
|
substr($buffer, 0, 4096, ($hex x 512));
|
|
sysseek($fd, $pos*4096, 0) or die $!;
|
|
sysread($fd, $fact, 4096) or die $!;
|
|
if ($fact ne $buffer)
|
|
{
|
|
print "Mismatch at offset $pos*4096 (line $i): ".unpack("H*", substr($fact, 0, 8))." vs ".unpack("H*", $hex)."\n";
|
|
}
|
|
$i++;
|
|
}
|
|
close $fd;
|
|
|
|
close $logfd;
|