Diff -- /var/www/vhosts/webstls.com/httpdocs/admin_action.cgi

O Operator
Diff

/var/www/vhosts/webstls.com/httpdocs/admin_action.cgi

added on WebSTLs (webstls.com) at 2026-07-01 22:26:15

Added
+551
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to d4c3eb368426
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# WebSTLs - 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/webstls.com/httpdocs';
27use CGI;
28use MODS::Template;
29use MODS::DBConnect;
30use MODS::Login;
31use MODS::WebSTLs::Config;
32use MODS::WebSTLs::Wrapper;
33use MODS::WebSTLs::Admin;
34use MODS::WebSTLs::Storage;
35
36my $q = CGI->new;
37my $form = $q->Vars;
38my $auth = MODS::Login->new;
39my $wrap = MODS::WebSTLs::Wrapper->new;
40my $tfile = MODS::Template->new;
41my $db = MODS::DBConnect->new;
42my $cfg = MODS::WebSTLs::Config->new;
43my $admin = MODS::WebSTLs::Admin->new;
44my $DB = $cfg->settings('database_name');
45
46$| = 1;
47
48# Reject non-POST. Admin mutations must always be POST.
49if (($ENV{REQUEST_METHOD} || '') ne 'POST') {
50 print "Status: 405 Method Not Allowed\nContent-Type: text/plain\n\nPOST required\n";
51 exit;
52}
53
54my $userinfo = $auth->login_verify();
55if (!$userinfo) {
56 print "Status: 302 Found\nLocation: /login.cgi\n\n";
57 exit;
58}
59$admin->require_admin($userinfo);
60require MODS::WebSTLs::Permissions;
61MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'admin_edit_users');
62
63my $act = lc($form->{act} || '');
64$act =~ s/[^a-z_]//g;
65
66my $target_id = $form->{u} || 0;
67$target_id =~ s/[^0-9]//g;
68
69my $admin_user_id = $admin->admin_user_id($userinfo);
70my $admin_sid = $admin->admin_session_id($userinfo);
71
72my $dbh = $db->db_connect();
73
74# Helpers ------------------------------------------------------------------
75sub _exists_user {
76 my ($dbh, $DB, $db, $id) = @_;
77 return 0 unless $id;
78 my $r = $db->db_readwrite($dbh, qq~
79 SELECT id FROM `${DB}`.users WHERE id='$id' LIMIT 1
80 ~, $ENV{SCRIPT_NAME}, __LINE__);
81 return ($r && $r->{id}) ? 1 : 0;
82}
83
84sub _go {
85 my ($where) = @_;
86 print "Status: 302 Found\nLocation: $where\n\n";
87 exit;
88}
89
90sub _go_user {
91 my ($id) = @_;
92 _go("/admin_user.cgi?u=$id");
93}
94
95sub _h {
96 my $s = shift; $s = '' unless defined $s;
97 $s =~ s/&/&amp;/g; $s =~ s/</&lt;/g; $s =~ s/>/&gt;/g;
98 $s =~ s/"/&quot;/g; $s =~ s/'/&#39;/g;
99 return $s;
100}
101
102# ---- storage: per-user overrides ------------------------------------------
103# Set / clear users.upload_max_mb_override + storage_hard_cap_gb_override +
104# allowed_extensions_override. Blank input clears the override (so the
105# tier default resumes); a number sets it.
106if ($act eq 'save_storage_overrides') {
107 unless (_exists_user($dbh, $DB, $db, $target_id)) {
108 $db->db_disconnect($dbh); _go('/admin.cgi');
109 }
110 my $upload_override = defined $form->{upload_max_mb_override}
111 ? $form->{upload_max_mb_override} : '';
112 my $hard_override = defined $form->{storage_hard_cap_gb_override}
113 ? $form->{storage_hard_cap_gb_override} : '';
114 my $ext_override = defined $form->{allowed_extensions_override}
115 ? $form->{allowed_extensions_override} : '';
116
117 # Numbers: blank = NULL (clear override). Strip everything that
118 # isn't a digit; if zero-length, write NULL.
119 $upload_override =~ s/[^0-9]//g;
120 $hard_override =~ s/[^0-9]//g;
121 my $u_sql = length($upload_override) ? "'$upload_override'" : 'NULL';
122 my $h_sql = length($hard_override) ? "'$hard_override'" : 'NULL';
123
124 # Extensions: csv, lowercased, alphanumeric letters only. Blank
125 # = NULL. Cap at 500 chars to match column length.
126 my $ext_clean = lc $ext_override;
127 $ext_clean =~ s/[^a-z0-9,]//g;
128 $ext_clean = substr($ext_clean, 0, 500);
129 my $e_sql = length($ext_clean) ? "'$ext_clean'" : 'NULL';
130
131 $db->db_readwrite($dbh, qq~
132 UPDATE `${DB}`.users
133 SET upload_max_mb_override = $u_sql,
134 storage_hard_cap_gb_override = $h_sql,
135 allowed_extensions_override = $e_sql
136 WHERE id='$target_id' LIMIT 1
137 ~, $ENV{SCRIPT_NAME}, __LINE__);
138 $db->db_disconnect($dbh);
139 _go_user($target_id);
140}
141
142# ---- storage: force recompute ---------------------------------------------
143# Sum the user's model_files.original_size_bytes (or file_size_bytes
144# fallback) and overwrite storage_used_bytes. Use after manually
145# poking files on disk or when drift is suspected.
146if ($act eq 'recompute_storage') {
147 unless (_exists_user($dbh, $DB, $db, $target_id)) {
148 $db->db_disconnect($dbh); _go('/admin.cgi');
149 }
150 my $storage = MODS::WebSTLs::Storage->new;
151 $storage->recompute_usage($db, $dbh, $DB, $target_id);
152 $db->db_disconnect($dbh);
153 _go_user($target_id);
154}
155
156# ---- impersonate ---------------------------------------------------------
157if ($act eq 'impersonate') {
158 if (!_exists_user($dbh, $DB, $db, $target_id)) {
159 $db->db_disconnect($dbh);
160 _go('/admin.cgi');
161 }
162 if ($target_id eq $admin_user_id) {
163 $db->db_disconnect($dbh);
164 _go_user($target_id);
165 }
166
167 my $mode = ($form->{mode} || 'control');
168 $admin->start_impersonation($db, $dbh, $DB,
169 $admin_sid, $admin_user_id, $target_id, $mode);
170
171 $db->db_disconnect($dbh);
172 # Send them to the target user's dashboard so the admin immediately
173 # sees what the user sees.
174 _go('/dashboard.cgi');
175}
176
177# ---- stop_impersonation --------------------------------------------------
178if ($act eq 'stop_impersonation') {
179 $admin->stop_impersonation($db, $dbh, $DB, $admin_sid);
180 $db->db_disconnect($dbh);
181 _go('/admin.cgi');
182}
183
184# Everything below mutates the target user. Guard against missing/self
185# in the few spots where self-action would be dangerous.
186if (!$target_id || !_exists_user($dbh, $DB, $db, $target_id)) {
187 $db->db_disconnect($dbh);
188 _go('/admin.cgi');
189}
190
191# ---- suspend / reactivate / close ----------------------------------------
192if ($act eq 'suspend' || $act eq 'reactivate' || $act eq 'close') {
193 my $new = $act eq 'suspend' ? 'suspended'
194 : $act eq 'close' ? 'closed'
195 : 'active';
196
197 # Don't let an admin lock themselves out by suspending/closing self.
198 if (($act eq 'suspend' || $act eq 'close') && $target_id eq $admin_user_id) {
199 $db->db_disconnect($dbh);
200 _go_user($target_id);
201 }
202
203 $db->db_readwrite($dbh, qq~
204 UPDATE `${DB}`.users
205 SET account_status='$new', updated_at=NOW()
206 WHERE id='$target_id'
207 ~, $ENV{SCRIPT_NAME}, __LINE__);
208
209 # Suspending/closing also revokes all of their sessions so they're
210 # kicked out immediately. login_verify rejects non-active accounts
211 # anyway, but revoke is cleaner for any other code that loads
212 # session state directly.
213 if ($act eq 'suspend' || $act eq 'close') {
214 $db->db_readwrite($dbh, qq~
215 UPDATE `${DB}`.user_sessions
216 SET revoked_at=NOW()
217 WHERE user_id='$target_id' AND revoked_at IS NULL
218 ~, $ENV{SCRIPT_NAME}, __LINE__);
219 }
220
221 $db->db_disconnect($dbh);
222 _go_user($target_id);
223}
224
225# ---- promote / demote admin ---------------------------------------------
226if ($act eq 'grant_credit') {
227 my $target_uid = $form->{u} || 0; $target_uid =~ s/[^0-9]//g;
228 my $amount_dollars = $form->{amount_dollars} // '';
229 my $reason = $form->{reason} // '';
230 $amount_dollars =~ s/^\s+|\s+$//g;
231 $reason = substr($reason, 0, 500);
232 if ($target_uid && $amount_dollars =~ /^-?\d+(\.\d{1,2})?$/) {
233 my $cents = int($amount_dollars * 100);
234 my $kind = ($cents >= 0) ? 'grant' : 'adjustment';
235 my $r_sql = $reason; $r_sql =~ s/'/\\'/g;
236 my $bal_row = $db->db_readwrite($dbh, qq~
237 SELECT balance_after FROM `${DB}`.credit_ledger
238 WHERE user_id='$target_uid'
239 ORDER BY id DESC LIMIT 1
240 ~, $ENV{SCRIPT_NAME}, __LINE__);
241 my $prev_bal = ($bal_row && defined $bal_row->{balance_after}) ? $bal_row->{balance_after} + 0 : 0;
242 my $new_bal = $prev_bal + $cents;
243 $db->db_readwrite($dbh, qq~
244 INSERT INTO `${DB}`.credit_ledger
245 SET user_id='$target_uid', kind='$kind', amount_cents='$cents',
246 balance_after='$new_bal', reason='$r_sql',
247 created_by_user_id='$admin_user_id'
248 ~, $ENV{SCRIPT_NAME}, __LINE__);
249 }
250 print "Status: 302 Found\nLocation: /admin_user.cgi?u=$target_uid\n\n"; exit;
251}
252
253if ($act eq 'queue_refund') {
254 my $target_uid = $form->{u} || 0; $target_uid =~ s/[^0-9]//g;
255 my $amount_dollars = $form->{amount_dollars} // '';
256 my $reason = $form->{reason} // '';
257 my $invoice_id = $form->{invoice_id} || 0; $invoice_id =~ s/[^0-9]//g;
258 $amount_dollars =~ s/^\s+|\s+$//g;
259 $reason = substr($reason, 0, 500);
260 if ($target_uid && $amount_dollars =~ /^\d+(\.\d{1,2})?$/) {
261 my $cents = int($amount_dollars * 100);
262 my $r_sql = $reason; $r_sql =~ s/'/\\'/g;
263 my $inv_sql = $invoice_id ? "'$invoice_id'" : 'NULL';
264 $db->db_readwrite($dbh, qq~
265 INSERT INTO `${DB}`.refund_intents
266 SET user_id='$target_uid', invoice_id=$inv_sql,
267 amount_cents='$cents', reason='$r_sql',
268 requested_by_uid='$admin_user_id', status='queued'
269 ~, $ENV{SCRIPT_NAME}, __LINE__);
270 my $bal_row = $db->db_readwrite($dbh, qq~
271 SELECT balance_after FROM `${DB}`.credit_ledger
272 WHERE user_id='$target_uid' ORDER BY id DESC LIMIT 1
273 ~, $ENV{SCRIPT_NAME}, __LINE__);
274 my $prev_bal = ($bal_row && defined $bal_row->{balance_after}) ? $bal_row->{balance_after} + 0 : 0;
275 my $new_bal = $prev_bal + $cents;
276 my $sr_reason = "Refund queued (Stripe pending): $r_sql";
277 $db->db_readwrite($dbh, qq~
278 INSERT INTO `${DB}`.credit_ledger
279 SET user_id='$target_uid', kind='refund', amount_cents='$cents',
280 balance_after='$new_bal', reason='$sr_reason',
281 created_by_user_id='$admin_user_id'
282 ~, $ENV{SCRIPT_NAME}, __LINE__);
283 }
284 print "Status: 302 Found\nLocation: /admin_user.cgi?u=$target_uid\n\n"; exit;
285}
286
287
288
289if ($act eq 'promote_admin' || $act eq 'demote_admin') {
290 my $val = $act eq 'promote_admin' ? 1 : 0;
291
292 # An admin can demote themselves but only if there's at least one
293 # other admin. Otherwise we'd lock out the Admin Console forever.
294 if ($act eq 'demote_admin' && $target_id eq $admin_user_id) {
295 my $count = $db->db_readwrite($dbh, qq~
296 SELECT COUNT(*) AS n FROM `${DB}`.users
297 WHERE is_admin=1 AND id != '$target_id'
298 ~, $ENV{SCRIPT_NAME}, __LINE__);
299 if (!$count || !$count->{n}) {
300 $db->db_disconnect($dbh);
301 _go_user($target_id);
302 }
303 }
304
305 $db->db_readwrite($dbh, qq~
306 UPDATE `${DB}`.users
307 SET is_admin='$val', updated_at=NOW()
308 WHERE id='$target_id'
309 ~, $ENV{SCRIPT_NAME}, __LINE__);
310
311 $db->db_disconnect($dbh);
312 _go_user($target_id);
313}
314
315# ---- promote / demote SUPER admin --------------------------------------
316# Only an existing super-admin can grant or revoke super-admin. Wraps
317# the regular is_admin flag too so a super-admin demotion never strands
318# someone with a one-way upgrade (super yes / admin no -- nonsensical).
319# Self-demote is blocked outright: the platform must always have at
320# least one super-admin.
321if ($act eq 'promote_super_admin' || $act eq 'demote_super_admin') {
322 require MODS::WebSTLs::Permissions;
323 my $is_super = MODS::WebSTLs::Permissions->new->is_super_admin($userinfo);
324 unless ($is_super) {
325 $db->db_disconnect($dbh);
326 _go_user($target_id);
327 }
328
329 my $val = $act eq 'promote_super_admin' ? 1 : 0;
330
331 if ($act eq 'demote_super_admin' && $target_id eq $admin_user_id) {
332 # Never lock the platform out of super-admin -- you can't demote
333 # yourself. Demote someone else first if you really want to step
334 # back.
335 $db->db_disconnect($dbh);
336 _go_user($target_id);
337 }
338 if ($act eq 'demote_super_admin') {
339 my $count = $db->db_readwrite($dbh, qq~
340 SELECT COUNT(*) AS n FROM `${DB}`.users
341 WHERE is_super_admin=1 AND id != '$target_id'
342 ~, $ENV{SCRIPT_NAME}, __LINE__);
343 if (!$count || !$count->{n}) {
344 # Would leave the platform with zero super-admins. Refuse.
345 $db->db_disconnect($dbh);
346 _go_user($target_id);
347 }
348 }
349
350 # Super-admin implies admin. Set both atomically on promote so we
351 # can't end up with is_super_admin=1 AND is_admin=0.
352 my $admin_clause = $val ? ', is_admin=1' : '';
353 $db->db_readwrite($dbh, qq~
354 UPDATE `${DB}`.users
355 SET is_super_admin='$val'$admin_clause,
356 updated_at=NOW()
357 WHERE id='$target_id'
358 ~, $ENV{SCRIPT_NAME}, __LINE__);
359
360 $db->db_disconnect($dbh);
361 _go_user($target_id);
362}
363
364# ---- reset_password ------------------------------------------------------
365# Admin-initiated password reset: mints a one-shot token in
366# password_resets, emails the link to the target user, and shows the
367# admin a confirmation with the link inline (so they can also relay it
368# manually if email delivery is slow or the target's address is wrong).
369if ($act eq 'reset_password') {
370 require Digest::SHA;
371 require MODS::WebSTLs::Mailer;
372
373 # Pre-migration guard. Pretend the action ran for the admin's UX
374 # but warn so they know to run the migration.
375 my $tab = $db->db_readwrite($dbh, qq~
376 SELECT COUNT(*) AS n FROM information_schema.tables
377 WHERE table_schema='$DB' AND table_name='password_resets'
378 ~, $ENV{SCRIPT_NAME}, __LINE__);
379 unless ($tab && $tab->{n}) {
380 $db->db_disconnect($dbh);
381 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n";
382 my $body = qq~
383 <div class="page-head">
384 <div>
385 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
386 <h1 class="page-title">Migration required</h1>
387 <p class="page-subtitle">Cannot send a reset link until the password_resets table is created.</p>
388 </div>
389 <div class="page-actions">
390 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
391 </div>
392 </div>
393 <div class="banner warn mb-3">Run the password_resets migration from installation_instructions.html, then try again.</div>
394 ~;
395 $wrap->render({ userinfo => $userinfo, page_key => 'admin', title => 'Reset password', body => $body });
396 exit;
397 }
398
399 # Look up the target user to get their email + display name.
400 my $u = $db->db_readwrite($dbh, qq~
401 SELECT id, email, display_name FROM `${DB}`.users WHERE id='$target_id' LIMIT 1
402 ~, $ENV{SCRIPT_NAME}, __LINE__);
403 unless ($u && $u->{id}) {
404 $db->db_disconnect($dbh);
405 _go_user($target_id);
406 exit;
407 }
408
409 # HMAC-SHA256 hex token (64 chars). Keyed off the platform Stripe
410 # webhook secret if set; otherwise a static fallback. Random 32-byte
411 # nonce makes guessing infeasible even with secret rotation.
412 my $key = $cfg->settings('stripe_webhook_secret')
413 || $cfg->settings('stripe_secret')
414 || 'webstls-static-fallback';
415 my $rand = '';
416 $rand .= chr(int(rand(256))) for 1..32;
417 my $token = Digest::SHA::hmac_sha256_hex($u->{id} . '|' . time() . '|' . $rand, $key);
418
419 my $ip = $ENV{REMOTE_ADDR} || ''; $ip =~ s/'/''/g; $ip = substr($ip, 0, 45);
420 my $ua = 'admin:' . ($admin_user_id || '?');
421 $ua =~ s/'/''/g; $ua = substr($ua, 0, 255);
422
423 $db->db_readwrite($dbh, qq~
424 INSERT INTO `${DB}`.password_resets
425 SET user_id='$u->{id}',
426 token='$token',
427 requested_ip='$ip',
428 requested_user_agent='$ua',
429 expires_at=DATE_ADD(NOW(), INTERVAL 60 MINUTE)
430 ~, $ENV{SCRIPT_NAME}, __LINE__);
431
432 # Build the link from the request host.
433 my $proto = 'https';
434 $proto = 'http' unless ($ENV{HTTPS} || '') =~ /^on$/i
435 || ($ENV{HTTP_X_FORWARDED_PROTO} || '') =~ /^https$/i;
436 my $host = $ENV{HTTP_HOST} || 'webstls.com';
437 my $link = "$proto://$host/reset_password.cgi?t=$token";
438
439 # Send the email. Failure (no SMTP, MTA down, etc.) does NOT block
440 # the admin -- they still see the link inline.
441 my $mailer = MODS::WebSTLs::Mailer->new;
442 my $mail_ok = 0;
443 my $mail_error = '';
444 if ($mailer->is_configured) {
445 my $brand = $cfg->settings('brand_name') || 'WebSTLs';
446 my $name = $u->{display_name} || 'there';
447 my $body_text = "Hi $name,\n\n"
448 . "A $brand administrator just initiated a password reset on your account.\n\n"
449 . "Use this link within the next 60 minutes:\n\n $link\n\n"
450 . "If you did not expect this, you can ignore the email and your password stays unchanged.\n\n"
451 . "-- $brand\n";
452 my $body_html = '<p>Hi ' . _h($name) . ',</p>'
453 . '<p>A ' . _h($brand) . ' administrator just initiated a password reset on your account.</p>'
454 . '<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>'
455 . '<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>'
456 . '<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>';
457 my $res = $mailer->send(
458 to => $u->{email},
459 subject => "Password reset for your $brand account",
460 body => $body_text,
461 html => $body_html,
462 );
463 $mail_ok = $res->{ok} ? 1 : 0;
464 $mail_error = $res->{error} || '';
465 } else {
466 $mail_error = 'Email pipeline not configured. Add SMTP settings in Software Configuration or install sendmail.';
467 }
468
469 $db->db_disconnect($dbh);
470
471 print "Content-Type: text/html; charset=utf-8\nCache-Control: no-store, no-cache, must-revalidate, max-age=0\nPragma: no-cache\nExpires: 0\n\n";
472 my $sent_block = $mail_ok
473 ? '<div class="banner mb-3" style="background:rgba(34,197,94,0.10);border:1px solid rgba(34,197,94,0.35);color:#86efac">' .
474 '<strong>Email sent to ' . _h($u->{email}) . '.</strong> The link below is also valid if you need to share it directly.' .
475 '</div>'
476 : '<div class="banner warn mb-3"><strong>Email could NOT be sent:</strong> ' . _h($mail_error) . ' Share the link below manually.</div>';
477 my $body = qq~
478 <div class="page-head">
479 <div>
480 <span class="page-eyebrow"><span class="dot"></span> Admin &middot; Reset password</span>
481 <h1 class="page-title">Reset link issued</h1>
482 <p class="page-subtitle">Valid for 60 minutes, single-use.</p>
483 </div>
484 <div class="page-actions">
485 <a href="/admin_user.cgi?u=$target_id" class="btn btn-secondary">Back to user</a>
486 </div>
487 </div>
488 $sent_block
489 <div class="banner info mb-3" style="word-break:break-all">
490 <strong>Reset URL:</strong>
491 <code>$link</code>
492 </div>
493 ~;
494 $wrap->render({
495 userinfo => $userinfo,
496 page_key => 'admin',
497 title => 'Reset password',
498 body => $body,
499 });
500 exit;
501}
502
503# ---- edit_account --------------------------------------------------------
504if ($act eq 'edit_account') {
505 my $email = $form->{email} || '';
506 my $name = $form->{display_name} || '';
507 my $plan = $form->{plan_tier} || '';
508 my $stat = $form->{account_status} || '';
509
510 $email =~ s/[^A-Za-z0-9._+@\-]//g;
511 $name =~ s/[\\']//g;
512 $plan = '' unless $plan =~ /^(free|starter|pro|studio)$/;
513 $stat = '' unless $stat =~ /^(active|suspended|closed|pending_verification)$/;
514
515 # Same self-lockout guard as suspend/close.
516 if ($stat && $stat ne 'active' && $target_id eq $admin_user_id) {
517 $stat = '';
518 }
519
520 my @sets;
521 push @sets, "email='$email'" if $email;
522 push @sets, "display_name='$name'" if $name;
523 push @sets, "plan_tier='$plan'" if $plan;
524 push @sets, "account_status='$stat'" if $stat;
525 push @sets, "updated_at=NOW()";
526
527 if (@sets > 1) {
528 my $sets_sql = join(',', @sets);
529 $db->db_readwrite($dbh, qq~
530 UPDATE `${DB}`.users
531 SET $sets_sql
532 WHERE id='$target_id'
533 ~, $ENV{SCRIPT_NAME}, __LINE__);
534
535 # If we suspended/closed via this form, revoke sessions too.
536 if ($stat && $stat ne 'active') {
537 $db->db_readwrite($dbh, qq~
538 UPDATE `${DB}`.user_sessions
539 SET revoked_at=NOW()
540 WHERE user_id='$target_id' AND revoked_at IS NULL
541 ~, $ENV{SCRIPT_NAME}, __LINE__);
542 }
543 }
544
545 $db->db_disconnect($dbh);
546 _go_user($target_id);
547}
548
549# Unknown action -- back to the admin home.
550$db->db_disconnect($dbh);
551_go('/admin.cgi');