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
+0
lines
Removed
-0
lines
Context
380
unchanged
Blobs
from 68dfbdf69eec
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.
11package MODS::MetaAdmin::SiteConn;
22#======================================================================
33# Meta-Admin -- READ-ONLY adapter for the other portfolio sites' DBs.
44#
55# RULES (enforced by convention -- do NOT relax):
66# * Every method here takes a slug or id and reads from
77# site_connections to get the connection details.
88# * Decrypted password lives only in this process's memory for the
99# life of the query. Never logged, never returned to the browser.
1010# * Only SELECT queries. The DBI handle is opened with PrintWarn=0
1111# and we never call do() / prepare() with anything except SELECT.
1212# * On any failure we return undef + stash the error on $self;
1313# callers degrade gracefully (a missing site never breaks the page).
1414#
1515# Public API:
1616# list_sites() -> arrayref of every active site row
1717# row_for_slug($slug) -> single row hashref
1818# query_one($slug, $sql) -> hashref of first row, or undef
1919# query_many($slug, $sql) -> arrayref of hashrefs
2020# test_connection($slug) -> (1, undef) | (0, $err)
2121#======================================================================
2222use strict;
2323use warnings;
2424use DBI;
2525
2626use MODS::DBConnect;
2727use MODS::MetaAdmin::Config;
2828
2929my $cfg = MODS::MetaAdmin::Config->new;
3030
3131sub new {
3232 my ($class) = @_;
3333 return bless({ err => '' }, $class);
3434}
3535
3636sub last_error { return $_[0]->{err} || ''; }
3737
3838#---------------------------------------------------------------------
3939# list_sites -- all active rows, sorted, brand_color + display_name +
4040# vhost_path included for UI use. NOT the password.
4141#---------------------------------------------------------------------
4242sub list_sites {
4343 my ($self, %a) = @_;
4444 my $only_active = exists $a{active} ? $a{active} : 1;
4545 my $where = $only_active ? 'WHERE is_active=1' : '';
4646
4747 my $db = MODS::DBConnect->new;
4848 my $dbh = $db->db_connect;
4949 return [] unless $dbh;
5050 my @rows = $db->db_readwrite_multiple($dbh, qq~
5151 SELECT id, slug, display_name, display_url, brand_color,
5252 db_host, db_port, db_name, db_user, vhost_path,
5353 is_active, last_test_at, last_test_result, sort_order
5454 FROM site_connections
5555 $where
5656 ORDER BY sort_order, id
5757 ~, __FILE__, __LINE__);
5858 $db->db_disconnect($dbh);
5959 return \@rows;
6060}
6161
6262#---------------------------------------------------------------------
6363# Internal: pull a single site_connections row + decrypt the password
6464# in the same query via AES_DECRYPT. Returns hashref with cleartext
6565# pass OR undef if the site is unknown / inactive / pass not set.
6666#---------------------------------------------------------------------
6767sub _conn_row {
6868 my ($self, $slug) = @_;
6969 return undef unless $slug;
7070 my $slug_q = $slug; $slug_q =~ s/'/''/g;
7171 my $key = $cfg->settings('site_conn_enc_key') || '';
7272 my $key_q = $key; $key_q =~ s/'/''/g;
7373
7474 my $db = MODS::DBConnect->new;
7575 my $dbh = $db->db_connect;
7676 return undef unless $dbh;
7777 my $r = $db->db_readwrite($dbh, qq~
7878 SELECT id, slug, display_name, db_host, db_port, db_name, db_user,
7979 CAST(AES_DECRYPT(db_pass_enc, '$key_q') AS CHAR) AS db_pass,
8080 is_active
8181 FROM site_connections
8282 WHERE slug='$slug_q' AND is_active=1
8383 LIMIT 1
8484 ~, __FILE__, __LINE__);
8585 $db->db_disconnect($dbh);
8686 return $r;
8787}
8888
8989sub row_for_slug {
9090 my ($self, $slug) = @_;
9191 return $self->_conn_row($slug);
9292}
9393
9494#---------------------------------------------------------------------
9595# Internal: open a DBI handle against the remote site. AutoCommit on,
9696# RaiseError off (we want to fail soft).
9797#---------------------------------------------------------------------
9898sub _open {
9999 my ($self, $slug) = @_;
100100 my $row = $self->_conn_row($slug);
101101 unless ($row && $row->{db_name}) {
102102 $self->{err} = "site '$slug' not configured / inactive";
103103 return undef;
104104 }
105105 my $host = $row->{db_host} || 'localhost';
106106 my $port = $row->{db_port} || 3306;
107107 my $name = $row->{db_name};
108108 my $user = $row->{db_user};
109109 my $pass = $row->{db_pass} || '';
110110
111111 my $dsn = "DBI:mysql:database=$name;host=$host;port=$port";
112112 my $dbh = eval { DBI->connect($dsn, $user, $pass, {
113113 PrintError => 0, RaiseError => 0, AutoCommit => 1, mysql_connect_timeout => 5
114114 }) };
115115 unless ($dbh) {
116116 $self->{err} = "connect failed: " . ($DBI::errstr || $@ || 'unknown');
117117 return undef;
118118 }
119119 return $dbh;
120120}
121121
122122#---------------------------------------------------------------------
123123# Read-only enforcement at the call layer: refuse anything that
124124# isn't a SELECT or SHOW. Keeps an accidental UPDATE from sneaking
125125# through.
126126#---------------------------------------------------------------------
127127sub _is_safe_sql {
128128 my ($sql) = @_;
129129 return 0 unless defined $sql;
130130 my $stripped = $sql;
131131 $stripped =~ s/^\s+//;
132132 return ($stripped =~ /^(SELECT|SHOW|DESC|EXPLAIN)\b/i) ? 1 : 0;
133133}
134134
135135sub query_one {
136136 my ($self, $slug, $sql) = @_;
137137 $self->{err} = '';
138138 unless (_is_safe_sql($sql)) {
139139 $self->{err} = 'read-only adapter refuses non-SELECT'; return undef;
140140 }
141141 my $dbh = $self->_open($slug);
142142 return undef unless $dbh;
143143 my $sth = $dbh->prepare($sql);
144144 unless ($sth && $sth->execute) {
145145 $self->{err} = $dbh->errstr || 'execute failed';
146146 $dbh->disconnect;
147147 return undef;
148148 }
149149 my $r = $sth->fetchrow_hashref;
150150 $sth->finish; # release cursor so ->disconnect is clean
151151 $dbh->disconnect;
152152 return $r;
153153}
154154
155155sub query_many {
156156 my ($self, $slug, $sql) = @_;
157157 $self->{err} = '';
158158 unless (_is_safe_sql($sql)) {
159159 $self->{err} = 'read-only adapter refuses non-SELECT'; return [];
160160 }
161161 my $dbh = $self->_open($slug);
162162 return [] unless $dbh;
163163 my $sth = $dbh->prepare($sql);
164164 unless ($sth && $sth->execute) {
165165 $self->{err} = $dbh->errstr || 'execute failed';
166166 $dbh->disconnect;
167167 return [];
168168 }
169169 my @out;
170170 while (my $r = $sth->fetchrow_hashref) { push @out, $r; }
171171 $sth->finish; # belt+suspenders (while-loop exhaustion should already finish it)
172172 $dbh->disconnect;
173173 return \@out;
174174}
175175
176176#---------------------------------------------------------------------
177177# test_connection -- runs SELECT 1 and stamps last_test_at /
178178# last_test_result on the site_connections row.
179179#---------------------------------------------------------------------
180180sub test_connection {
181181 my ($self, $slug) = @_;
182182 $self->{err} = '';
183183 my $r = $self->query_one($slug, 'SELECT 1 AS ok');
184184 my $ok = ($r && $r->{ok}) ? 1 : 0;
185185 my $msg = $ok ? 'ok' : ($self->{err} || 'failed');
186186
187187 # Stamp result on local site_connections row.
188188 my $db = MODS::DBConnect->new;
189189 my $dbh = $db->db_connect;
190190 if ($dbh) {
191191 my $slug_q = $slug; $slug_q =~ s/'/''/g;
192192 my $msg_q = substr($msg, 0, 250); $msg_q =~ s/'/''/g;
193193 $db->db_readwrite($dbh, qq~
194194 UPDATE site_connections
195195 SET last_test_at=NOW(), last_test_result='$msg_q'
196196 WHERE slug='$slug_q'
197197 ~, __FILE__, __LINE__);
198198 $db->db_disconnect($dbh);
199199 }
200200 return ($ok, $ok ? undef : $msg);
201201}
202202
203203#---------------------------------------------------------------------
204204# Helper for UPSERTing a row in local site_connections. Encrypts the
205205# password via AES_ENCRYPT(plain, $key). Blank pass keeps the
206206# existing one (so admin can edit a row without retyping).
207207#---------------------------------------------------------------------
208208sub upsert {
209209 my ($self, %a) = @_;
210210 my $id = ($a{id} || 0) + 0;
211211 my $slug = $a{slug} || '';
212212 my $display_name= $a{display_name}|| $slug;
213213 my $display_url = $a{display_url} || '';
214214 my $brand_color = $a{brand_color} || '#00f0ff';
215215 my $db_host = $a{db_host} || 'localhost';
216216 my $db_port = ($a{db_port} || 3306) + 0;
217217 my $db_name = $a{db_name} || '';
218218 my $db_user = $a{db_user} || '';
219219 my $db_pass = defined $a{db_pass} ? $a{db_pass} : '';
220220 my $vhost_path = $a{vhost_path} || '';
221221 my $is_active = $a{is_active} ? 1 : 0;
222222 my $sort_order = ($a{sort_order} || 100) + 0;
223223 return (0, 'slug required') unless length $slug;
224224 return (0, 'db_name required') unless length $db_name;
225225 return (0, 'db_user required') unless length $db_user;
226226
227227 my $key = $cfg->settings('site_conn_enc_key') || '';
228228 my $q = sub { my $v = shift; $v //= ''; $v =~ s/'/''/g; return $v; };
229229
230230 my $key_q = $q->($key);
231231 my $pass_sql;
232232 if (length $db_pass) {
233233 my $p_q = $q->($db_pass);
234234 $pass_sql = "AES_ENCRYPT('$p_q','$key_q')";
235235 } else {
236236 $pass_sql = undef; # keep existing
237237 }
238238
239239 my $db = MODS::DBConnect->new;
240240 my $dbh = $db->db_connect;
241241 return (0, 'local db unavailable') unless $dbh;
242242
243243 my @sets = (
244244 "slug='" . $q->($slug) . "'",
245245 "display_name='" . $q->($display_name) . "'",
246246 "display_url='" . $q->($display_url) . "'",
247247 "brand_color='" . $q->($brand_color) . "'",
248248 "db_host='" . $q->($db_host) . "'",
249249 "db_port='$db_port'",
250250 "db_name='" . $q->($db_name) . "'",
251251 "db_user='" . $q->($db_user) . "'",
252252 "vhost_path='" . $q->($vhost_path) . "'",
253253 "is_active='$is_active'",
254254 "sort_order='$sort_order'",
255255 );
256256 push @sets, "db_pass_enc=$pass_sql" if defined $pass_sql;
257257 my $set_sql = join(",\n ", @sets);
258258
259259 if ($id) {
260260 $db->db_readwrite($dbh, qq~
261261 UPDATE site_connections SET $set_sql WHERE id='$id'
262262 ~, __FILE__, __LINE__);
263263 } else {
264264 # On insert, password is REQUIRED -- otherwise we'd have a
265265 # half-configured row.
266266 unless (defined $pass_sql) {
267267 $db->db_disconnect($dbh);
268268 return (0, 'password required on new sites');
269269 }
270270 $db->db_readwrite($dbh, qq~
271271 INSERT INTO site_connections SET $set_sql
272272 ~, __FILE__, __LINE__);
273273 my $r = $db->db_readwrite($dbh, q~SELECT LAST_INSERT_ID() AS n~, __FILE__, __LINE__);
274274 $id = ($r && $r->{n}) ? $r->{n} : 0;
275275 }
276276 $db->db_disconnect($dbh);
277277 return ($id, undef);
278278}
279279
280280#---------------------------------------------------------------------
281281# set_session_override / clear_session_override -- tightly scoped
282282# write carve-out. Only ever touches users.session_minutes_override.
283283# Everything else is still read-only.
284284#---------------------------------------------------------------------
285285sub set_session_override {
286286 my ($self, $slug, $user_id, $minutes) = @_;
287287 $self->{err} = '';
288288 $user_id = int($user_id || 0); return 0 unless $user_id > 0;
289289 $minutes = int($minutes || 0); return 0 unless $minutes > 0 && $minutes <= 525600 * 5; # cap 5y
290290 my $dbh = $self->_open($slug);
291291 return 0 unless $dbh;
292292 my $sth = $dbh->prepare('UPDATE users SET session_minutes_override=? WHERE id=?');
293293 my $ok = $sth && $sth->execute($minutes, $user_id);
294294 $self->{err} = $dbh->errstr if !$ok;
295295 $dbh->disconnect;
296296 return $ok ? 1 : 0;
297297}
298298
299299sub clear_session_override {
300300 my ($self, $slug, $user_id) = @_;
301301 $self->{err} = '';
302302 $user_id = int($user_id || 0); return 0 unless $user_id > 0;
303303 my $dbh = $self->_open($slug);
304304 return 0 unless $dbh;
305305 my $sth = $dbh->prepare('UPDATE users SET session_minutes_override=NULL WHERE id=?');
306306 my $ok = $sth && $sth->execute($user_id);
307307 $self->{err} = $dbh->errstr if !$ok;
308308 $dbh->disconnect;
309309 return $ok ? 1 : 0;
310310}
311311
312312#---------------------------------------------------------------------
313313# Maintenance lockdown carve-out (per-site write).
314314# Two tight, fixed UPDATEs against platform_settings only -- everything
315315# else stays read-only.
316316#---------------------------------------------------------------------
317317sub set_maintenance_locked {
318318 my ($self, $slug, $value) = @_;
319319 $self->{err} = '';
320320 $value = $value ? 1 : 0;
321321 my $dbh = $self->_open($slug);
322322 return 0 unless $dbh;
323323 # Upsert via prepared statement
324324 my $sth = $dbh->prepare(q{
325325 INSERT INTO platform_settings (setting_key, setting_value)
326326 VALUES ('maintenance_locked', ?)
327327 ON DUPLICATE KEY UPDATE setting_value = VALUES(setting_value)
328328 });
329329 my $ok = $sth && $sth->execute($value);
330330 $self->{err} = $dbh->errstr if !$ok;
331331 $dbh->disconnect;
332332 return $ok ? 1 : 0;
333333}
334334
335335sub get_maintenance_status {
336336 my ($self, $slug) = @_;
337337 $self->{err} = '';
338338 my $dbh = $self->_open($slug);
339339 return undef unless $dbh;
340340 my $sth = $dbh->prepare(q{
341341 SELECT setting_value FROM platform_settings WHERE setting_key='maintenance_locked' LIMIT 1
342342 });
343343 my $locked = 0;
344344 if ($sth && $sth->execute) {
345345 my $row = $sth->fetchrow_hashref;
346346 $locked = ($row && int($row->{setting_value})) ? 1 : 0;
347347 }
348348 $dbh->disconnect;
349349 return $locked;
350350}
351351
352352sub deactivate {
353353 my ($self, $id) = @_;
354354 $id =~ s/[^0-9]//g if defined $id;
355355 return 0 unless $id;
356356 my $db = MODS::DBConnect->new;
357357 my $dbh = $db->db_connect;
358358 return 0 unless $dbh;
359359 $db->db_readwrite($dbh, qq~
360360 UPDATE site_connections SET is_active=0 WHERE id='$id'
361361 ~, __FILE__, __LINE__);
362362 $db->db_disconnect($dbh);
363363 return 1;
364364}
365365
366366sub reactivate {
367367 my ($self, $id) = @_;
368368 $id =~ s/[^0-9]//g if defined $id;
369369 return 0 unless $id;
370370 my $db = MODS::DBConnect->new;
371371 my $dbh = $db->db_connect;
372372 return 0 unless $dbh;
373373 $db->db_readwrite($dbh, qq~
374374 UPDATE site_connections SET is_active=1 WHERE id='$id'
375375 ~, __FILE__, __LINE__);
376376 $db->db_disconnect($dbh);
377377 return 1;
378378}
379379
3803801;