added on local at 2026-07-12 22:38:31
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # DriftSense -- /portfolio_drift.cgi | |
| 4 | # | |
| 5 | # Cross-site drift comparison. Finds files (by basename) that changed | |
| 6 | # in more than one monitored site in the same day -- catches accidental | |
| 7 | # cross-portfolio propagation, and lets you eyeball intentional | |
| 8 | # broadcasts to confirm every site received them. | |
| 9 | # | |
| 10 | # Grouping is by basename (LOWERCASED, extension-preserved). This is | |
| 11 | # looser than "same full path" but tighter than "any file with the | |
| 12 | # same name" because we key on the file's leaf which is the useful | |
| 13 | # unit for portfolio comparison. | |
| 14 | #====================================================================== | |
| 15 | use strict; | |
| 16 | use warnings; | |
| 17 | use CGI (); | |
| 18 | use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper; | |
| 19 | use MODS::RangePicker; | |
| 20 | ||
| 21 | my $cgi = CGI->new; my $db = MODS::DBConnect->new; my $tpl = MODS::Template->new; | |
| 22 | $|=1; print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 23 | ||
| 24 | my $dbh = $db->db_connect or die "DB connect failed\n"; | |
| 25 | ||
| 26 | # Default range 24h; RangePicker handles 24h/7d/30d/90d/1y/custom | |
| 27 | my $r = MODS::RangePicker::parse($cgi); | |
| 28 | my $where = $r->{sql_where}->('fc.date_time'); | |
| 29 | ||
| 30 | # Pull each change with its basename computed in SQL. We SUBSTRING_INDEX | |
| 31 | # on '/' but the result is the last path segment. | |
| 32 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 33 | SELECT LOWER(SUBSTRING_INDEX(fc.file_name, '/', -1)) AS basename, | |
| 34 | fc.file_name, | |
| 35 | fc.file_monitor_list_id AS mid, | |
| 36 | m.scan_name, | |
| 37 | fc.server_id, | |
| 38 | s.server_name, | |
| 39 | fc.blob_sha, | |
| 40 | fc.status, | |
| 41 | UNIX_TIMESTAMP(fc.date_time) AS ts_epoch, | |
| 42 | fc.file_changes_id AS id, | |
| 43 | DATE(fc.date_time) AS d | |
| 44 | FROM FILE_CHANGES fc | |
| 45 | LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = fc.file_monitor_list_id | |
| 46 | LEFT JOIN SERVERS s ON s.server_id = fc.server_id | |
| 47 | WHERE $where | |
| 48 | AND fc.blob_sha IS NOT NULL | |
| 49 | AND fc.file_name IS NOT NULL | |
| 50 | AND fc.file_name != '' | |
| 51 | ORDER BY basename ASC, fc.date_time DESC | |
| 52 | LIMIT 5000 | |
| 53 | ~, __FILE__, __LINE__); | |
| 54 | ||
| 55 | # Group by basename; only keep groups touching 2+ distinct sites. | |
| 56 | my %groups; | |
| 57 | foreach my $row (@rows) { | |
| 58 | push @{$groups{$row->{basename}}}, $row; | |
| 59 | } | |
| 60 | ||
| 61 | my @cross; | |
| 62 | foreach my $bn (sort keys %groups) { | |
| 63 | my $g = $groups{$bn}; | |
| 64 | my %distinct_mid; | |
| 65 | my %by_mid; | |
| 66 | foreach my $r (@$g) { | |
| 67 | $distinct_mid{$r->{mid}}++; | |
| 68 | # First (most recent) row per monitor wins | |
| 69 | $by_mid{$r->{mid}} //= $r; | |
| 70 | } | |
| 71 | next unless scalar(keys %distinct_mid) >= 2; | |
| 72 | ||
| 73 | # Grade: same blob = intentional broadcast; different blobs = drift | |
| 74 | my %distinct_sha; | |
| 75 | foreach my $r (values %by_mid) { | |
| 76 | $distinct_sha{$r->{blob_sha}}++ if $r->{blob_sha}; | |
| 77 | } | |
| 78 | my $status = | |
| 79 | scalar(keys %distinct_sha) == 1 ? 'synchronized' : | |
| 80 | scalar(keys %distinct_sha) > 1 ? 'divergent' : 'unknown'; | |
| 81 | ||
| 82 | my @per_site; | |
| 83 | foreach my $mid (sort { $by_mid{$b}->{ts_epoch} <=> $by_mid{$a}->{ts_epoch} } keys %by_mid) { | |
| 84 | my $r = $by_mid{$mid}; | |
| 85 | push @per_site, { | |
| 86 | mid => $mid, | |
| 87 | scan_name => $r->{scan_name} // '?', | |
| 88 | server_name => $r->{server_name} // '?', | |
| 89 | blob_short => $r->{blob_sha} ? substr($r->{blob_sha}, 0, 8) : '-', | |
| 90 | blob_full => $r->{blob_sha} // '', | |
| 91 | status => $r->{status} // 'unknown', | |
| 92 | status_pill => ( | |
| 93 | ($r->{status}//'') eq 'added' ? 'pill-ok' : | |
| 94 | ($r->{status}//'') eq 'modified' ? 'pill-warn' : | |
| 95 | ($r->{status}//'') eq 'deleted' ? 'pill-bad' : 'pill-mute' | |
| 96 | ), | |
| 97 | ts_epoch => $r->{ts_epoch} // 0, | |
| 98 | file_url => "/diff.cgi?kind=file&id=$r->{id}", | |
| 99 | full_path => $r->{file_name}, | |
| 100 | full_path_h => length($r->{file_name}) > 60 ? '...' . substr($r->{file_name}, -57) : $r->{file_name}, | |
| 101 | }; | |
| 102 | } | |
| 103 | ||
| 104 | push @cross, { | |
| 105 | basename => $bn, | |
| 106 | site_count => scalar(keys %distinct_mid), | |
| 107 | distinct_blobs => scalar(keys %distinct_sha), | |
| 108 | status_label => $status, | |
| 109 | status_pill => ( | |
| 110 | $status eq 'synchronized' ? 'pill-ok' : | |
| 111 | $status eq 'divergent' ? 'pill-warn' : 'pill-mute' | |
| 112 | ), | |
| 113 | per_site => \@per_site, | |
| 114 | latest_epoch => (sort { $b <=> $a } map { $_->{ts_epoch} } @per_site)[0] // 0, | |
| 115 | }; | |
| 116 | } | |
| 117 | ||
| 118 | # Sort: divergent first (needs attention), then synchronized, both by recency | |
| 119 | @cross = sort { | |
| 120 | ($a->{status_label} eq 'divergent' ? 0 : 1) <=> ($b->{status_label} eq 'divergent' ? 0 : 1) | |
| 121 | || $b->{latest_epoch} <=> $a->{latest_epoch} | |
| 122 | } @cross; | |
| 123 | ||
| 124 | my $divergent_count = scalar(grep { $_->{status_label} eq 'divergent' } @cross); | |
| 125 | my $sync_count = scalar(grep { $_->{status_label} eq 'synchronized' } @cross); | |
| 126 | ||
| 127 | $db->db_disconnect($dbh); | |
| 128 | ||
| 129 | my $picker_html = MODS::RangePicker::picker_html( | |
| 130 | action => '/portfolio_drift.cgi', | |
| 131 | range => $r, | |
| 132 | hidden => {}, | |
| 133 | ); | |
| 134 | ||
| 135 | my $tvars = { | |
| 136 | groups => \@cross, | |
| 137 | has_groups => scalar(@cross) ? 1 : 0, | |
| 138 | group_count => scalar(@cross), | |
| 139 | divergent_count => $divergent_count, | |
| 140 | sync_count => $sync_count, | |
| 141 | picker_html => $picker_html, | |
| 142 | range_label => $r->{range_label}, | |
| 143 | }; | |
| 144 | my @body = $tpl->template('portfolio_drift.html', $tvars); | |
| 145 | MODS::PageWrapper->new->wrapper( | |
| 146 | page_title => 'Portfolio drift', page_key => 'portfolio_drift', | |
| 147 | body_html => join('', @body), userinfo => { display_name => 'Operator' }, | |
| 148 | ); |