added on local at 2026-07-13 16:35:42
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- filesystem scanner | |
| 4 | # | |
| 5 | # Cron entry point (NOT a CGI). Reads FILE_MONITOR_SETTINGS, walks each | |
| 6 | # configured path, and captures every changed file since the previous | |
| 7 | # tick. Optimizations: | |
| 8 | # | |
| 9 | # * mtime-first check -- cheap stat() every file, hash only when | |
| 10 | # mtime differs vs. the last captured version. Turns a 10 GB | |
| 11 | # codebase scan from minutes into seconds. | |
| 12 | # * Content-addressable BLOB_STORE dedup -- if the file's content | |
| 13 | # bounces back to a previous state, zero new bytes stored. | |
| 14 | # * gzip compression on stored snapshots. | |
| 15 | # * Timestamp-only change suppression (per Shawn's own note file) | |
| 16 | # -- files whose only change is mtime (content-identical) get | |
| 17 | # flagged is_ts_only=1 so the UI can filter noise. | |
| 18 | # * Per-scan max_file_size and file_type_filter honored. | |
| 19 | # | |
| 20 | # Config: /etc/drift_sense/drift_sense.conf (via MODS::Config). | |
| 21 | # Log: /var/log/drift_sense/file_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 Getopt::Long (); | |
| 28 | use Digest::SHA qw(sha256_hex); | |
| 29 | use Compress::Zlib qw(compress); | |
| 30 | use File::Find (); | |
| 31 | use MODS::Config; | |
| 32 | use MODS::DBConnect; | |
| 33 | ||
| 34 | # --mid=N restricts the scan to a single monitor. Used by /file_monitors.cgi | |
| 35 | # to trigger an immediate baseline scan when a new monitor is added. | |
| 36 | my $only_mid = 0; | |
| 37 | Getopt::Long::GetOptions('mid=i' => \$only_mid); | |
| 38 | ||
| 39 | $| = 1; | |
| 40 | my $ts = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime); | |
| 41 | ||
| 42 | my $cfg = MODS::Config->new; | |
| 43 | my $db = MODS::DBConnect->new; | |
| 44 | my $dbh = $db->db_connect or die "[$ts] cannot connect to DriftSense storage DB\n"; | |
| 45 | ||
| 46 | # ---- Config: global max-file-size default ---- | |
| 47 | my $default_max_size = int($cfg->settings('max_file_size_bytes') || 10_485_760); | |
| 48 | ||
| 49 | # ---- Global scan settings (SCAN_GLOBALS singleton) ----------------- | |
| 50 | # Applied UNIVERSALLY across every monitor so operators can set | |
| 51 | # "always ignore .swp, node_modules/, etc." in one place. | |
| 52 | my $g_row = $db->db_readwrite($dbh, q~ | |
| 53 | SELECT global_ignore_list, global_file_type_filter, global_max_file_size_bytes | |
| 54 | FROM SCAN_GLOBALS WHERE id = 1 LIMIT 1 | |
| 55 | ~, __FILE__, __LINE__); | |
| 56 | my $global_ignore = ($g_row && $g_row->{global_ignore_list}) // ''; | |
| 57 | my $global_ftypes = ($g_row && $g_row->{global_file_type_filter}) // ''; | |
| 58 | my $global_max_size = ($g_row && $g_row->{global_max_file_size_bytes}) || 0; | |
| 59 | $default_max_size = $global_max_size if $global_max_size; | |
| 60 | ||
| 61 | # ---- Fetch active file monitors ---- | |
| 62 | my $mid_clause = $only_mid ? " AND file_monitor_list_id = " . int($only_mid) : ""; | |
| 63 | my @scans = $db->db_readwrite_multiple($dbh, qq~ | |
| 64 | SELECT file_monitor_list_id, scan_path, ignore_list, file_type_filter, | |
| 65 | max_file_size_bytes, server_id, container_target_id, scan_name | |
| 66 | FROM FILE_MONITOR_SETTINGS | |
| 67 | WHERE status = 1 | |
| 68 | $mid_clause | |
| 69 | ~, __FILE__, __LINE__); | |
| 70 | ||
| 71 | unless (@scans) { | |
| 72 | print "[$ts] no active file monitors, exiting\n"; | |
| 73 | exit 0; | |
| 74 | } | |
| 75 | ||
| 76 | my $total_added = 0; | |
| 77 | my $total_modified = 0; | |
| 78 | my $total_deleted = 0; | |
| 79 | my $total_ts_only = 0; | |
| 80 | ||
| 81 | foreach my $scan (@scans) { | |
| 82 | my $path = $scan->{scan_path} or next; | |
| 83 | unless (-d $path) { | |
| 84 | print "[$ts] scan #$scan->{file_monitor_list_id} '$scan->{scan_name}': path missing ($path)\n"; | |
| 85 | next; | |
| 86 | } | |
| 87 | ||
| 88 | # ---- Ignore patterns: UNION of global + per-monitor ------------ | |
| 89 | my %ignore_pats; | |
| 90 | for my $src ($global_ignore, ($scan->{ignore_list} // '')) { | |
| 91 | next unless length $src; | |
| 92 | for my $ig (split /[,\n]+/, $src) { | |
| 93 | $ig =~ s/^\s+|\s+$//g; | |
| 94 | $ignore_pats{$ig} = _pattern_to_regex($ig) if length $ig; | |
| 95 | } | |
| 96 | } | |
| 97 | ||
| 98 | # ---- File-type filter: per-monitor wins if set, else global --- | |
| 99 | my %type_filter; | |
| 100 | my $eff_ftypes = length($scan->{file_type_filter} // '') | |
| 101 | ? $scan->{file_type_filter} | |
| 102 | : $global_ftypes; | |
| 103 | if ($eff_ftypes && length $eff_ftypes) { | |
| 104 | for my $ext (split /,/, $eff_ftypes) { | |
| 105 | $ext =~ s/^\s+|\s+$//g; | |
| 106 | next unless length $ext; | |
| 107 | $ext = ".$ext" unless $ext =~ /^\./; | |
| 108 | $type_filter{lc $ext} = 1; | |
| 109 | } | |
| 110 | } | |
| 111 | ||
| 112 | my $max_size = $scan->{max_file_size_bytes} || $default_max_size; | |
| 113 | ||
| 114 | # ---- Snapshot of what we captured in the previous tick, keyed by | |
| 115 | # file_name, for delete-detection + mtime-baseline lookup. | |
| 116 | my $prev_sth = $dbh->prepare(qq~ | |
| 117 | SELECT fc.file_name, fc.blob_sha, fc.status, fc.date_time | |
| 118 | FROM FILE_CHANGES fc | |
| 119 | WHERE fc.file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 120 | AND fc.file_changes_id IN ( | |
| 121 | SELECT MAX(inner_fc.file_changes_id) | |
| 122 | FROM FILE_CHANGES inner_fc | |
| 123 | WHERE inner_fc.file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 124 | GROUP BY inner_fc.file_name | |
| 125 | ) | |
| 126 | ~); | |
| 127 | my %prev; | |
| 128 | if ($prev_sth && $prev_sth->execute) { | |
| 129 | while (my $r = $prev_sth->fetchrow_hashref) { | |
| 130 | $prev{$r->{file_name}} = $r; | |
| 131 | } | |
| 132 | $prev_sth->finish; | |
| 133 | } | |
| 134 | # Baseline mode: if this monitor has NEVER captured anything before, | |
| 135 | # this is the initial inventory scan -- flag every inserted row so | |
| 136 | # the dashboard doesn't count baseline captures as "changes". | |
| 137 | my $baseline_mode = scalar(keys %prev) == 0 ? 1 : 0; | |
| 138 | ||
| 139 | # ---- Walk + capture ---- | |
| 140 | my %seen; | |
| 141 | File::Find::find({ | |
| 142 | no_chdir => 1, | |
| 143 | wanted => sub { | |
| 144 | my $f = $File::Find::name; | |
| 145 | return if -d $f; | |
| 146 | return unless -f $f; | |
| 147 | ||
| 148 | # Ignore patterns | |
| 149 | for my $pat (keys %ignore_pats) { | |
| 150 | my $re = $ignore_pats{$pat}; | |
| 151 | if ($f =~ $re) { return; } | |
| 152 | } | |
| 153 | ||
| 154 | # File type filter | |
| 155 | if (%type_filter) { | |
| 156 | my $ext_ok = 0; | |
| 157 | for my $e (keys %type_filter) { | |
| 158 | if (lc(substr($f, -length($e))) eq $e) { $ext_ok = 1; last; } | |
| 159 | } | |
| 160 | return unless $ext_ok; | |
| 161 | } | |
| 162 | ||
| 163 | my @st = stat $f; | |
| 164 | return unless @st; | |
| 165 | return if $st[7] > $max_size; # skip huge files | |
| 166 | ||
| 167 | $seen{$f} = 1; | |
| 168 | my $mtime = $st[9]; | |
| 169 | my $prev_row = $prev{$f}; | |
| 170 | ||
| 171 | # mtime-first optimization: skip hashing if mtime hasn't advanced | |
| 172 | # (very common case for unchanged files). | |
| 173 | if ($prev_row && $prev_row->{status} ne 'deleted') { | |
| 174 | my $prev_mtime = _parse_mysql_datetime($prev_row->{date_time}); | |
| 175 | return if $prev_mtime && $prev_mtime == $mtime; | |
| 176 | } | |
| 177 | ||
| 178 | # Read + hash | |
| 179 | my $content = _slurp($f); | |
| 180 | return unless defined $content; | |
| 181 | my $sha = sha256_hex($content); | |
| 182 | ||
| 183 | # Same content as previous capture? timestamp-only change. | |
| 184 | my $is_ts_only = 0; | |
| 185 | my $status = 'added'; | |
| 186 | if ($prev_row && $prev_row->{blob_sha}) { | |
| 187 | if ($prev_row->{blob_sha} eq $sha) { | |
| 188 | $is_ts_only = 1; | |
| 189 | $status = 'modified'; # mtime touched but bytes identical | |
| 190 | } else { | |
| 191 | $status = 'modified'; | |
| 192 | } | |
| 193 | } | |
| 194 | ||
| 195 | # Content-drift guard: compare against the latest NON-DELETED | |
| 196 | # capture. If SHA matches, skip -- bytes unchanged from what we | |
| 197 | # last recorded. A real revert-to-earlier-version still lands | |
| 198 | # because that differs from the most recent SHA on record. | |
| 199 | { | |
| 200 | my $q_f_g = $dbh->quote($f); | |
| 201 | my $sid_g = int($scan->{server_id} || 0); | |
| 202 | my $last_live = $db->db_readwrite($dbh, qq~ | |
| 203 | SELECT blob_sha FROM FILE_CHANGES | |
| 204 | WHERE file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 205 | AND server_id = $sid_g | |
| 206 | AND file_name = $q_f_g | |
| 207 | AND status <> 'deleted' | |
| 208 | AND blob_sha IS NOT NULL | |
| 209 | ORDER BY file_changes_id DESC LIMIT 1 | |
| 210 | ~, __FILE__, __LINE__); | |
| 211 | return if $last_live && $last_live->{blob_sha} && $last_live->{blob_sha} eq $sha; | |
| 212 | } | |
| 213 | ||
| 214 | # Persist blob (content-addressable, dedup) | |
| 215 | _store_blob($db, $dbh, $sha, $content); | |
| 216 | ||
| 217 | # Insert change row | |
| 218 | my $q_file = $dbh->quote($f); | |
| 219 | my $q_sha = $dbh->quote($sha); | |
| 220 | my $q_stat = $dbh->quote($status); | |
| 221 | my $uid = $st[4]; my $gid = $st[5]; | |
| 222 | my $perm = sprintf('%04o', $st[2] & 07777); | |
| 223 | $db->db_readwrite($dbh, qq~ | |
| 224 | INSERT IGNORE INTO FILE_CHANGES | |
| 225 | (file_monitor_list_id, server_id, container_target_id, | |
| 226 | file_name, blob_sha, is_ts_only, is_baseline, | |
| 227 | date_time, status, | |
| 228 | uid, gid, permissions) | |
| 229 | VALUES | |
| 230 | ($scan->{file_monitor_list_id}, $scan->{server_id}, | |
| 231 | ~ . ($scan->{container_target_id} ? $scan->{container_target_id} : 'NULL') . qq~, | |
| 232 | $q_file, $q_sha, $is_ts_only, $baseline_mode, | |
| 233 | FROM_UNIXTIME($mtime), $q_stat, | |
| 234 | '$uid', '$gid', '$perm') | |
| 235 | ~, __FILE__, __LINE__); | |
| 236 | ||
| 237 | if ($is_ts_only) { $total_ts_only++; } | |
| 238 | elsif ($status eq 'added') { $total_added++; } | |
| 239 | else { $total_modified++; } | |
| 240 | }, | |
| 241 | }, $path); | |
| 242 | ||
| 243 | # ---- Delete detection ---- | |
| 244 | # Two-layer guard: (1) %prev cache says non-deleted, (2) live DB | |
| 245 | # re-check right before insert says non-deleted. Prevents repeat | |
| 246 | # "deleted" rows piling up when a file stays missing across many | |
| 247 | # scans -- one delete row per real disappearance, not one per tick. | |
| 248 | foreach my $f (keys %prev) { | |
| 249 | next if $seen{$f}; | |
| 250 | next if $prev{$f}->{status} eq 'deleted'; # already marked deleted | |
| 251 | my $q_file = $dbh->quote($f); | |
| 252 | my $sid = int($scan->{server_id} || 0); | |
| 253 | # Live re-check | |
| 254 | my $live = $db->db_readwrite($dbh, qq~ | |
| 255 | SELECT status FROM FILE_CHANGES | |
| 256 | WHERE file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 257 | AND server_id = $sid | |
| 258 | AND file_name = $q_file | |
| 259 | ORDER BY file_changes_id DESC LIMIT 1 | |
| 260 | ~, __FILE__, __LINE__); | |
| 261 | next if $live && ($live->{status} // '') eq 'deleted'; | |
| 262 | $db->db_readwrite($dbh, qq~ | |
| 263 | INSERT IGNORE INTO FILE_CHANGES | |
| 264 | (file_monitor_list_id, server_id, file_name, status, date_time) | |
| 265 | VALUES | |
| 266 | ($scan->{file_monitor_list_id}, $scan->{server_id}, | |
| 267 | $q_file, 'deleted', NOW()) | |
| 268 | ~, __FILE__, __LINE__); | |
| 269 | $total_deleted++; | |
| 270 | } | |
| 271 | ||
| 272 | # Update last_scanned stamp | |
| 273 | $db->db_readwrite($dbh, qq~ | |
| 274 | UPDATE FILE_MONITOR_SETTINGS | |
| 275 | SET last_scanned = NOW() | |
| 276 | WHERE file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 277 | ~, __FILE__, __LINE__); | |
| 278 | } | |
| 279 | ||
| 280 | $db->db_disconnect($dbh); | |
| 281 | ||
| 282 | print "[$ts] file scan complete: +$total_added added, ~$total_modified modified, " | |
| 283 | . "-$total_deleted deleted, $total_ts_only ts-only\n" | |
| 284 | if ($total_added + $total_modified + $total_deleted + $total_ts_only) > 0; | |
| 285 | ||
| 286 | exit 0; | |
| 287 | ||
| 288 | #--------------------------------------------------------------------- | |
| 289 | sub _slurp { | |
| 290 | my $path = shift; | |
| 291 | open(my $fh, '<:raw', $path) or return undef; | |
| 292 | local $/; my $c = <$fh>; close $fh; | |
| 293 | return $c; | |
| 294 | } | |
| 295 | ||
| 296 | sub _pattern_to_regex { | |
| 297 | my $pat = shift; | |
| 298 | # Simple glob-ish -> regex conversion | |
| 299 | my $re = quotemeta $pat; | |
| 300 | $re =~ s/\\\*/.*/g; | |
| 301 | $re =~ s/\\\?/./g; | |
| 302 | return qr/$re/; | |
| 303 | } | |
| 304 | ||
| 305 | sub _parse_mysql_datetime { | |
| 306 | my $dt = shift; | |
| 307 | return 0 unless $dt && $dt =~ /^(\d{4})-(\d{2})-(\d{2})[T ](\d{2}):(\d{2}):(\d{2})$/; | |
| 308 | require Time::Local; | |
| 309 | return eval { Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900) } || 0; | |
| 310 | } | |
| 311 | ||
| 312 | #--------------------------------------------------------------------- | |
| 313 | sub _store_blob { | |
| 314 | my ($db, $dbh, $sha, $content) = @_; | |
| 315 | my $existing = $db->db_readwrite($dbh, | |
| 316 | "SELECT blob_sha FROM BLOB_STORE WHERE blob_sha = " . $dbh->quote($sha) . " LIMIT 1", | |
| 317 | __FILE__, __LINE__); | |
| 318 | if ($existing && $existing->{blob_sha}) { | |
| 319 | $db->db_readwrite($dbh, | |
| 320 | "UPDATE BLOB_STORE SET ref_count = ref_count + 1 WHERE blob_sha = " . $dbh->quote($sha), | |
| 321 | __FILE__, __LINE__); | |
| 322 | return; | |
| 323 | } | |
| 324 | my $gz = compress($content) // ''; | |
| 325 | my $sth = $dbh->prepare(qq~ | |
| 326 | INSERT INTO BLOB_STORE (blob_sha, content_gz, size_uncompressed, size_compressed, ref_count, first_seen_at) | |
| 327 | VALUES (?, ?, ?, ?, 1, NOW()) | |
| 328 | ~); | |
| 329 | if ($sth) { | |
| 330 | $sth->execute($sha, $gz, length($content), length($gz)); | |
| 331 | $sth->finish; | |
| 332 | } | |
| 333 | } |