Diff -- /var/www/vhosts/3dshawn.com/site1/named_releases.cgi
Diff

/var/www/vhosts/3dshawn.com/site1/named_releases.cgi

added on local at 2026-07-12 23:13:01

Added
+240
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 2660314723c8
Restore this content →
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 -- /named_releases.cgi
4#
5# List + create named releases. Each release is a bookmark that pins
6# every blob referenced by FILE_CHANGES rows in a chosen scope. A
7# release can be portfolio-wide (scope_monitor_id NULL) or scoped to
8# a single site (scope_monitor_id set). Pinned blobs are exempt from
9# auto-purge.
10#======================================================================
11use strict;
12use warnings;
13use CGI ();
14use MODS::Config; use MODS::DBConnect; use MODS::Template; use MODS::PageWrapper;
15use MODS::Webhook;
16use JSON::PP ();
17my $cgi = CGI->new; my $db = MODS::DBConnect->new; my $tpl = MODS::Template->new;
18$|=1;
19
20my $dbh = $db->db_connect or die "DB connect failed\n";
21
22# ---- POST: create ---------------------------------------------------
23if (($ENV{REQUEST_METHOD} || '') eq 'POST' && $cgi->param('save')) {
24 my $name = $cgi->param('name') || '';
25 my $desc = $cgi->param('description') || '';
26 my $by = $cgi->param('released_by') || 'Operator';
27 my $scope_mid = int($cgi->param('scope_monitor_id') || 0);
28 my $scope_sid = int($cgi->param('scope_server_id') || 0);
29 my $dkind = $cgi->param('alert_delivery_kind') || 'none';
30 $dkind = 'none' unless $dkind =~ /^(none|generic_webhook|slack|discord)$/;
31 my $durl = $cgi->param('alert_delivery_url') || '';
32 my $tier = $cgi->param('tier') || 'draft';
33 $tier = 'draft' unless $tier =~ /^(draft|working|stable)$/;
34 my $vlabel = $cgi->param('version_label') || '';
35 my $apdays = int($cgi->param('auto_promote_stable_days') || 0);
36 $apdays = 0 if $apdays < 0 || $apdays > 365;
37 my $ann = $cgi->param('annotation') // '';
38 $ann = substr($ann, 0, 4000) if length($ann) > 4000;
39
40 if (length $name) {
41 my $q_name = $dbh->quote($name);
42 my $q_desc = $dbh->quote($desc);
43 my $q_by = $dbh->quote($by);
44 my $q_dk = $dbh->quote($dkind);
45 my $q_du = $dbh->quote($durl);
46 my $q_tier = $dbh->quote($tier);
47 my $q_vl = $dbh->quote($vlabel);
48 my $mid_expr = $scope_mid ? $scope_mid : 'NULL';
49 my $sid_expr = $scope_sid ? $scope_sid : 'NULL';
50 my $has_ap = _has_col($dbh, 'NAMED_RELEASES', 'auto_promote_stable_days');
51 my $has_ann = _has_col($dbh, 'NAMED_RELEASES', 'annotation');
52 my $q_ann = $dbh->quote($ann);
53 my $cols = "(name, description, released_at, released_by, is_locked, created_at,
54 scope_monitor_id, scope_server_id,
55 alert_delivery_kind, alert_delivery_url,
56 tier, version_label"
57 . ($has_ap ? ', auto_promote_stable_days' : '')
58 . ($has_ann ? ', annotation' : '') . ")";
59 my $vals = "($q_name, $q_desc, NOW(), $q_by, 1, NOW(),
60 $mid_expr, $sid_expr,
61 $q_dk, $q_du,
62 $q_tier, $q_vl"
63 . ($has_ap ? ", $apdays" : '')
64 . ($has_ann ? ", $q_ann" : '') . ")";
65 $db->db_readwrite($dbh, "INSERT INTO NAMED_RELEASES $cols VALUES $vals",
66 __FILE__, __LINE__);
67 # Extra scopes for cross-scope releases (Wave 5 F5): multi-select
68 # scope_monitor_ids[] additive
69 my $new_rel = $db->db_readwrite($dbh, "SELECT LAST_INSERT_ID() AS id", __FILE__, __LINE__);
70 my $rid = $new_rel && $new_rel->{id};
71 if ($rid) {
72 foreach my $extra ($cgi->param('extra_monitor_ids')) {
73 my $eid = int($extra || 0);
74 next unless $eid && $eid != $scope_mid;
75 $db->db_readwrite($dbh, qq~
76 INSERT INTO NAMED_RELEASE_SCOPES
77 (named_release_id, file_monitor_list_id)
78 VALUES ($rid, $eid)
79 ~, __FILE__, __LINE__);
80 }
81 }
82 }
83 print "Status: 302 Found\nLocation: /named_releases.cgi\n\n"; exit;
84}
85
86# ---- AJAX: test alert delivery ------------------------------------
87if ($cgi->param('op') && $cgi->param('op') eq 'test_alert') {
88 my $rid = int($cgi->param('release_id') || 0);
89 print "Content-Type: application/json\nCache-Control: no-cache\n\n";
90 my $r = $db->db_readwrite($dbh, qq~
91 SELECT name, alert_delivery_kind, alert_delivery_url
92 FROM NAMED_RELEASES WHERE named_release_id = $rid LIMIT 1
93 ~, __FILE__, __LINE__);
94 unless ($r && $r->{alert_delivery_url}) {
95 print JSON::PP::encode_json({ ok => \0, message => 'no delivery URL configured' });
96 exit;
97 }
98 my $summary = "TEST alert from DriftSense -- release '$r->{name}' -- ignore me";
99 my $body = ($r->{alert_delivery_kind} eq 'slack') ? {
100 text => "*DriftSense TEST*: $summary",
101 attachments => [{ color => '#f59e0b', text => 'This is a synthetic drift payload. No files actually drifted.' }],
102 } : ($r->{alert_delivery_kind} eq 'discord') ? {
103 content => "**DriftSense TEST**: $summary",
104 } : {
105 source => 'drift_sense', alert_type => 'test',
106 release_name => $r->{name}, summary => $summary,
107 };
108 my ($code, $rbody, $err) = MODS::Webhook::post_json(
109 $r->{alert_delivery_url}, $body,
110 timeout => 8,
111 user_agent => 'DriftSense/1.0 (test-alert)',
112 );
113 my $ok = (!$err && $code >= 200 && $code < 400) ? \1 : \0;
114 print JSON::PP::encode_json({
115 ok => $ok, http_code => $code, message => $err ? $err : "HTTP $code",
116 });
117 exit;
118}
119
120# ---- POST: promote / demote tier -----------------------------------
121if (($ENV{REQUEST_METHOD} || '') eq 'POST' && $cgi->param('promote')) {
122 my $rid = int($cgi->param('release_id') || 0);
123 my $tier = $cgi->param('to_tier') || 'stable';
124 $tier = 'draft' unless $tier =~ /^(draft|working|stable)$/;
125 my $q_tier = $dbh->quote($tier);
126 $db->db_readwrite($dbh,
127 "UPDATE NAMED_RELEASES SET tier = $q_tier WHERE named_release_id = $rid",
128 __FILE__, __LINE__);
129 print "Status: 302 Found\nLocation: /named_releases.cgi\n\n"; exit;
130}
131
132print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
133
134# ---- Existing releases + count how many blobs each pins -------------
135my $has_ap = _has_col($dbh, 'NAMED_RELEASES', 'auto_promote_stable_days');
136my $has_ann = _has_col($dbh, 'NAMED_RELEASES', 'annotation');
137my $ap_expr = $has_ap ? 'nr.auto_promote_stable_days' : '0';
138my $ann_expr = $has_ann ? 'nr.annotation' : 'NULL';
139my @rows = $db->db_readwrite_multiple($dbh, qq~
140 SELECT nr.named_release_id AS id, nr.name, nr.description, nr.tier, nr.version_label,
141 DATE_FORMAT(nr.released_at, '%b %d, %Y %H:%i') AS released_h,
142 UNIX_TIMESTAMP(nr.released_at) AS released_epoch,
143 nr.released_by, nr.is_locked,
144 nr.scope_monitor_id, nr.scope_server_id,
145 $ap_expr AS auto_promote_days,
146 $ann_expr AS annotation,
147 TIMESTAMPDIFF(DAY, nr.released_at, NOW()) AS age_days,
148 m.scan_name, s.server_name
149 FROM NAMED_RELEASES nr
150 LEFT JOIN FILE_MONITOR_SETTINGS m ON m.file_monitor_list_id = nr.scope_monitor_id
151 LEFT JOIN SERVERS s ON s.server_id = nr.scope_server_id
152 ORDER BY (nr.tier = 'stable') DESC,
153 (nr.tier = 'working') DESC,
154 nr.released_at DESC
155 LIMIT 100
156~, __FILE__, __LINE__);
157foreach my $r (@rows) {
158 $r->{lock_pill} = $r->{is_locked} ? 'pill-ok' : 'pill-mute';
159 $r->{lock_lbl} = $r->{is_locked} ? 'PROTECTED' : 'UNLOCKED';
160 $r->{released_epoch} //= 0;
161 $r->{auto_promote_days} //= 0;
162 $r->{age_days} //= 0;
163 $r->{has_auto_promote} = ($r->{auto_promote_days} > 0) ? 1 : 0;
164 $r->{ap_ready} = ($r->{has_auto_promote} && $r->{tier} eq 'working'
165 && $r->{age_days} >= $r->{auto_promote_days}) ? 1 : 0;
166 $r->{ap_days_left} = $r->{has_auto_promote}
167 ? ($r->{auto_promote_days} - $r->{age_days})
168 : 0;
169 $r->{annotation} //= '';
170 $r->{has_annotation} = length($r->{annotation}) ? 1 : 0;
171 $r->{tier} //= 'draft';
172 $r->{tier_pill} = $r->{tier} eq 'stable' ? 'pill-ok'
173 : $r->{tier} eq 'working' ? 'pill-info'
174 : 'pill-mute';
175 $r->{tier_lbl} = uc($r->{tier});
176 $r->{display_label} = $r->{version_label} || $r->{name};
177 $r->{is_stable} = $r->{tier} eq 'stable' ? 1 : 0;
178 $r->{is_draft} = $r->{tier} eq 'draft' ? 1 : 0;
179 $r->{is_working} = $r->{tier} eq 'working'? 1 : 0;
180 $r->{restore_url} = "/restore_release.cgi?release_id=$r->{id}";
181 if ($r->{scope_monitor_id}) {
182 $r->{scope_pill} = 'pill-info';
183 $r->{scope_lbl} = 'per-site';
184 $r->{scope_h} = $r->{scan_name} || "monitor #$r->{scope_monitor_id}";
185 } elsif ($r->{scope_server_id}) {
186 $r->{scope_pill} = 'pill-info';
187 $r->{scope_lbl} = 'per-server';
188 $r->{scope_h} = $r->{server_name} || "server #$r->{scope_server_id}";
189 } else {
190 $r->{scope_pill} = 'pill-mute';
191 $r->{scope_lbl} = 'portfolio';
192 $r->{scope_h} = 'All monitored sites';
193 }
194}
195
196# ---- All monitors + servers for scope picker ------------------------
197my @monitors = $db->db_readwrite_multiple($dbh, q~
198 SELECT m.file_monitor_list_id AS mid, m.scan_name, s.server_name
199 FROM FILE_MONITOR_SETTINGS m
200 LEFT JOIN SERVERS s ON s.server_id = m.server_id
201 WHERE m.status = 1
202 ORDER BY s.server_id ASC, m.file_monitor_list_id ASC
203~, __FILE__, __LINE__);
204foreach my $m (@monitors) {
205 $m->{label} = ($m->{scan_name} // '?') . ' (on ' . ($m->{server_name} // '?') . ')';
206}
207
208my $total = scalar @rows;
209$db->db_disconnect($dbh);
210
211my $tvars = {
212 rows => \@rows,
213 has_rows => $total ? 1 : 0,
214 total => $total,
215 monitors => \@monitors,
216 has_monitors=> scalar(@monitors) ? 1 : 0,
217};
218my @body = $tpl->template('named_releases.html', $tvars);
219MODS::PageWrapper->new->wrapper(
220 page_title => 'Named releases', page_key => 'named_releases',
221 body_html => join('', @body), userinfo => { display_name => 'Operator' },
222);
223
224#---------------------------------------------------------------------
225# _has_col($dbh, $table, $col) -- schema probe cached per-process
226#---------------------------------------------------------------------
227my %_COL_CACHE;
228sub _has_col {
229 my ($dbh, $table, $col) = @_;
230 my $k = "$table/$col";
231 return $_COL_CACHE{$k} if exists $_COL_CACHE{$k};
232 my $q_tab = $dbh->quote($table);
233 my $q_col = $dbh->quote($col);
234 my $r = $db->db_readwrite($dbh, qq~
235 SELECT 1 AS ok FROM INFORMATION_SCHEMA.COLUMNS
236 WHERE TABLE_SCHEMA = DATABASE()
237 AND TABLE_NAME = $q_tab AND COLUMN_NAME = $q_col
238 ~, __FILE__, __LINE__);
239 return $_COL_CACHE{$k} = ($r && $r->{ok}) ? 1 : 0;
240}
Keyboard: j next diff k previous diff g top G bottom r restore c compile-check ? help