Diff -- /var/www/vhosts/3dshawn.com/site1/_file_scan.pl
Diff
/var/www/vhosts/3dshawn.com/site1/_file_scan.pl
added on local at 2026-07-10 22:19:09
Added
+268
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 2b862b37ab7e
to 2b862b37ab7e
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 -- 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 Digest::SHA qw(sha256_hex); | |
| 28 | use Compress::Zlib qw(compress); | |
| 29 | use File::Find (); | |
| 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 | # ---- Config: global max-file-size default ---- | |
| 41 | my $default_max_size = int($cfg->settings('max_file_size_bytes') || 10_485_760); | |
| 42 | ||
| 43 | # ---- Fetch active file monitors ---- | |
| 44 | my @scans = $db->db_readwrite_multiple($dbh, q~ | |
| 45 | SELECT file_monitor_list_id, scan_path, ignore_list, file_type_filter, | |
| 46 | max_file_size_bytes, server_id, container_target_id, scan_name | |
| 47 | FROM FILE_MONITOR_SETTINGS | |
| 48 | WHERE status = 1 | |
| 49 | ~, __FILE__, __LINE__); | |
| 50 | ||
| 51 | unless (@scans) { | |
| 52 | print "[$ts] no active file monitors, exiting\n"; | |
| 53 | exit 0; | |
| 54 | } | |
| 55 | ||
| 56 | my $total_added = 0; | |
| 57 | my $total_modified = 0; | |
| 58 | my $total_deleted = 0; | |
| 59 | my $total_ts_only = 0; | |
| 60 | ||
| 61 | foreach my $scan (@scans) { | |
| 62 | my $path = $scan->{scan_path} or next; | |
| 63 | unless (-d $path) { | |
| 64 | print "[$ts] scan #$scan->{file_monitor_list_id} '$scan->{scan_name}': path missing ($path)\n"; | |
| 65 | next; | |
| 66 | } | |
| 67 | ||
| 68 | my %ignore_pats; | |
| 69 | if ($scan->{ignore_list}) { | |
| 70 | for my $ig (split /[,\n]+/, $scan->{ignore_list}) { | |
| 71 | $ig =~ s/^\s+|\s+$//g; | |
| 72 | $ignore_pats{$ig} = _pattern_to_regex($ig) if length $ig; | |
| 73 | } | |
| 74 | } | |
| 75 | ||
| 76 | my %type_filter; | |
| 77 | if ($scan->{file_type_filter} && length $scan->{file_type_filter}) { | |
| 78 | for my $ext (split /,/, $scan->{file_type_filter}) { | |
| 79 | $ext =~ s/^\s+|\s+$//g; | |
| 80 | $ext = ".$ext" unless $ext =~ /^\./; | |
| 81 | $type_filter{lc $ext} = 1; | |
| 82 | } | |
| 83 | } | |
| 84 | ||
| 85 | my $max_size = $scan->{max_file_size_bytes} || $default_max_size; | |
| 86 | ||
| 87 | # ---- Snapshot of what we captured in the previous tick, keyed by | |
| 88 | # file_name, for delete-detection + mtime-baseline lookup. | |
| 89 | my $prev_sth = $dbh->prepare(qq~ | |
| 90 | SELECT fc.file_name, fc.blob_sha, fc.status, fc.date_time | |
| 91 | FROM FILE_CHANGES fc | |
| 92 | WHERE fc.file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 93 | AND fc.file_changes_id IN ( | |
| 94 | SELECT MAX(inner_fc.file_changes_id) | |
| 95 | FROM FILE_CHANGES inner_fc | |
| 96 | WHERE inner_fc.file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 97 | GROUP BY inner_fc.file_name | |
| 98 | ) | |
| 99 | ~); | |
| 100 | my %prev; | |
| 101 | if ($prev_sth && $prev_sth->execute) { | |
| 102 | while (my $r = $prev_sth->fetchrow_hashref) { | |
| 103 | $prev{$r->{file_name}} = $r; | |
| 104 | } | |
| 105 | $prev_sth->finish; | |
| 106 | } | |
| 107 | ||
| 108 | # ---- Walk + capture ---- | |
| 109 | my %seen; | |
| 110 | File::Find::find({ | |
| 111 | no_chdir => 1, | |
| 112 | wanted => sub { | |
| 113 | my $f = $File::Find::name; | |
| 114 | return if -d $f; | |
| 115 | return unless -f $f; | |
| 116 | ||
| 117 | # Ignore patterns | |
| 118 | for my $pat (keys %ignore_pats) { | |
| 119 | my $re = $ignore_pats{$pat}; | |
| 120 | if ($f =~ $re) { return; } | |
| 121 | } | |
| 122 | ||
| 123 | # File type filter | |
| 124 | if (%type_filter) { | |
| 125 | my $ext_ok = 0; | |
| 126 | for my $e (keys %type_filter) { | |
| 127 | if (lc(substr($f, -length($e))) eq $e) { $ext_ok = 1; last; } | |
| 128 | } | |
| 129 | return unless $ext_ok; | |
| 130 | } | |
| 131 | ||
| 132 | my @st = stat $f; | |
| 133 | return unless @st; | |
| 134 | return if $st[7] > $max_size; # skip huge files | |
| 135 | ||
| 136 | $seen{$f} = 1; | |
| 137 | my $mtime = $st[9]; | |
| 138 | my $prev_row = $prev{$f}; | |
| 139 | ||
| 140 | # mtime-first optimization: skip hashing if mtime hasn't advanced | |
| 141 | # (very common case for unchanged files). | |
| 142 | if ($prev_row && $prev_row->{status} ne 'deleted') { | |
| 143 | my $prev_mtime = _parse_mysql_datetime($prev_row->{date_time}); | |
| 144 | return if $prev_mtime && $prev_mtime == $mtime; | |
| 145 | } | |
| 146 | ||
| 147 | # Read + hash | |
| 148 | my $content = _slurp($f); | |
| 149 | return unless defined $content; | |
| 150 | my $sha = sha256_hex($content); | |
| 151 | ||
| 152 | # Same content as previous capture? timestamp-only change. | |
| 153 | my $is_ts_only = 0; | |
| 154 | my $status = 'added'; | |
| 155 | if ($prev_row && $prev_row->{blob_sha}) { | |
| 156 | if ($prev_row->{blob_sha} eq $sha) { | |
| 157 | $is_ts_only = 1; | |
| 158 | $status = 'modified'; # mtime touched but bytes identical | |
| 159 | } else { | |
| 160 | $status = 'modified'; | |
| 161 | } | |
| 162 | } | |
| 163 | ||
| 164 | # Persist blob (content-addressable, dedup) | |
| 165 | _store_blob($db, $dbh, $sha, $content); | |
| 166 | ||
| 167 | # Insert change row | |
| 168 | my $q_file = $dbh->quote($f); | |
| 169 | my $q_sha = $dbh->quote($sha); | |
| 170 | my $q_stat = $dbh->quote($status); | |
| 171 | my $uid = $st[4]; my $gid = $st[5]; | |
| 172 | my $perm = sprintf('%04o', $st[2] & 07777); | |
| 173 | $db->db_readwrite($dbh, qq~ | |
| 174 | INSERT INTO FILE_CHANGES | |
| 175 | (file_monitor_list_id, server_id, container_target_id, | |
| 176 | file_name, blob_sha, is_ts_only, date_time, status, | |
| 177 | uid, gid, permissions) | |
| 178 | VALUES | |
| 179 | ($scan->{file_monitor_list_id}, $scan->{server_id}, | |
| 180 | ~ . ($scan->{container_target_id} ? $scan->{container_target_id} : 'NULL') . qq~, | |
| 181 | $q_file, $q_sha, $is_ts_only, | |
| 182 | FROM_UNIXTIME($mtime), $q_stat, | |
| 183 | '$uid', '$gid', '$perm') | |
| 184 | ~, __FILE__, __LINE__); | |
| 185 | ||
| 186 | if ($is_ts_only) { $total_ts_only++; } | |
| 187 | elsif ($status eq 'added') { $total_added++; } | |
| 188 | else { $total_modified++; } | |
| 189 | }, | |
| 190 | }, $path); | |
| 191 | ||
| 192 | # ---- Delete detection ---- | |
| 193 | foreach my $f (keys %prev) { | |
| 194 | next if $seen{$f}; | |
| 195 | next if $prev{$f}->{status} eq 'deleted'; # already marked deleted | |
| 196 | my $q_file = $dbh->quote($f); | |
| 197 | $db->db_readwrite($dbh, qq~ | |
| 198 | INSERT INTO FILE_CHANGES | |
| 199 | (file_monitor_list_id, server_id, file_name, status, date_time) | |
| 200 | VALUES | |
| 201 | ($scan->{file_monitor_list_id}, $scan->{server_id}, | |
| 202 | $q_file, 'deleted', NOW()) | |
| 203 | ~, __FILE__, __LINE__); | |
| 204 | $total_deleted++; | |
| 205 | } | |
| 206 | ||
| 207 | # Update last_scanned stamp | |
| 208 | $db->db_readwrite($dbh, qq~ | |
| 209 | UPDATE FILE_MONITOR_SETTINGS | |
| 210 | SET last_scanned = NOW() | |
| 211 | WHERE file_monitor_list_id = $scan->{file_monitor_list_id} | |
| 212 | ~, __FILE__, __LINE__); | |
| 213 | } | |
| 214 | ||
| 215 | $db->db_disconnect($dbh); | |
| 216 | ||
| 217 | print "[$ts] file scan complete: +$total_added added, ~$total_modified modified, " | |
| 218 | . "-$total_deleted deleted, $total_ts_only ts-only\n" | |
| 219 | if ($total_added + $total_modified + $total_deleted + $total_ts_only) > 0; | |
| 220 | ||
| 221 | exit 0; | |
| 222 | ||
| 223 | #--------------------------------------------------------------------- | |
| 224 | sub _slurp { | |
| 225 | my $path = shift; | |
| 226 | open(my $fh, '<:raw', $path) or return undef; | |
| 227 | local $/; my $c = <$fh>; close $fh; | |
| 228 | return $c; | |
| 229 | } | |
| 230 | ||
| 231 | sub _pattern_to_regex { | |
| 232 | my $pat = shift; | |
| 233 | # Simple glob-ish -> regex conversion | |
| 234 | my $re = quotemeta $pat; | |
| 235 | $re =~ s/\\\*/.*/g; | |
| 236 | $re =~ s/\\\?/./g; | |
| 237 | return qr/$re/; | |
| 238 | } | |
| 239 | ||
| 240 | sub _parse_mysql_datetime { | |
| 241 | my $dt = shift; | |
| 242 | return 0 unless $dt && $dt =~ /^(\d{4})-(\d{2})-(\d{2})[T ](\d{2}):(\d{2}):(\d{2})$/; | |
| 243 | require Time::Local; | |
| 244 | return eval { Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900) } || 0; | |
| 245 | } | |
| 246 | ||
| 247 | #--------------------------------------------------------------------- | |
| 248 | sub _store_blob { | |
| 249 | my ($db, $dbh, $sha, $content) = @_; | |
| 250 | my $existing = $db->db_readwrite($dbh, | |
| 251 | "SELECT blob_sha FROM BLOB_STORE WHERE blob_sha = " . $dbh->quote($sha) . " LIMIT 1", | |
| 252 | __FILE__, __LINE__); | |
| 253 | if ($existing && $existing->{blob_sha}) { | |
| 254 | $db->db_readwrite($dbh, | |
| 255 | "UPDATE BLOB_STORE SET ref_count = ref_count + 1 WHERE blob_sha = " . $dbh->quote($sha), | |
| 256 | __FILE__, __LINE__); | |
| 257 | return; | |
| 258 | } | |
| 259 | my $gz = compress($content) // ''; | |
| 260 | my $sth = $dbh->prepare(qq~ | |
| 261 | INSERT INTO BLOB_STORE (blob_sha, content_gz, size_uncompressed, size_compressed, ref_count, first_seen_at) | |
| 262 | VALUES (?, ?, ?, ?, 1, NOW()) | |
| 263 | ~); | |
| 264 | if ($sth) { | |
| 265 | $sth->execute($sha, $gz, length($content), length($gz)); | |
| 266 | $sth->finish; | |
| 267 | } | |
| 268 | } |