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

O Operator
Diff

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

added on WebSTLs (webstls.com) at 2026-07-11 18:31:14

Added
+450
lines
Removed
-0
lines
Context
0
unchanged
Blobs
from
to 4277fac194db
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 - SUPER-ADMIN: All Users list + per-user detail.
4#
5# Consolidates the former /admin_user.cgi (per-user detail, ?u=<id>)
6# via SCRIPT_NAME dispatch. The admin_user.cgi file is now a wrapper
7# that `do`s this file.
8#
9# /admin_users.cgi list view (formerly this file)
10# /admin_user.cgi?u=<id> per-user detail (formerly admin_user.cgi)
11#======================================================================
12use strict; use warnings;
13use lib '/var/www/vhosts/webstls.com/httpdocs';
14use CGI;
15use MODS::Template;
16use MODS::DBConnect;
17use MODS::Login;
18use MODS::WebSTLs::Config;
19use MODS::WebSTLs::Wrapper;
20use MODS::WebSTLs::Admin;
21use MODS::WebSTLs::Storage;
22
23my $q = CGI->new;
24my $form = $q->Vars;
25my $auth = MODS::Login->new;
26my $wrap = MODS::WebSTLs::Wrapper->new;
27my $tfile = MODS::Template->new;
28my $db = MODS::DBConnect->new;
29my $cfg = MODS::WebSTLs::Config->new;
30my $admin = MODS::WebSTLs::Admin->new;
31my $DB = $cfg->settings('database_name');
32
33my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_users';
34
35my $userinfo = $auth->login_verify();
36if (!$userinfo) { print "Status: 302 Found\nLocation: /login.cgi\n\n"; exit; }
37$admin->require_admin($userinfo);
38require MODS::WebSTLs::Permissions;
39MODS::WebSTLs::Permissions->new->require_feature($userinfo, 'admin_view_users');
40
41if ($entry eq 'admin_user') {
42 _usr_detail();
43 exit;
44}
45
46# ---- LIST PATH (formerly admin_users.cgi) ---------------------------
47
48my $sq = $form->{q} || '';
49$sq =~ s/[^A-Za-z0-9_\-\.\s\@]//g;
50
51my $dbh = $db->db_connect();
52
53my $where = '1=1';
54$where .= " AND (u.email LIKE '%$sq%' OR u.display_name LIKE '%$sq%' OR s.name LIKE '%$sq%' OR s.subdomain LIKE '%$sq%')" if $sq;
55
56my $sort_raw = $form->{sort} || 'recent';
57$sort_raw =~ s/[^a-z_]//gi;
58my %sorts = (
59 recent => 'u.created_at DESC',
60 storage => 'u.storage_used_bytes DESC',
61 plan => "FIELD(u.plan_tier,'studio','pro','starter','free'), u.created_at DESC",
62 name => 'u.display_name ASC, u.email ASC',
63);
64my $orderby = $sorts{$sort_raw} || $sorts{recent};
65
66my @users = $db->db_readwrite_multiple($dbh, qq~
67 SELECT u.id, u.email, u.display_name, u.plan_tier, u.account_status,
68 u.is_admin, u.last_login_at, u.created_at,
69 UNIX_TIMESTAMP(u.last_login_at) AS last_login_epoch,
70 UNIX_TIMESTAMP(u.created_at) AS created_epoch,
71 u.storage_used_bytes,
72 s.id AS storefront_id, s.name AS storefront_name, s.subdomain
73 FROM `${DB}`.users u
74 LEFT JOIN `${DB}`.storefronts s ON s.user_id = u.id
75 WHERE $where
76 GROUP BY u.id
77 ORDER BY $orderby
78 LIMIT 200
79~, $ENV{SCRIPT_NAME}, __LINE__);
80
81my $storage = MODS::WebSTLs::Storage->new;
82
83my @palette = ('#5aa9ff','#34d399','#fbbf24','#a78bfa','#f87171','#22c55e','#06b6d4','#ec4899','#f59e0b');
84foreach my $u (@users) {
85 my $dn = $u->{display_name} || $u->{email} || ('User #' . $u->{id});
86 $u->{display_name} = _usr_h($dn);
87 $u->{email} = _usr_h($u->{email});
88 $u->{plan_tier} = ucfirst($u->{plan_tier} || 'free');
89 $u->{account_status} = _usr_h($u->{account_status} || 'active');
90 $u->{is_admin_flag} = $u->{is_admin} ? 1 : 0;
91 $u->{last_login_at} = $u->{last_login_at} || '-';
92 $u->{storefront_name} = _usr_h($u->{storefront_name} || '-');
93 $u->{avatar_color} = $palette[ ($u->{id} || 0) % scalar(@palette) ];
94
95 # Storage column: pct of cap, human-readable used / cap, color
96 # bucket. limits_for_user does the override-vs-tier resolution.
97 my $L = $storage->limits_for_user($db, $dbh, $DB, $u->{id});
98 $u->{storage_used_h} = MODS::WebSTLs::Storage::human_size($L->{used_bytes});
99 $u->{storage_cap_h} = MODS::WebSTLs::Storage::human_size($L->{hard_cap_bytes});
100 $u->{storage_pct} = $L->{pct_of_cap};
101 $u->{storage_color} = $L->{over_cap} ? '#ef4444'
102 : ($L->{warn} ? '#f59e0b' : '#22c55e');
103 $u->{storage_label} = "$u->{storage_used_h} / $u->{storage_cap_h}";
104 my @parts = split /\s+/, $dn, 2;
105 my $ini = '';
106 $ini .= uc(substr($parts[0], 0, 1)) if defined $parts[0];
107 $ini .= uc(substr($parts[1], 0, 1)) if defined $parts[1] && length $parts[1];
108 $ini = uc(substr($dn, 0, 2)) unless length $ini;
109 $u->{initials} = $ini;
110 $u->{is_self} = ($u->{id} == $userinfo->{user_id}) ? 1 : 0;
111}
112$db->db_disconnect($dbh);
113
114print "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";
115my $tvars = {
116 users => \@users,
117 has_users => scalar(@users) ? 1 : 0,
118 q => _usr_h($sq),
119 sort => _usr_h($sort_raw),
120 sort_is_recent => ($sort_raw eq 'recent') ? 1 : 0,
121 sort_is_storage => ($sort_raw eq 'storage') ? 1 : 0,
122 sort_is_plan => ($sort_raw eq 'plan') ? 1 : 0,
123 sort_is_name => ($sort_raw eq 'name') ? 1 : 0,
124};
125my $body = join('', $tfile->template('webstls_admin_users.html', $tvars, $userinfo));
126$wrap->render({
127 userinfo => $userinfo,
128 page_key => 'admin_users',
129 title => 'All Users',
130 body => $body,
131});
132
133exit;
134
135#======================================================================
136# admin_user entry: per-user detail (?u=<id>)
137#======================================================================
138sub _usr_detail {
139 require MODS::WebSTLs::Marketplaces;
140 require MODS::WebSTLs::Billing;
141 require MODS::WebSTLs::Compress;
142
143 my $mp = MODS::WebSTLs::Marketplaces->new;
144 my $bill = MODS::WebSTLs::Billing->new;
145
146 $| = 1;
147
148 my $uid = $form->{u} || 0;
149 $uid =~ s/[^0-9]//g;
150 if (!$uid) {
151 print "Status: 302 Found\nLocation: /admin.cgi\n\n";
152 return;
153 }
154
155 my $dbh = $db->db_connect();
156
157 # ---- The target user ---------------------------------------------
158 my $u = $db->db_readwrite($dbh, qq~
159 SELECT id, email, display_name, plan_tier, account_status, is_admin,
160 trust_level, two_factor_enabled, email_verified_at,
161 last_login_at, default_currency, timezone, created_at, updated_at,
162 UNIX_TIMESTAMP(created_at) AS created_epoch,
163 UNIX_TIMESTAMP(last_login_at) AS last_login_epoch,
164 UNIX_TIMESTAMP(email_verified_at) AS email_verified_epoch,
165 UNIX_TIMESTAMP(updated_at) AS updated_epoch
166 FROM `${DB}`.users
167 WHERE id='$uid'
168 LIMIT 1
169 ~, $ENV{SCRIPT_NAME}, __LINE__);
170
171 if (!$u || !$u->{id}) {
172 $db->db_disconnect($dbh);
173 print "Status: 302 Found\nLocation: /admin.cgi\n\n";
174 return;
175 }
176
177 # ---- Storefront(s) -----------------------------------------------
178 my @storefronts = $db->db_readwrite_multiple($dbh, qq~
179 SELECT id, name, subdomain, created_at,
180 UNIX_TIMESTAMP(created_at) AS created_epoch
181 FROM `${DB}`.storefronts
182 WHERE user_id='$uid'
183 ORDER BY id ASC
184 ~, $ENV{SCRIPT_NAME}, __LINE__);
185
186 # ---- Model counts ------------------------------------------------
187 my $m_total = _usr_scalar($db, $dbh,
188 "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND purged_at IS NULL", 'n');
189 my $m_purged = _usr_scalar($db, $dbh,
190 "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND purged_at IS NOT NULL", 'n');
191 my $m_published = _usr_scalar($db, $dbh,
192 "SELECT COUNT(*) AS n FROM `${DB}`.models WHERE user_id='$uid' AND status='published' AND purged_at IS NULL", 'n');
193
194 # Last 10 models so the admin can see what they're working on.
195 my @models = $db->db_readwrite_multiple($dbh, qq~
196 SELECT id, title, status, visibility, currency, base_price_cents,
197 created_at, updated_at,
198 UNIX_TIMESTAMP(created_at) AS created_epoch,
199 UNIX_TIMESTAMP(updated_at) AS updated_epoch
200 FROM `${DB}`.models
201 WHERE user_id='$uid' AND purged_at IS NULL
202 ORDER BY updated_at DESC
203 LIMIT 10
204 ~, $ENV{SCRIPT_NAME}, __LINE__);
205
206 foreach my $m (@models) {
207 $m->{price} = '$' . sprintf('%.2f', ($m->{base_price_cents} || 0) / 100);
208 $m->{title} = $m->{title} || ('Model #' . $m->{id});
209 }
210
211 # ---- Orders / revenue --------------------------------------------
212 # Sum across every storefront the user owns.
213 my $orders_30d_count = 0;
214 my $orders_30d_cents = 0;
215 my $orders_all_cents = 0;
216 my @recent_orders;
217
218 if (@storefronts) {
219 my $sids = join(',', map { "'$_->{id}'" } @storefronts);
220
221 my $rec30 = $db->db_readwrite($dbh, qq~
222 SELECT COUNT(*) AS n, COALESCE(SUM(total_amount_cents),0) AS cents
223 FROM `${DB}`.orders
224 WHERE storefront_id IN ($sids)
225 AND status='paid'
226 AND created_at >= DATE_SUB(NOW(), INTERVAL 30 DAY)
227 ~, $ENV{SCRIPT_NAME}, __LINE__);
228 if ($rec30) {
229 $orders_30d_count = $rec30->{n} || 0;
230 $orders_30d_cents = $rec30->{cents} || 0;
231 }
232
233 my $allr = $db->db_readwrite($dbh, qq~
234 SELECT COALESCE(SUM(total_amount_cents),0) AS cents
235 FROM `${DB}`.orders
236 WHERE storefront_id IN ($sids)
237 AND status='paid'
238 ~, $ENV{SCRIPT_NAME}, __LINE__);
239 $orders_all_cents = ($allr && $allr->{cents}) ? $allr->{cents} : 0;
240
241 @recent_orders = $db->db_readwrite_multiple($dbh, qq~
242 SELECT id, storefront_id, buyer_email, total_amount_cents,
243 currency, status, created_at,
244 UNIX_TIMESTAMP(created_at) AS created_epoch
245 FROM `${DB}`.orders
246 WHERE storefront_id IN ($sids)
247 ORDER BY created_at DESC
248 LIMIT 10
249 ~, $ENV{SCRIPT_NAME}, __LINE__);
250
251 foreach my $o (@recent_orders) {
252 $o->{total} = '$' . sprintf('%.2f', ($o->{total_amount_cents} || 0) / 100);
253 }
254 }
255
256 # ---- Marketplace connections -------------------------------------
257 my @mp_rows;
258 my $have_mp = _usr_scalar($db, $dbh, qq~
259 SELECT COUNT(*) AS n FROM information_schema.tables
260 WHERE table_schema='$DB' AND table_name='marketplace_accounts'
261 ~, 'n');
262 if ($have_mp) {
263 @mp_rows = $db->db_readwrite_multiple($dbh, qq~
264 SELECT platform, status, account_handle, connected_at, last_used_at,
265 UNIX_TIMESTAMP(connected_at) AS connected_epoch,
266 UNIX_TIMESTAMP(last_used_at) AS last_used_epoch
267 FROM `${DB}`.marketplace_accounts
268 WHERE user_id='$uid'
269 ORDER BY platform ASC
270 ~, $ENV{SCRIPT_NAME}, __LINE__);
271 foreach my $r (@mp_rows) {
272 my $p = $mp->by_slug($r->{platform});
273 $r->{name} = $p ? $p->{name} : ucfirst($r->{platform});
274 $r->{connected_at} = $r->{connected_at} || '-';
275 $r->{last_used_at} = $r->{last_used_at} || '-';
276 $r->{connected_epoch} = $r->{connected_epoch} || 0;
277 $r->{last_used_epoch} = $r->{last_used_epoch} || 0;
278 }
279 }
280
281 # ---- Credit balance ----------------------------------------------
282 # Billing helpers self-guard against missing credit_ledger table.
283 my $credit_cents = $bill->credit_balance_cents($db, $dbh, $DB, $uid);
284
285 $db->db_disconnect($dbh);
286
287 # ---- Format / tvars ----------------------------------------------
288 my $is_self = ($uid eq $userinfo->{_admin_user_id} || $uid eq $userinfo->{user_id}) ? 1 : 0;
289
290 my $tvars = {
291 target_id => $u->{id},
292 target_email => _usr_esc($u->{email}),
293 target_display_name => _usr_esc($u->{display_name} || $u->{email}),
294 target_plan_tier => ucfirst($u->{plan_tier} || 'free'),
295 target_plan_raw => $u->{plan_tier} || 'free',
296 target_account_status => $u->{account_status} || 'active',
297 target_is_admin => $u->{is_admin} ? 1 : 0,
298 target_is_super_admin => $u->{is_super_admin} ? 1 : 0,
299 target_not_super_admin => $u->{is_super_admin} ? 0 : 1,
300 # login_verify() does NOT include is_super_admin -- read it through
301 # Permissions->is_super_admin() which probes lazily and caches.
302 viewer_is_super_admin => do {
303 require MODS::WebSTLs::Permissions;
304 MODS::WebSTLs::Permissions->new->is_super_admin($userinfo) ? 1 : 0;
305 },
306 target_2fa => $u->{two_factor_enabled} ? 'On' : 'Off',
307 target_trust_level => $u->{trust_level} || 0,
308 target_currency => $u->{default_currency} || 'USD',
309 target_timezone => $u->{timezone} || 'UTC',
310 target_created_at => $u->{created_at} || '-',
311 target_created_epoch => $u->{created_epoch} || 0,
312 target_last_login_at => $u->{last_login_at} || '-',
313 target_last_login_epoch=> $u->{last_login_epoch} || 0,
314 target_email_verified => $u->{email_verified_at} ? 'Verified' : 'Unverified',
315
316 is_self => $is_self,
317 is_active => (($u->{account_status} || '') eq 'active') ? 1 : 0,
318 is_suspended => (($u->{account_status} || '') eq 'suspended') ? 1 : 0,
319 is_closed => (($u->{account_status} || '') eq 'closed') ? 1 : 0,
320
321 # Sub-data
322 storefronts => \@storefronts,
323 storefront_count => scalar(@storefronts),
324 has_storefront => scalar(@storefronts) ? 1 : 0,
325
326 models => \@models,
327 model_count => scalar(@models),
328 m_total => $m_total,
329 m_published => $m_published,
330 m_purged => $m_purged,
331 has_models => scalar(@models) ? 1 : 0,
332
333 recent_orders => \@recent_orders,
334 has_orders => scalar(@recent_orders) ? 1 : 0,
335 orders_30d_count => $orders_30d_count,
336 orders_30d_revenue => '$' . sprintf('%.2f', $orders_30d_cents / 100),
337 orders_all_revenue => '$' . sprintf('%.2f', $orders_all_cents / 100),
338
339 marketplaces => \@mp_rows,
340 has_marketplaces => scalar(@mp_rows) ? 1 : 0,
341
342 # Credits (account-level credit ledger balance)
343 target_credit_cents => $credit_cents,
344 target_credit_dollars => ($credit_cents < 0 ? '-' : '') . '$' . sprintf('%.2f', abs($credit_cents) / 100),
345 target_has_credit => $credit_cents > 0 ? 1 : 0,
346 target_has_debit => $credit_cents < 0 ? 1 : 0,
347 target_no_credit => $credit_cents == 0 ? 1 : 0,
348 };
349
350 # ---- Storage card ------------------------------------------------
351 # Effective caps + usage. limits_for_user combines tier defaults from
352 # platform_settings with per-user overrides.
353 {
354 my $sdbh = $db->db_connect();
355 my $storage = MODS::WebSTLs::Storage->new;
356 my $L = $storage->limits_for_user($db, $sdbh, $DB, $uid);
357
358 # Pull raw override values so the form pre-fills what the admin
359 # actually set (NULL columns surface as blank inputs = "use tier
360 # default").
361 my $ov = $db->db_readwrite($sdbh, qq~
362 SELECT upload_max_mb_override,
363 storage_hard_cap_gb_override,
364 allowed_extensions_override,
365 last_storage_alert_at,
366 storage_used_at_recompute,
367 UNIX_TIMESTAMP(last_storage_alert_at) AS last_alert_epoch,
368 UNIX_TIMESTAMP(storage_used_at_recompute) AS last_recompute_epoch
369 FROM `${DB}`.users WHERE id='$uid' LIMIT 1
370 ~, $ENV{SCRIPT_NAME}, __LINE__);
371 $db->db_disconnect($sdbh);
372
373 my $used_h = MODS::WebSTLs::Storage::human_size($L->{used_bytes});
374 my $cap_h = MODS::WebSTLs::Storage::human_size($L->{hard_cap_bytes});
375 my $pct = $L->{pct_of_cap};
376 my $bar_col = $pct >= 100 ? '#ef4444'
377 : $pct >= $cfg->settings('storage_soft_alert_pct') ? '#f59e0b'
378 : '#22c55e';
379 my $algos = MODS::WebSTLs::Compress->can('resolved_algo')
380 ? MODS::WebSTLs::Compress->new->resolved_algo
381 : 'none';
382
383 $tvars->{storage_tier} = $L->{tier};
384 $tvars->{storage_used_human} = $used_h;
385 $tvars->{storage_cap_human} = $cap_h;
386 $tvars->{storage_pct_of_cap} = $pct;
387 $tvars->{storage_bar_color} = $bar_col;
388 $tvars->{storage_upload_mb} = $L->{upload_max_mb};
389 $tvars->{storage_upload_src} = $L->{src_upload_mb};
390 $tvars->{storage_hard_gb} = $L->{hard_cap_gb};
391 $tvars->{storage_hard_src} = $L->{src_hard_cap_gb};
392 $tvars->{storage_allowed_csv} = join(', ', @{ $L->{allowed_exts} });
393 $tvars->{storage_allowed_src} = $L->{src_allowed_exts};
394 $tvars->{storage_compression_algo} = $algos;
395 $tvars->{storage_upload_override_value}
396 = defined $ov->{upload_max_mb_override} ? $ov->{upload_max_mb_override} : '';
397 $tvars->{storage_hard_override_value}
398 = defined $ov->{storage_hard_cap_gb_override} ? $ov->{storage_hard_cap_gb_override} : '';
399 $tvars->{storage_ext_override_value}
400 = defined $ov->{allowed_extensions_override} ? $ov->{allowed_extensions_override} : '';
401 $tvars->{storage_last_recompute}
402 = $ov->{storage_used_at_recompute} || '-';
403 $tvars->{storage_last_recompute_epoch}
404 = $ov->{last_recompute_epoch} || 0;
405 $tvars->{storage_last_alert}
406 = $ov->{last_storage_alert_at} || '-';
407 $tvars->{storage_last_alert_epoch}
408 = $ov->{last_alert_epoch} || 0;
409 }
410
411 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";
412
413 my $body = join('', $tfile->template('webstls_admin_user.html', $tvars, $userinfo));
414
415 $wrap->render({
416 userinfo => $userinfo,
417 page_key => 'admin',
418 title => 'Admin: ' . ($u->{display_name} || $u->{email}),
419 body => $body,
420 extra_js => ['/assets/javascript/graphs.js'],
421 });
422
423 return;
424}
425
426sub _usr_scalar {
427 my ($db, $dbh, $sql, $key) = @_;
428 my $r = $db->db_readwrite($dbh, $sql, $ENV{SCRIPT_NAME}, __LINE__);
429 return ($r && defined $r->{$key}) ? $r->{$key} : 0;
430}
431
432sub _usr_esc {
433 my $s = shift;
434 return '' unless defined $s;
435 $s =~ s/&/&amp;/g;
436 $s =~ s/</&lt;/g;
437 $s =~ s/>/&gt;/g;
438 $s =~ s/"/&quot;/g;
439 return $s;
440}
441
442sub _usr_h {
443 my $s = shift;
444 return '' unless defined $s;
445 $s =~ s/&/&amp;/g;
446 $s =~ s/</&lt;/g;
447 $s =~ s/>/&gt;/g;
448 $s =~ s/"/&quot;/g;
449 return $s;
450}