Diff -- /var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_action.cgi

O Operator
Diff

/var/www/vhosts/3dshawn.com/abforge.3dshawn.com/admin_action.cgi

added on local at 2026-07-01 16:00:50

Added
+433
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 63959472907f
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# ABForge - Admin action handler.
4#
5# Single POST chokepoint for every admin-side mutation. Each "act"
6# value performs one tightly-scoped operation against a target user.
7#
8# Actions (POSTed via the buttons in /admin_user.cgi):
9# impersonate u=<id> -- start "Acting as X"
10# stop_impersonation -- end current impersonation
11# suspend u=<id> -- account_status='suspended'
12# reactivate u=<id> -- account_status='active'
13# close u=<id> -- account_status='closed'
14# promote_admin u=<id> -- is_admin=1
15# demote_admin u=<id> -- is_admin=0
16# reset_password u=<id> -- generate one-time token
17# edit_account u=<id> email= name= plan_tier= account_status=
18#
19# Every action goes through require_admin first. We do NOT allow GET
20# anywhere -- accidental link-followers can't trigger a destructive
21# action by sharing a URL.
22#======================================================================
23use strict;
24use warnings;
25
26use lib '/var/www/vhosts/abforge.com/httpdocs';
27use CGI;
28use MODS::Template;
29use MODS::DBConnect;
30use MODS::Login;
31use MODS::ABForge::Config;
32use MODS::ABForge::Wrapper;
33use MODS::ABForge::Admin;
34
35my $q = CGI->new;
36my $form = $q->Vars;
37my $auth = MODS::Login->new;
38my $wrap = MODS::ABForge::Wrapper->new;
39my $tfile = MODS::Template->new;
40my $db = MODS::DBConnect->new;
41my $cfg = MODS::ABForge::Config->new;
42my $admin = MODS::ABForge::Admin->new;
43my $DB = $cfg->settings('database_name');
44
45$| = 1;
46
47# Reject non-POST. Admin mutations must always be POST.
48if (($ENV{REQUEST_METHOD} || '') ne 'POST') {
49 print "Status: 405 Method Not Allowed\nContent-Type: text/plain\n\nPOST required\n";
50 exit;
51}
52
53my $userinfo = $auth->login_verify();
54if (!$userinfo) {
55 print "Status: 302 Found\nLocation: /login.cgi\n\n";
56 exit;
57}
58$admin->require_admin($userinfo);
59require MODS::ABForge::Permissions;
60MODS::ABForge::Permissions->new->require_feature($userinfo, 'admin_edit_users');
61
62my $act = lc($form->{act} || '');
63$act =~ s/[^a-z_]//g;
64
65my $target_id = $form->{u} || 0;
66$target_id =~ s/[^0-9]//g;
67
68my $admin_user_id = $admin->admin_user_id($userinfo);
69my $admin_sid = $admin->admin_session_id($userinfo);
70
71my $dbh = $db->db_connect();
72
73# Helpers ------------------------------------------------------------------
74sub _exists_user {
75 my ($dbh, $DB, $db, $id) = @_;
76 return 0 unless $id;
77 my $r = $db->db_readwrite($dbh, qq~
78 SELECT id FROM `${DB}`.users WHERE id='$id' LIMIT 1
79 ~, $ENV{SCRIPT_NAME}, __LINE__);
80 return ($r && $r->{id}) ? 1 : 0;
81}
82
83sub _go {
84 my ($where) = @_;
85 print "Status: 302 Found\nLocation: $where\n\n";
86 exit;
87}
88
89sub _go_user {
90 my ($id) = @_;
91 _go("/admin_user.cgi?u=$id");
92}
93
94sub _h {
95 my $s = shift; $s = '' unless defined $s;
96 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
97 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
98 return $s;
99}
100
101# ---- impersonate ---------------------------------------------------------
102if ($act eq 'impersonate') {
103 if (!_exists_user($dbh, $DB, $db, $target_id)) {
104 $db->db_disconnect($dbh);
105 _go('/admin.cgi');
106 }
107 if ($target_id eq $admin_user_id) {
108 $db->db_disconnect($dbh);
109 _go_user($target_id);
110 }
111
112 my $mode = ($form->{mode} || 'control');
113 $admin->start_impersonation($db, $dbh, $DB,
114 $admin_sid, $admin_user_id, $target_id, $mode);
115
116 $db->db_disconnect($dbh);
117 # Send them to the target user's dashboard so the admin immediately
118 # sees what the user sees.
119 _go('/dashboard.cgi');
120}
121
122# ---- stop_impersonation --------------------------------------------------
123if ($act eq 'stop_impersonation') {
124 $admin->stop_impersonation($db, $dbh, $DB, $admin_sid);
125 $db->db_disconnect($dbh);
126 _go('/admin.cgi');
127}
128
129# Everything below mutates the target user. Guard against missing/self
130# in the few spots where self-action would be dangerous.
131if (!$target_id || !_exists_user($dbh, $DB, $db, $target_id)) {
132 $db->db_disconnect($dbh);
133 _go('/admin.cgi');
134}
135
136# ---- suspend / reactivate / close ----------------------------------------
137if ($act eq 'suspend' || $act eq 'reactivate' || $act eq 'close') {
138 my $new = $act eq 'suspend' ? 'suspended'
139 : $act eq 'close' ? 'closed'
140 : 'active';
141
142 # Don't let an admin lock themselves out by suspending/closing self.
143 if (($act eq 'suspend' || $act eq 'close') && $target_id eq $admin_user_id) {
144 $db->db_disconnect($dbh);
145 _go_user($target_id);
146 }
147
148 $db->db_readwrite($dbh, qq~
149 UPDATE `${DB}`.users
150 SET account_status='$new', updated_at=NOW()
151 WHERE id='$target_id'
152 ~, $ENV{SCRIPT_NAME}, __LINE__);
153
154 # Suspending/closing also revokes all of their sessions so they're
155 # kicked out immediately. login_verify rejects non-active accounts
156 # anyway, but revoke is cleaner for any other code that loads
157 # session state directly.
158 if ($act eq 'suspend' || $act eq 'close') {
159 $db->db_readwrite($dbh, qq~
160 UPDATE `${DB}`.user_sessions
161 SET revoked_at=NOW()
162 WHERE user_id='$target_id' AND revoked_at IS NULL
163 ~, $ENV{SCRIPT_NAME}, __LINE__);
164 }
165
166 $db->db_disconnect($dbh);
167 _go_user($target_id);
168}
169
170# ---- promote / demote admin ---------------------------------------------
171if ($act eq 'promote_admin' || $act eq 'demote_admin') {
172 my $val = $act eq 'promote_admin' ? 1 : 0;
173
174 # An admin can demote themselves but only if there's at least one
175 # other admin. Otherwise we'd lock out the Admin Console forever.
176 if ($act eq 'demote_admin' && $target_id eq $admin_user_id) {
177 my $count = $db->db_readwrite($dbh, qq~
178 SELECT COUNT(*) AS n FROM `${DB}`.users
179 WHERE is_admin=1 AND id != '$target_id'
180 ~, $ENV{SCRIPT_NAME}, __LINE__);
181 if (!$count || !$count->{n}) {
182 $db->db_disconnect($dbh);
183 _go_user($target_id);
184 }
185 }
186
187 $db->db_readwrite($dbh, qq~
188 UPDATE `${DB}`.users
189 SET is_admin='$val', updated_at=NOW()
190 WHERE id='$target_id'
191 ~, $ENV{SCRIPT_NAME}, __LINE__);
192
193 $db->db_disconnect($dbh);
194 _go_user($target_id);
195}
196
197# ---- promote / demote SUPER admin --------------------------------------
198# Only an existing super-admin can grant or revoke super-admin. Wraps
199# the regular is_admin flag too so a super-admin demotion never strands
200# someone with a one-way upgrade (super yes / admin no -- nonsensical).
201# Self-demote is blocked outright: the platform must always have at
202# least one super-admin.
203if ($act eq 'promote_super_admin' || $act eq 'demote_super_admin') {
204 require MODS::ABForge::Permissions;
205 my $is_super = MODS::ABForge::Permissions->new->is_super_admin($userinfo);
206 unless ($is_super) {
207 $db->db_disconnect($dbh);
208 _go_user($target_id);
209 }
210
211 my $val = $act eq 'promote_super_admin' ? 1 : 0;
212
213 if ($act eq 'demote_super_admin' && $target_id eq $admin_user_id) {
214 # Never lock the platform out of super-admin -- you can't demote
215 # yourself. Demote someone else first if you really want to step
216 # back.
217 $db->db_disconnect($dbh);
218 _go_user($target_id);
219 }
220 if ($act eq 'demote_super_admin') {
221 my $count = $db->db_readwrite($dbh, qq~
222 SELECT COUNT(*) AS n FROM `${DB}`.users
223 WHERE is_super_admin=1 AND id != '$target_id'
224 ~, $ENV{SCRIPT_NAME}, __LINE__);
225 if (!$count || !$count->{n}) {
226 # Would leave the platform with zero super-admins. Refuse.
227 $db->db_disconnect($dbh);
228 _go_user($target_id);
229 }
230 }
231
232 # Super-admin implies admin. Set both atomically on promote so we
233 # can't end up with is_super_admin=1 AND is_admin=0.
234 my $admin_clause = $val ? ', is_admin=1' : '';
235 $db->db_readwrite($dbh, qq~
236 UPDATE `${DB}`.users
237 SET is_super_admin='$val'$admin_clause,
238 updated_at=NOW()
239 WHERE id='$target_id'
240 ~, $ENV{SCRIPT_NAME}, __LINE__);
241
242 $db->db_disconnect($dbh);
243 _go_user($target_id);
244}
245
246# ---- reset_password ------------------------------------------------------
247# Admin-initiated password reset: mints a one-shot token in
248# password_resets, emails the link to the target user, and shows the
249# admin a confirmation with the link inline (so they can also relay it
250# manually if email delivery is slow or the target's address is wrong).
251if ($act eq 'reset_password') {
252 require Digest::SHA;
253 require MODS::ABForge::Mailer;
254
255 # Pre-migration guard. Pretend the action ran for the admin's UX
256 # but warn so they know to run the migration.
257 my $tab = $db->db_readwrite($dbh, qq~
258 SELECT COUNT(*) AS n FROM information_schema.tables
259 WHERE table_schema='$DB' AND table_name='password_resets'
260 ~, $ENV{SCRIPT_NAME}, __LINE__);
261 unless ($tab && $tab->{n}) {
262 $db->db_disconnect($dbh);
263 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
264 my $body = qq~
265 <div class="page-head">
266 <div>
267 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
268 <h1 class="page-title">Migration required</h1>
269 <p class="page-subtitle">Cannot send a reset link until the password_resets table is created.</p>
270 </div>
271 <div class="page-actions">
272 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
273 </div>
274 </div>
275 <div class="banner warn mb-3">Run the password_resets migration from installation_instructions.html, then try again.</div>
276 ~;
277 $wrap->render({ userinfo => $userinfo, page_key => 'admin', title => 'Reset password', body => $body });
278 exit;
279 }
280
281 # Look up the target user to get their email + display name.
282 my $u = $db->db_readwrite($dbh, qq~
283 SELECT id, email, display_name FROM `${DB}`.users WHERE id='$target_id' LIMIT 1
284 ~, $ENV{SCRIPT_NAME}, __LINE__);
285 unless ($u && $u->{id}) {
286 $db->db_disconnect($dbh);
287 _go_user($target_id);
288 exit;
289 }
290
291 # HMAC-SHA256 hex token (64 chars). Keyed off the platform Stripe
292 # webhook secret if set; otherwise a static fallback. Random 32-byte
293 # nonce makes guessing infeasible even with secret rotation.
294 my $key = $cfg->settings('stripe_webhook_secret')
295 || $cfg->settings('stripe_secret')
296 || 'abforge-static-fallback';
297 my $rand = '';
298 $rand .= chr(int(rand(256))) for 1..32;
299 my $token = Digest::SHA::hmac_sha256_hex($u->{id} . '|' . time() . '|' . $rand, $key);
300
301 my $ip = $ENV{REMOTE_ADDR} || ''; $ip =~ s/'/''/g; $ip = substr($ip, 0, 45);
302 my $ua = 'admin:' . ($admin_user_id || '?');
303 $ua =~ s/'/''/g; $ua = substr($ua, 0, 255);
304
305 $db->db_readwrite($dbh, qq~
306 INSERT INTO `${DB}`.password_resets
307 SET user_id='$u->{id}',
308 token='$token',
309 requested_ip='$ip',
310 requested_user_agent='$ua',
311 expires_at=DATE_ADD(NOW(), INTERVAL 60 MINUTE)
312 ~, $ENV{SCRIPT_NAME}, __LINE__);
313
314 # Build the link from the request host.
315 my $proto = 'https';
316 $proto = 'http' unless ($ENV{HTTPS} || '') =~ /^on$/i
317 || ($ENV{HTTP_X_FORWARDED_PROTO} || '') =~ /^https$/i;
318 my $host = $ENV{HTTP_HOST} || 'abforge.com';
319 my $link = "$proto://$host/reset_password.cgi?t=$token";
320
321 # Send the email. Failure (no SMTP, MTA down, etc.) does NOT block
322 # the admin -- they still see the link inline.
323 my $mailer = MODS::ABForge::Mailer->new;
324 my $mail_ok = 0;
325 my $mail_error = '';
326 if ($mailer->is_configured) {
327 my $brand = $cfg->settings('brand_name') || 'ABForge';
328 my $name = $u->{display_name} || 'there';
329 my $body_text = "Hi $name,\n\n"
330 . "A $brand administrator just initiated a password reset on your account.\n\n"
331 . "Use this link within the next 60 minutes:\n\n $link\n\n"
332 . "If you did not expect this, you can ignore the email and your password stays unchanged.\n\n"
333 . "-- $brand\n";
334 my $body_html = '<p>Hi ' . _h($name) . ',</p>'
335 . '<p>A ' . _h($brand) . ' administrator just initiated a password reset on your account.</p>'
336 . '<p><a href="' . _h($link) . '" style="display:inline-block;background:#4f46e5;color:#fff;padding:10px 18px;border-radius:6px;text-decoration:none;font-weight:600">Reset my password</a></p>'
337 . '<p style="font-size:13px;color:#475569">Or copy and paste this URL into your browser:<br><span style="word-break:break-all">' . _h($link) . '</span></p>'
338 . '<p style="font-size:13px;color:#475569">This link expires in 60 minutes. If you did not expect this, you can ignore the email and your password stays unchanged.</p>';
339 my $res = $mailer->send(
340 to => $u->{email},
341 subject => "Password reset for your $brand account",
342 body => $body_text,
343 html => $body_html,
344 );
345 $mail_ok = $res->{ok} ? 1 : 0;
346 $mail_error = $res->{error} || '';
347 } else {
348 $mail_error = 'Email pipeline not configured. Add SMTP settings in Software Configuration or install sendmail.';
349 }
350
351 $db->db_disconnect($dbh);
352
353 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n";
354 my $sent_block = $mail_ok
355 ? '<div class="banner mb-3" style="background:rgba(34,197,94,0.10);border:1px solid rgba(34,197,94,0.35);color:#86efac">' .
356 '<strong>Email sent to ' . _h($u->{email}) . '.</strong> The link below is also valid if you need to share it directly.' .
357 '</div>'
358 : '<div class="banner warn mb-3"><strong>Email could NOT be sent:</strong> ' . _h($mail_error) . ' Share the link below manually.</div>';
359 my $body = qq~
360 <div class="page-head">
361 <div>
362 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
363 <h1 class="page-title">Reset link issued</h1>
364 <p class="page-subtitle">Valid for 60 minutes, single-use.</p>
365 </div>
366 <div class="page-actions">
367 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
368 </div>
369 </div>
370 $sent_block
371 <div class="banner info mb-3" style="word-break:break-all">
372 <strong>Reset URL:</strong>
373 <code>$link</code>
374 </div>
375 ~;
376 $wrap->render({
377 userinfo => $userinfo,
378 page_key => 'admin',
379 title => 'Reset password',
380 body => $body,
381 });
382 exit;
383}
384
385# ---- edit_account --------------------------------------------------------
386if ($act eq 'edit_account') {
387 my $email = $form->{email} || '';
388 my $name = $form->{display_name} || '';
389 my $plan = $form->{plan_tier} || '';
390 my $stat = $form->{account_status} || '';
391
392 $email =~ s/[^A-Za-z0-9._+@\-]//g;
393 $name =~ s/[\\']//g;
394 $plan = '' unless $plan =~ /^(free|starter|pro|studio)$/;
395 $stat = '' unless $stat =~ /^(active|suspended|closed|pending_verification)$/;
396
397 # Same self-lockout guard as suspend/close.
398 if ($stat && $stat ne 'active' && $target_id eq $admin_user_id) {
399 $stat = '';
400 }
401
402 my @sets;
403 push @sets, "email='$email'" if $email;
404 push @sets, "display_name='$name'" if $name;
405 push @sets, "plan_tier='$plan'" if $plan;
406 push @sets, "account_status='$stat'" if $stat;
407 push @sets, "updated_at=NOW()";
408
409 if (@sets > 1) {
410 my $sets_sql = join(',', @sets);
411 $db->db_readwrite($dbh, qq~
412 UPDATE `${DB}`.users
413 SET $sets_sql
414 WHERE id='$target_id'
415 ~, $ENV{SCRIPT_NAME}, __LINE__);
416
417 # If we suspended/closed via this form, revoke sessions too.
418 if ($stat && $stat ne 'active') {
419 $db->db_readwrite($dbh, qq~
420 UPDATE `${DB}`.user_sessions
421 SET revoked_at=NOW()
422 WHERE user_id='$target_id' AND revoked_at IS NULL
423 ~, $ENV{SCRIPT_NAME}, __LINE__);
424 }
425 }
426
427 $db->db_disconnect($dbh);
428 _go_user($target_id);
429}
430
431# Unknown action -- back to the admin home.
432$db->db_disconnect($dbh);
433_go('/admin.cgi');