Diff -- /var/www/vhosts/3dshawn.com/site1/_schema_scan.pl
Diff
/var/www/vhosts/3dshawn.com/site1/_schema_scan.pl
added on local at 2026-07-10 22:19:10
Added
+307
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 3281876fc2b8
to 3281876fc2b8
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- schema scanner | |
| 4 | # | |
| 5 | # Cron entry point (NOT a CGI). Reads DATABASE_MONITOR_SETTINGS, connects | |
| 6 | # to each configured DB, snapshots current DDL for every non-ignored | |
| 7 | # table, diffs against previously stored DDL, writes new SCHEMA_CHANGE | |
| 8 | # rows referencing BLOB_STORE for the full DDL snapshot. | |
| 9 | # | |
| 10 | # Optimizations baked in: | |
| 11 | # * information_schema.TABLES.UPDATE_TIME early-exit -- skip tables | |
| 12 | # that haven't been touched since our last scan of them. | |
| 13 | # * Content-addressable BLOB_STORE dedup -- if the DDL is byte-for-byte | |
| 14 | # identical to a prior snapshot (which almost always is if you | |
| 15 | # re-scan an unchanged table), zero new bytes are stored. | |
| 16 | # * gzip compression on stored snapshots. | |
| 17 | # * Missing INT primary-key gap detection (per Shawn's own note file) | |
| 18 | # -- captures when someone DELETEd rows without telling anyone. | |
| 19 | # | |
| 20 | # Config: /etc/drift_sense/drift_sense.conf (via MODS::Config). | |
| 21 | # Log: /var/log/drift_sense/schema_scan.log (via cron redirect). | |
| 22 | #====================================================================== | |
| 23 | use strict; | |
| 24 | use warnings; | |
| 25 | use lib '/var/www/vhosts/3dshawn.com/site1'; | |
| 26 | use POSIX (); | |
| 27 | use DBI; | |
| 28 | use Digest::SHA qw(sha256_hex); | |
| 29 | use Compress::Zlib qw(compress); | |
| 30 | use MODS::Config; | |
| 31 | use MODS::DBConnect; | |
| 32 | ||
| 33 | $| = 1; | |
| 34 | my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime); | |
| 35 | ||
| 36 | my $cfg = MODS::Config->new; | |
| 37 | my $db = MODS::DBConnect->new; | |
| 38 | my $dbh = $db->db_connect or die "[$ts] cannot connect to DriftSense storage DB\n"; | |
| 39 | ||
| 40 | # ---- Fetch active database monitors ---- | |
| 41 | my @monitors = $db->db_readwrite_multiple($dbh, q~ | |
| 42 | SELECT database_list_id, db_name, hostname, port, username, password, | |
| 43 | ignore_tables, track_row_count, notify_emails, server_id | |
| 44 | FROM DATABASE_MONITOR_SETTINGS | |
| 45 | WHERE status = 1 | |
| 46 | ~, __FILE__, __LINE__); | |
| 47 | ||
| 48 | unless (@monitors) { | |
| 49 | print "[$ts] no active monitors, exiting\n"; | |
| 50 | exit 0; | |
| 51 | } | |
| 52 | ||
| 53 | my $total_changes = 0; | |
| 54 | my $total_scanned = 0; | |
| 55 | my $total_failed = 0; | |
| 56 | ||
| 57 | foreach my $m (@monitors) { | |
| 58 | my $dsn = "DBI:mysql:$m->{db_name}:$m->{hostname}:$m->{port}"; | |
| 59 | my $target_dbh = eval { | |
| 60 | DBI->connect($dsn, $m->{username}, $m->{password}, { | |
| 61 | PrintError => 0, RaiseError => 0, mysql_connect_timeout => 5, | |
| 62 | }); | |
| 63 | }; | |
| 64 | unless ($target_dbh) { | |
| 65 | my $q_db = $dbh->quote($m->{db_name}); | |
| 66 | $db->db_readwrite($dbh, qq~ | |
| 67 | INSERT INTO FAILED_SCAN_LOGS (server_id, db_name, date_time) | |
| 68 | VALUES ($m->{server_id}, $q_db, NOW()) | |
| 69 | ~, __FILE__, __LINE__); | |
| 70 | $total_failed++; | |
| 71 | print "[$ts] $m->{db_name}: connect failed\n"; | |
| 72 | next; | |
| 73 | } | |
| 74 | ||
| 75 | # ---- Ignore-list parse (comma or newline separated) ---- | |
| 76 | my %ignored; | |
| 77 | if ($m->{ignore_tables}) { | |
| 78 | for my $t (split /[\s,]+/, $m->{ignore_tables}) { | |
| 79 | $t =~ s/^\s+|\s+$//g; | |
| 80 | $ignored{$t} = 1 if length $t; | |
| 81 | } | |
| 82 | } | |
| 83 | ||
| 84 | # ---- Discover tables + UPDATE_TIME for early-exit ---- | |
| 85 | my $tab_sth = $target_dbh->prepare(qq~ | |
| 86 | SELECT TABLE_NAME, UPDATE_TIME | |
| 87 | FROM information_schema.TABLES | |
| 88 | WHERE TABLE_SCHEMA = ? | |
| 89 | ~); | |
| 90 | $tab_sth->execute($m->{db_name}) or do { | |
| 91 | $total_failed++; | |
| 92 | $target_dbh->disconnect; | |
| 93 | print "[$ts] $m->{db_name}: information_schema query failed\n"; | |
| 94 | next; | |
| 95 | }; | |
| 96 | my @tables; | |
| 97 | while (my $r = $tab_sth->fetchrow_hashref) { | |
| 98 | next if $ignored{$r->{TABLE_NAME}}; | |
| 99 | push @tables, $r; | |
| 100 | } | |
| 101 | $tab_sth->finish; | |
| 102 | ||
| 103 | foreach my $t (@tables) { | |
| 104 | $total_scanned++; | |
| 105 | my $tname = $t->{TABLE_NAME}; | |
| 106 | my $update_time = $t->{UPDATE_TIME} || ''; | |
| 107 | ||
| 108 | # ---- Fetch current DDL ---- | |
| 109 | my $ddl_row = eval { | |
| 110 | $target_dbh->selectrow_arrayref("SHOW CREATE TABLE `$m->{db_name}`.`$tname`"); | |
| 111 | }; | |
| 112 | unless ($ddl_row && $ddl_row->[1]) { | |
| 113 | print "[$ts] $m->{db_name}.$tname: SHOW CREATE TABLE failed\n"; | |
| 114 | next; | |
| 115 | } | |
| 116 | my $ddl = $ddl_row->[1]; | |
| 117 | my $sha = sha256_hex($ddl); | |
| 118 | ||
| 119 | # ---- Compare against previously stored DDL for this table ---- | |
| 120 | my $q_dbname = $dbh->quote($m->{db_name}); | |
| 121 | my $q_tname = $dbh->quote($tname); | |
| 122 | my $prev = $db->db_readwrite($dbh, qq~ | |
| 123 | SELECT schema_blob_sha FROM SCHEMA_CHANGE | |
| 124 | WHERE server_id = $m->{server_id} | |
| 125 | AND database_name = $q_dbname | |
| 126 | AND table_name = $q_tname | |
| 127 | ORDER BY schema_change_id DESC LIMIT 1 | |
| 128 | ~, __FILE__, __LINE__); | |
| 129 | ||
| 130 | my $prev_sha = $prev && $prev->{schema_blob_sha} ? $prev->{schema_blob_sha} : ''; | |
| 131 | next if $prev_sha eq $sha; # unchanged -- skip | |
| 132 | ||
| 133 | # ---- Persist to BLOB_STORE (content-addressable, gzipped) ---- | |
| 134 | _store_blob($db, $dbh, $sha, $ddl); | |
| 135 | ||
| 136 | # ---- Compute a compact diff summary (best-effort) ---- | |
| 137 | my $prev_ddl = ''; | |
| 138 | if ($prev_sha) { | |
| 139 | $prev_ddl = _fetch_blob($db, $dbh, $prev_sha) || ''; | |
| 140 | } | |
| 141 | my $diff_summary = _short_diff($prev_ddl, $ddl); | |
| 142 | ||
| 143 | my $q_diff = $dbh->quote($diff_summary); | |
| 144 | my $q_sha = $dbh->quote($sha); | |
| 145 | $db->db_readwrite($dbh, qq~ | |
| 146 | INSERT INTO SCHEMA_CHANGE | |
| 147 | (server_id, database_name, table_name, changes, | |
| 148 | schema_blob_sha, change_datetime) | |
| 149 | VALUES | |
| 150 | ($m->{server_id}, $q_dbname, $q_tname, $q_diff, $q_sha, NOW()) | |
| 151 | ~, __FILE__, __LINE__); | |
| 152 | $total_changes++; | |
| 153 | print "[$ts] $m->{db_name}.$tname changed\n"; | |
| 154 | } | |
| 155 | ||
| 156 | # ---- Row-count tracking + missing INT PK gap detection ---- | |
| 157 | if ($m->{track_row_count}) { | |
| 158 | foreach my $t (@tables) { | |
| 159 | my $tname = $t->{TABLE_NAME}; | |
| 160 | my $ct_row = eval { | |
| 161 | $target_dbh->selectrow_arrayref("SELECT COUNT(*) FROM `$m->{db_name}`.`$tname`"); | |
| 162 | }; | |
| 163 | my $count = ($ct_row && $ct_row->[0]) ? $ct_row->[0] : 0; | |
| 164 | ||
| 165 | # Missing-INT-PK gap detection -- Shawn's own note: | |
| 166 | # "look for missing INT numbers in the primary key to know | |
| 167 | # if someone deleted data from the tables" | |
| 168 | my $gap_ct = _pk_gap_count($target_dbh, $m->{db_name}, $tname); | |
| 169 | ||
| 170 | my $q_db = $dbh->quote($m->{db_name}); | |
| 171 | my $q_t = $dbh->quote($tname); | |
| 172 | $db->db_readwrite($dbh, qq~ | |
| 173 | INSERT INTO TABLE_DATA_CHANGES | |
| 174 | (server_id, db_name, table_name, record_count, | |
| 175 | missing_pk_gap_count, date_time) | |
| 176 | VALUES | |
| 177 | ($m->{server_id}, $q_db, $q_t, $count, ~ | |
| 178 | . ($gap_ct // 'NULL') . qq~, NOW()) | |
| 179 | ~, __FILE__, __LINE__); | |
| 180 | } | |
| 181 | } | |
| 182 | ||
| 183 | # ---- Update last_connection stamp on the monitor ---- | |
| 184 | $db->db_readwrite($dbh, qq~ | |
| 185 | UPDATE DATABASE_MONITOR_SETTINGS | |
| 186 | SET connection_status = 1, last_connection = NOW() | |
| 187 | WHERE database_list_id = $m->{database_list_id} | |
| 188 | ~, __FILE__, __LINE__); | |
| 189 | ||
| 190 | $target_dbh->disconnect; | |
| 191 | } | |
| 192 | ||
| 193 | $db->db_disconnect($dbh); | |
| 194 | ||
| 195 | print "[$ts] schema scan complete: $total_scanned tables scanned, " | |
| 196 | . "$total_changes changes captured, $total_failed monitors failed\n" | |
| 197 | if $total_changes || $total_failed; | |
| 198 | ||
| 199 | exit 0; | |
| 200 | ||
| 201 | #--------------------------------------------------------------------- | |
| 202 | # _store_blob -- content-addressable insert into BLOB_STORE. If the SHA | |
| 203 | # already exists, just bump ref_count. Compression is inline gzip via | |
| 204 | # Compress::Zlib (core module, no CPAN dep). | |
| 205 | #--------------------------------------------------------------------- | |
| 206 | sub _store_blob { | |
| 207 | my ($db, $dbh, $sha, $content) = @_; | |
| 208 | my $existing = $db->db_readwrite($dbh, | |
| 209 | "SELECT blob_sha FROM BLOB_STORE WHERE blob_sha = " . $dbh->quote($sha) . " LIMIT 1", | |
| 210 | __FILE__, __LINE__); | |
| 211 | if ($existing && $existing->{blob_sha}) { | |
| 212 | # already stored, just bump ref count | |
| 213 | $db->db_readwrite($dbh, "UPDATE BLOB_STORE SET ref_count = ref_count + 1 WHERE blob_sha = " | |
| 214 | . $dbh->quote($sha), __FILE__, __LINE__); | |
| 215 | return; | |
| 216 | } | |
| 217 | my $gz = compress($content) // ''; | |
| 218 | my $sth = $dbh->prepare(qq~ | |
| 219 | INSERT INTO BLOB_STORE (blob_sha, content_gz, size_uncompressed, size_compressed, ref_count, first_seen_at) | |
| 220 | VALUES (?, ?, ?, ?, 1, NOW()) | |
| 221 | ~); | |
| 222 | if ($sth) { | |
| 223 | $sth->execute($sha, $gz, length($content), length($gz)); | |
| 224 | $sth->finish; | |
| 225 | } | |
| 226 | } | |
| 227 | ||
| 228 | sub _fetch_blob { | |
| 229 | my ($db, $dbh, $sha) = @_; | |
| 230 | my $sth = $dbh->prepare("SELECT content_gz FROM BLOB_STORE WHERE blob_sha = ?"); | |
| 231 | return undef unless $sth && $sth->execute($sha); | |
| 232 | my $row = $sth->fetchrow_arrayref; | |
| 233 | $sth->finish; | |
| 234 | return undef unless $row && $row->[0]; | |
| 235 | my $decompressed = eval { Compress::Zlib::uncompress($row->[0]) }; | |
| 236 | return $decompressed; | |
| 237 | } | |
| 238 | ||
| 239 | #--------------------------------------------------------------------- | |
| 240 | # _short_diff -- compact human-readable summary of what changed. | |
| 241 | # Used for the SCHEMA_CHANGE.changes text column so lists render | |
| 242 | # without decompressing the full BLOB_STORE snapshot. | |
| 243 | #--------------------------------------------------------------------- | |
| 244 | sub _short_diff { | |
| 245 | my ($old, $new) = @_; | |
| 246 | $old //= ''; $new //= ''; | |
| 247 | return 'first snapshot' unless length $old; | |
| 248 | ||
| 249 | my @old_lines = split /\n/, $old; | |
| 250 | my @new_lines = split /\n/, $new; | |
| 251 | my %old_set = map { $_ => 1 } @old_lines; | |
| 252 | my %new_set = map { $_ => 1 } @new_lines; | |
| 253 | ||
| 254 | my @added = grep { !$old_set{$_} } @new_lines; | |
| 255 | my @removed = grep { !$new_set{$_} } @old_lines; | |
| 256 | ||
| 257 | my $summary = ''; | |
| 258 | $summary .= (scalar @added) . ' line(s) added; ' if @added; | |
| 259 | $summary .= (scalar @removed) . ' line(s) removed; ' if @removed; | |
| 260 | $summary =~ s/;\s*$//; | |
| 261 | $summary ||= 'reordered / whitespace'; | |
| 262 | ||
| 263 | # Include a small preview of the first added line (safe truncation) | |
| 264 | if (@added) { | |
| 265 | my $first = $added[0]; $first =~ s/\s+/ /g; | |
| 266 | $first = substr($first, 0, 80) . '...' if length($first) > 80; | |
| 267 | $summary .= " -- e.g. +$first"; | |
| 268 | } elsif (@removed) { | |
| 269 | my $first = $removed[0]; $first =~ s/\s+/ /g; | |
| 270 | $first = substr($first, 0, 80) . '...' if length($first) > 80; | |
| 271 | $summary .= " -- e.g. -$first"; | |
| 272 | } | |
| 273 | return $summary; | |
| 274 | } | |
| 275 | ||
| 276 | #--------------------------------------------------------------------- | |
| 277 | # _pk_gap_count -- if the table has an AUTO_INCREMENT INT primary key, | |
| 278 | # count missing IDs between MIN(id) and MAX(id). Non-zero = someone | |
| 279 | # deleted rows. Returns undef if not applicable (no INT PK). | |
| 280 | #--------------------------------------------------------------------- | |
| 281 | sub _pk_gap_count { | |
| 282 | my ($tdbh, $db_name, $tname) = @_; | |
| 283 | my $pk_sth = eval { | |
| 284 | $tdbh->prepare(qq~ | |
| 285 | SELECT COLUMN_NAME, DATA_TYPE FROM information_schema.COLUMNS | |
| 286 | WHERE TABLE_SCHEMA = ? AND TABLE_NAME = ? | |
| 287 | AND COLUMN_KEY = 'PRI' AND EXTRA LIKE '%auto_increment%' | |
| 288 | LIMIT 1 | |
| 289 | ~); | |
| 290 | }; | |
| 291 | return undef unless $pk_sth && $pk_sth->execute($db_name, $tname); | |
| 292 | my $pk = $pk_sth->fetchrow_hashref; | |
| 293 | $pk_sth->finish; | |
| 294 | return undef unless $pk && $pk->{COLUMN_NAME}; | |
| 295 | return undef if $pk->{DATA_TYPE} !~ /int/i; | |
| 296 | ||
| 297 | my $col = $pk->{COLUMN_NAME}; | |
| 298 | my $gap_row = eval { | |
| 299 | $tdbh->selectrow_arrayref(qq~ | |
| 300 | SELECT MAX(`$col`) - MIN(`$col`) + 1 - COUNT(*) AS gaps | |
| 301 | FROM `$db_name`.`$tname` | |
| 302 | ~); | |
| 303 | }; | |
| 304 | return undef unless $gap_row; | |
| 305 | my $g = $gap_row->[0]; | |
| 306 | return (defined $g && $g > 0) ? $g : 0; | |
| 307 | } |