Diff -- /var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/SiteConn.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/admin.3dshawn.com/MODS/MetaAdmin/SiteConn.pm

added on local at 2026-07-10 15:02:12

Added
+380
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 68dfbdf69eec
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
1package MODS::MetaAdmin::SiteConn;
2#======================================================================
3# Meta-Admin -- READ-ONLY adapter for the other portfolio sites' DBs.
4#
5# RULES (enforced by convention -- do NOT relax):
6# * Every method here takes a slug or id and reads from
7# site_connections to get the connection details.
8# * Decrypted password lives only in this process's memory for the
9# life of the query. Never logged, never returned to the browser.
10# * Only SELECT queries. The DBI handle is opened with PrintWarn=0
11# and we never call do() / prepare() with anything except SELECT.
12# * On any failure we return undef + stash the error on $self;
13# callers degrade gracefully (a missing site never breaks the page).
14#
15# Public API:
16# list_sites() -> arrayref of every active site row
17# row_for_slug($slug) -> single row hashref
18# query_one($slug, $sql) -> hashref of first row, or undef
19# query_many($slug, $sql) -> arrayref of hashrefs
20# test_connection($slug) -> (1, undef) | (0, $err)
21#======================================================================
22use strict;
23use warnings;
24use DBI;
25
26use MODS::DBConnect;
27use MODS::MetaAdmin::Config;
28
29my $cfg = MODS::MetaAdmin::Config->new;
30
31sub new {
32 my ($class) = @_;
33 return bless({ err => '' }, $class);
34}
35
36sub last_error { return $_[0]->{err} || ''; }
37
38#---------------------------------------------------------------------
39# list_sites -- all active rows, sorted, brand_color + display_name +
40# vhost_path included for UI use. NOT the password.
41#---------------------------------------------------------------------
42sub list_sites {
43 my ($self, %a) = @_;
44 my $only_active = exists $a{active} ? $a{active} : 1;
45 my $where = $only_active ? 'WHERE is_active=1' : '';
46
47 my $db = MODS::DBConnect->new;
48 my $dbh = $db->db_connect;
49 return [] unless $dbh;
50 my @rows = $db->db_readwrite_multiple($dbh, qq~
51 SELECT id, slug, display_name, display_url, brand_color,
52 db_host, db_port, db_name, db_user, vhost_path,
53 is_active, last_test_at, last_test_result, sort_order
54 FROM site_connections
55 $where
56 ORDER BY sort_order, id
57 ~, __FILE__, __LINE__);
58 $db->db_disconnect($dbh);
59 return \@rows;
60}
61
62#---------------------------------------------------------------------
63# Internal: pull a single site_connections row + decrypt the password
64# in the same query via AES_DECRYPT. Returns hashref with cleartext
65# pass OR undef if the site is unknown / inactive / pass not set.
66#---------------------------------------------------------------------
67sub _conn_row {
68 my ($self, $slug) = @_;
69 return undef unless $slug;
70 my $slug_q = $slug; $slug_q =~ s/'/''/g;
71 my $key = $cfg->settings('site_conn_enc_key') || '';
72 my $key_q = $key; $key_q =~ s/'/''/g;
73
74 my $db = MODS::DBConnect->new;
75 my $dbh = $db->db_connect;
76 return undef unless $dbh;
77 my $r = $db->db_readwrite($dbh, qq~
78 SELECT id, slug, display_name, db_host, db_port, db_name, db_user,
79 CAST(AES_DECRYPT(db_pass_enc, '$key_q') AS CHAR) AS db_pass,
80 is_active
81 FROM site_connections
82 WHERE slug='$slug_q' AND is_active=1
83 LIMIT 1
84 ~, __FILE__, __LINE__);
85 $db->db_disconnect($dbh);
86 return $r;
87}
88
89sub row_for_slug {
90 my ($self, $slug) = @_;
91 return $self->_conn_row($slug);
92}
93
94#---------------------------------------------------------------------
95# Internal: open a DBI handle against the remote site. AutoCommit on,
96# RaiseError off (we want to fail soft).
97#---------------------------------------------------------------------
98sub _open {
99 my ($self, $slug) = @_;
100 my $row = $self->_conn_row($slug);
101 unless ($row && $row->{db_name}) {
102 $self->{err} = "site '$slug' not configured / inactive";
103 return undef;
104 }
105 my $host = $row->{db_host} || 'localhost';
106 my $port = $row->{db_port} || 3306;
107 my $name = $row->{db_name};
108 my $user = $row->{db_user};
109 my $pass = $row->{db_pass} || '';
110
111 my $dsn = "DBI:mysql:database=$name;host=$host;port=$port";
112 my $dbh = eval { DBI->connect($dsn, $user, $pass, {
113 PrintError => 0, RaiseError => 0, AutoCommit => 1, mysql_connect_timeout => 5
114 }) };
115 unless ($dbh) {
116 $self->{err} = "connect failed: " . ($DBI::errstr || $@ || 'unknown');
117 return undef;
118 }
119 return $dbh;
120}
121
122#---------------------------------------------------------------------
123# Read-only enforcement at the call layer: refuse anything that
124# isn't a SELECT or SHOW. Keeps an accidental UPDATE from sneaking
125# through.
126#---------------------------------------------------------------------
127sub _is_safe_sql {
128 my ($sql) = @_;
129 return 0 unless defined $sql;
130 my $stripped = $sql;
131 $stripped =~ s/^\s+//;
132 return ($stripped =~ /^(SELECT|SHOW|DESC|EXPLAIN)\b/i) ? 1 : 0;
133}
134
135sub query_one {
136 my ($self, $slug, $sql) = @_;
137 $self->{err} = '';
138 unless (_is_safe_sql($sql)) {
139 $self->{err} = 'read-only adapter refuses non-SELECT'; return undef;
140 }
141 my $dbh = $self->_open($slug);
142 return undef unless $dbh;
143 my $sth = $dbh->prepare($sql);
144 unless ($sth && $sth->execute) {
145 $self->{err} = $dbh->errstr || 'execute failed';
146 $dbh->disconnect;
147 return undef;
148 }
149 my $r = $sth->fetchrow_hashref;
150 $sth->finish; # release cursor so ->disconnect is clean
151 $dbh->disconnect;
152 return $r;
153}
154
155sub query_many {
156 my ($self, $slug, $sql) = @_;
157 $self->{err} = '';
158 unless (_is_safe_sql($sql)) {
159 $self->{err} = 'read-only adapter refuses non-SELECT'; return [];
160 }
161 my $dbh = $self->_open($slug);
162 return [] unless $dbh;
163 my $sth = $dbh->prepare($sql);
164 unless ($sth && $sth->execute) {
165 $self->{err} = $dbh->errstr || 'execute failed';
166 $dbh->disconnect;
167 return [];
168 }
169 my @out;
170 while (my $r = $sth->fetchrow_hashref) { push @out, $r; }
171 $sth->finish; # belt+suspenders (while-loop exhaustion should already finish it)
172 $dbh->disconnect;
173 return \@out;
174}
175
176#---------------------------------------------------------------------
177# test_connection -- runs SELECT 1 and stamps last_test_at /
178# last_test_result on the site_connections row.
179#---------------------------------------------------------------------
180sub test_connection {
181 my ($self, $slug) = @_;
182 $self->{err} = '';
183 my $r = $self->query_one($slug, 'SELECT 1 AS ok');
184 my $ok = ($r && $r->{ok}) ? 1 : 0;
185 my $msg = $ok ? 'ok' : ($self->{err} || 'failed');
186
187 # Stamp result on local site_connections row.
188 my $db = MODS::DBConnect->new;
189 my $dbh = $db->db_connect;
190 if ($dbh) {
191 my $slug_q = $slug; $slug_q =~ s/'/''/g;
192 my $msg_q = substr($msg, 0, 250); $msg_q =~ s/'/''/g;
193 $db->db_readwrite($dbh, qq~
194 UPDATE site_connections
195 SET last_test_at=NOW(), last_test_result='$msg_q'
196 WHERE slug='$slug_q'
197 ~, __FILE__, __LINE__);
198 $db->db_disconnect($dbh);
199 }
200 return ($ok, $ok ? undef : $msg);
201}
202
203#---------------------------------------------------------------------
204# Helper for UPSERTing a row in local site_connections. Encrypts the
205# password via AES_ENCRYPT(plain, $key). Blank pass keeps the
206# existing one (so admin can edit a row without retyping).
207#---------------------------------------------------------------------
208sub upsert {
209 my ($self, %a) = @_;
210 my $id = ($a{id} || 0) + 0;
211 my $slug = $a{slug} || '';
212 my $display_name= $a{display_name}|| $slug;
213 my $display_url = $a{display_url} || '';
214 my $brand_color = $a{brand_color} || '#00f0ff';
215 my $db_host = $a{db_host} || 'localhost';
216 my $db_port = ($a{db_port} || 3306) + 0;
217 my $db_name = $a{db_name} || '';
218 my $db_user = $a{db_user} || '';
219 my $db_pass = defined $a{db_pass} ? $a{db_pass} : '';
220 my $vhost_path = $a{vhost_path} || '';
221 my $is_active = $a{is_active} ? 1 : 0;
222 my $sort_order = ($a{sort_order} || 100) + 0;
223 return (0, 'slug required') unless length $slug;
224 return (0, 'db_name required') unless length $db_name;
225 return (0, 'db_user required') unless length $db_user;
226
227 my $key = $cfg->settings('site_conn_enc_key') || '';
228 my $q = sub { my $v = shift; $v //= ''; $v =~ s/'/''/g; return $v; };
229
230 my $key_q = $q->($key);
231 my $pass_sql;
232 if (length $db_pass) {
233 my $p_q = $q->($db_pass);
234 $pass_sql = "AES_ENCRYPT('$p_q','$key_q')";
235 } else {
236 $pass_sql = undef; # keep existing
237 }
238
239 my $db = MODS::DBConnect->new;
240 my $dbh = $db->db_connect;
241 return (0, 'local db unavailable') unless $dbh;
242
243 my @sets = (
244 "slug='" . $q->($slug) . "'",
245 "display_name='" . $q->($display_name) . "'",
246 "display_url='" . $q->($display_url) . "'",
247 "brand_color='" . $q->($brand_color) . "'",
248 "db_host='" . $q->($db_host) . "'",
249 "db_port='$db_port'",
250 "db_name='" . $q->($db_name) . "'",
251 "db_user='" . $q->($db_user) . "'",
252 "vhost_path='" . $q->($vhost_path) . "'",
253 "is_active='$is_active'",
254 "sort_order='$sort_order'",
255 );
256 push @sets, "db_pass_enc=$pass_sql" if defined $pass_sql;
257 my $set_sql = join(",\n ", @sets);
258
259 if ($id) {
260 $db->db_readwrite($dbh, qq~
261 UPDATE site_connections SET $set_sql WHERE id='$id'
262 ~, __FILE__, __LINE__);
263 } else {
264 # On insert, password is REQUIRED -- otherwise we'd have a
265 # half-configured row.
266 unless (defined $pass_sql) {
267 $db->db_disconnect($dbh);
268 return (0, 'password required on new sites');
269 }
270 $db->db_readwrite($dbh, qq~
271 INSERT INTO site_connections SET $set_sql
272 ~, __FILE__, __LINE__);
273 my $r = $db->db_readwrite($dbh, q~SELECT LAST_INSERT_ID() AS n~, __FILE__, __LINE__);
274 $id = ($r && $r->{n}) ? $r->{n} : 0;
275 }
276 $db->db_disconnect($dbh);
277 return ($id, undef);
278}
279
280#---------------------------------------------------------------------
281# set_session_override / clear_session_override -- tightly scoped
282# write carve-out. Only ever touches users.session_minutes_override.
283# Everything else is still read-only.
284#---------------------------------------------------------------------
285sub set_session_override {
286 my ($self, $slug, $user_id, $minutes) = @_;
287 $self->{err} = '';
288 $user_id = int($user_id || 0); return 0 unless $user_id > 0;
289 $minutes = int($minutes || 0); return 0 unless $minutes > 0 && $minutes <= 525600 * 5; # cap 5y
290 my $dbh = $self->_open($slug);
291 return 0 unless $dbh;
292 my $sth = $dbh->prepare('UPDATE users SET session_minutes_override=? WHERE id=?');
293 my $ok = $sth && $sth->execute($minutes, $user_id);
294 $self->{err} = $dbh->errstr if !$ok;
295 $dbh->disconnect;
296 return $ok ? 1 : 0;
297}
298
299sub clear_session_override {
300 my ($self, $slug, $user_id) = @_;
301 $self->{err} = '';
302 $user_id = int($user_id || 0); return 0 unless $user_id > 0;
303 my $dbh = $self->_open($slug);
304 return 0 unless $dbh;
305 my $sth = $dbh->prepare('UPDATE users SET session_minutes_override=NULL WHERE id=?');
306 my $ok = $sth && $sth->execute($user_id);
307 $self->{err} = $dbh->errstr if !$ok;
308 $dbh->disconnect;
309 return $ok ? 1 : 0;
310}
311
312#---------------------------------------------------------------------
313# Maintenance lockdown carve-out (per-site write).
314# Two tight, fixed UPDATEs against platform_settings only -- everything
315# else stays read-only.
316#---------------------------------------------------------------------
317sub set_maintenance_locked {
318 my ($self, $slug, $value) = @_;
319 $self->{err} = '';
320 $value = $value ? 1 : 0;
321 my $dbh = $self->_open($slug);
322 return 0 unless $dbh;
323 # Upsert via prepared statement
324 my $sth = $dbh->prepare(q{
325 INSERT INTO platform_settings (setting_key, setting_value)
326 VALUES ('maintenance_locked', ?)
327 ON DUPLICATE KEY UPDATE setting_value = VALUES(setting_value)
328 });
329 my $ok = $sth && $sth->execute($value);
330 $self->{err} = $dbh->errstr if !$ok;
331 $dbh->disconnect;
332 return $ok ? 1 : 0;
333}
334
335sub get_maintenance_status {
336 my ($self, $slug) = @_;
337 $self->{err} = '';
338 my $dbh = $self->_open($slug);
339 return undef unless $dbh;
340 my $sth = $dbh->prepare(q{
341 SELECT setting_value FROM platform_settings WHERE setting_key='maintenance_locked' LIMIT 1
342 });
343 my $locked = 0;
344 if ($sth && $sth->execute) {
345 my $row = $sth->fetchrow_hashref;
346 $locked = ($row && int($row->{setting_value})) ? 1 : 0;
347 }
348 $dbh->disconnect;
349 return $locked;
350}
351
352sub deactivate {
353 my ($self, $id) = @_;
354 $id =~ s/[^0-9]//g if defined $id;
355 return 0 unless $id;
356 my $db = MODS::DBConnect->new;
357 my $dbh = $db->db_connect;
358 return 0 unless $dbh;
359 $db->db_readwrite($dbh, qq~
360 UPDATE site_connections SET is_active=0 WHERE id='$id'
361 ~, __FILE__, __LINE__);
362 $db->db_disconnect($dbh);
363 return 1;
364}
365
366sub reactivate {
367 my ($self, $id) = @_;
368 $id =~ s/[^0-9]//g if defined $id;
369 return 0 unless $id;
370 my $db = MODS::DBConnect->new;
371 my $dbh = $db->db_connect;
372 return 0 unless $dbh;
373 $db->db_readwrite($dbh, qq~
374 UPDATE site_connections SET is_active=1 WHERE id='$id'
375 ~, __FILE__, __LINE__);
376 $db->db_disconnect($dbh);
377 return 1;
378}
379
3801;