added on local at 2026-07-12 23:15:09
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- _blob_verify.pl | |
| 4 | # | |
| 5 | # Silent random-sample integrity check on BLOB_STORE. Every hourly run: | |
| 6 | # * pulls up to 500 random blobs (not yet verified in the last N days) | |
| 7 | # * decompresses each; hashes; compares to stored blob_sha | |
| 8 | # * logs 'ok' / 'corrupt' / 'missing' to BLOB_INTEGRITY_LOG | |
| 9 | # | |
| 10 | # Catches storage corruption BEFORE you need to restore. | |
| 11 | # Never mutates BLOB_STORE. | |
| 12 | #====================================================================== | |
| 13 | use strict; | |
| 14 | use warnings; | |
| 15 | use lib '/var/www/vhosts/3dshawn.com/site1'; | |
| 16 | use POSIX (); | |
| 17 | use Compress::Zlib qw(uncompress); | |
| 18 | use Digest::SHA qw(sha256_hex); | |
| 19 | use MODS::Config; | |
| 20 | use MODS::DBConnect; | |
| 21 | ||
| 22 | $| = 1; | |
| 23 | my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime); | |
| 24 | my $db = MODS::DBConnect->new; | |
| 25 | my $dbh = $db->db_connect or die "[$ts] cannot connect\n"; | |
| 26 | ||
| 27 | my $SAMPLE_SIZE = 500; | |
| 28 | my $STALE_DAYS = 14; # skip blobs verified in the last N days | |
| 29 | ||
| 30 | # Build a lookup of recently-verified-OK blobs (subquery in DBConnect-wrapped | |
| 31 | # JOINs was rejecting; do it as two passes and combine in perl). | |
| 32 | my %recently_ok; | |
| 33 | foreach my $r ($db->db_readwrite_multiple($dbh, qq~ | |
| 34 | SELECT blob_sha, MAX(checked_at) AS last_check | |
| 35 | FROM BLOB_INTEGRITY_LOG | |
| 36 | WHERE status = 'ok' | |
| 37 | AND checked_at >= DATE_SUB(NOW(), INTERVAL $STALE_DAYS DAY) | |
| 38 | GROUP BY blob_sha | |
| 39 | ~, __FILE__, __LINE__)) { | |
| 40 | $recently_ok{$r->{blob_sha}} = 1; | |
| 41 | } | |
| 42 | ||
| 43 | # Pick a random sample from BLOB_STORE, filter out recently-verified ones, | |
| 44 | # take up to $SAMPLE_SIZE. | |
| 45 | my @cands; | |
| 46 | foreach my $r ($db->db_readwrite_multiple($dbh, qq~ | |
| 47 | SELECT blob_sha FROM BLOB_STORE ORDER BY RAND() LIMIT @{[$SAMPLE_SIZE * 3]} | |
| 48 | ~, __FILE__, __LINE__)) { | |
| 49 | next if $recently_ok{$r->{blob_sha}}; | |
| 50 | push @cands, $r; | |
| 51 | last if scalar(@cands) >= $SAMPLE_SIZE; | |
| 52 | } | |
| 53 | ||
| 54 | my ($ok, $corrupt, $missing, $decompress_fail) = (0, 0, 0, 0); | |
| 55 | my $sth_blob = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?"); | |
| 56 | my $sth_log = $dbh->prepare( | |
| 57 | "INSERT INTO BLOB_INTEGRITY_LOG (blob_sha, status, detail) VALUES (?, ?, ?)" | |
| 58 | ); | |
| 59 | ||
| 60 | foreach my $c (@cands) { | |
| 61 | my $sha = $c->{blob_sha}; | |
| 62 | unless ($sth_blob->execute($sha)) { | |
| 63 | $sth_log->execute($sha, 'missing', 'blob_sha row disappeared mid-check'); | |
| 64 | $missing++; next; | |
| 65 | } | |
| 66 | my $r = $sth_blob->fetchrow_arrayref; | |
| 67 | $sth_blob->finish; | |
| 68 | unless ($r && defined $r->[0]) { | |
| 69 | $sth_log->execute($sha, 'missing', 'content_gz is NULL'); | |
| 70 | $missing++; next; | |
| 71 | } | |
| 72 | my $content = eval { uncompress($r->[0]) }; | |
| 73 | unless (defined $content) { | |
| 74 | my $err = $@ || 'unknown decompress error'; | |
| 75 | $err = substr($err, 0, 400); | |
| 76 | $sth_log->execute($sha, 'corrupt', "decompress failed: $err"); | |
| 77 | $decompress_fail++; $corrupt++; next; | |
| 78 | } | |
| 79 | my $actual = sha256_hex($content); | |
| 80 | if ($actual ne $sha) { | |
| 81 | $sth_log->execute($sha, 'corrupt', "sha mismatch: stored=$sha actual=$actual"); | |
| 82 | $corrupt++; next; | |
| 83 | } | |
| 84 | $sth_log->execute($sha, 'ok', undef); | |
| 85 | $ok++; | |
| 86 | } | |
| 87 | ||
| 88 | my $total = scalar @cands; | |
| 89 | print "[$ts] blob_verify: sampled=$total ok=$ok corrupt=$corrupt missing=$missing decompress_failed=$decompress_fail\n"; | |
| 90 | ||
| 91 | # If anything corrupt/missing this pass, do a one-shot summary insert too | |
| 92 | if ($corrupt + $missing > 0) { | |
| 93 | warn "[$ts] BLOB INTEGRITY ALERT: $corrupt corrupt + $missing missing (see BLOB_INTEGRITY_LOG)\n"; | |
| 94 | } | |
| 95 | ||
| 96 | $db->db_disconnect($dbh); | |
| 97 | exit 0; |