added on WebSTLs (webstls.com) at 2026-07-01 22:27:10
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs -- admin tool: remove on-disk model-upload folders whose | |
| 4 | # model_id no longer exists in the `models` table. | |
| 5 | # | |
| 6 | # Background: when a model is deleted (either via the UI -> trash -> | |
| 7 | # purge_models.cgi flow, or via a direct DB DELETE, e.g. after a | |
| 8 | # bulk marketplace re-import), the DB rows go away (CASCADE on | |
| 9 | # model_files / model_images), but the actual files under | |
| 10 | # /uploads/models/<storefront_id>/<model_id>/ are not touched -- the | |
| 11 | # CASCADE only deletes DB rows. Over time the upload dir fills with | |
| 12 | # orphaned folders. This script reconciles disk with DB. | |
| 13 | # | |
| 14 | # Usage: | |
| 15 | # GET /_cleanup_orphan_uploads.cgi | |
| 16 | # -> dry run; lists orphan folders without touching them. | |
| 17 | # | |
| 18 | # GET /_cleanup_orphan_uploads.cgi?confirm=1 | |
| 19 | # -> actually deletes the orphan folders. Empty storefront | |
| 20 | # parent directories (no model_id folders left inside) get | |
| 21 | # rmdir'd too so the tree stays tidy. | |
| 22 | # | |
| 23 | # Admin-only. Non-admins get a 403. | |
| 24 | #====================================================================== | |
| 25 | use strict; | |
| 26 | use warnings; | |
| 27 | use File::Path qw(remove_tree); | |
| 28 | ||
| 29 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 30 | use CGI; | |
| 31 | use MODS::DBConnect; | |
| 32 | use MODS::Login; | |
| 33 | use MODS::WebSTLs::Config; | |
| 34 | ||
| 35 | $| = 1; | |
| 36 | ||
| 37 | my $q = CGI->new; | |
| 38 | my $db = MODS::DBConnect->new; | |
| 39 | my $auth = MODS::Login->new; | |
| 40 | my $config = MODS::WebSTLs::Config->new; | |
| 41 | my $DB = $config->settings('database_name'); | |
| 42 | ||
| 43 | my $userinfo = $auth->login_verify(); | |
| 44 | unless ($userinfo && $userinfo->{user_id}) { | |
| 45 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 46 | exit; | |
| 47 | } | |
| 48 | unless ($userinfo->{is_admin}) { | |
| 49 | print "Status: 403 Forbidden\nContent-Type: text/plain\n\nAdmin access required.\n"; | |
| 50 | exit; | |
| 51 | } | |
| 52 | ||
| 53 | my $confirm = $q->param('confirm') ? 1 : 0; | |
| 54 | ||
| 55 | # Hard-wired upload root. Same path used by upload.cgi and | |
| 56 | # ImportAdapters.pm so the layout is shared. | |
| 57 | my $BASE_DIR = '/var/www/vhosts/webstls.com/httpdocs/uploads/models'; | |
| 58 | ||
| 59 | 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"; | |
| 60 | print <<'HTML'; | |
| 61 | <!doctype html> | |
| 62 | <html><head><meta charset="utf-8"><title>Orphan upload cleanup</title> | |
| 63 | <style> | |
| 64 | body { background:#0a1024; color:#e2e8f0; font-family:system-ui,sans-serif; padding:24px; } | |
| 65 | h1 { color:#a78bfa; margin:0 0 6px; } | |
| 66 | .sub { color:#94a3b8; margin-bottom:18px; } | |
| 67 | .box { background:#0c1729; border:1px solid #1e293b; border-radius:10px; padding:16px; margin-bottom:14px; } | |
| 68 | .ok { color:#4ade80; } | |
| 69 | .warn { color:#fbbf24; } | |
| 70 | .err { color:#f87171; } | |
| 71 | code { background:#1e293b; padding:1px 6px; border-radius:4px; color:#c4b5fd; font-size:13px; } | |
| 72 | ul { padding-left:22px; line-height:1.6; } | |
| 73 | a.btn { display:inline-block; background:linear-gradient(130deg,#7c3aed,#3b82f6); color:#fff; padding:8px 14px; border-radius:8px; text-decoration:none; font-weight:600; margin-right:8px; } | |
| 74 | a.btn.danger { background:linear-gradient(130deg,#b91c1c,#ef4444); } | |
| 75 | </style></head><body> | |
| 76 | <h1>Orphan upload cleanup</h1> | |
| 77 | <div class="sub">Reconciles <code>/uploads/models/<sid>/<model_id>/</code> against the <code>models</code> table. Folders whose <code>model_id</code> no longer exists in the DB are flagged as orphans.</div> | |
| 78 | HTML | |
| 79 | ||
| 80 | unless (-d $BASE_DIR) { | |
| 81 | print qq~<div class="box err">Base directory does not exist: <code>$BASE_DIR</code></div></body></html>~; | |
| 82 | exit; | |
| 83 | } | |
| 84 | ||
| 85 | # Pull every model id currently in the table. Includes purged_at IS NOT | |
| 86 | # NULL rows on purpose -- those are soft-purged but the row still | |
| 87 | # exists, so the disk folder is still legit. | |
| 88 | my $dbh = $db->db_connect(); | |
| 89 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 90 | SELECT id FROM `${DB}`.models | |
| 91 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 92 | my %valid_ids = map { ($_->{id} || 0) => 1 } @rows; | |
| 93 | ||
| 94 | # Also pull valid storefront ids so we can flag (and clean up) whole | |
| 95 | # storefront folders whose row was deleted. | |
| 96 | my @sf_rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 97 | SELECT id FROM `${DB}`.storefronts | |
| 98 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 99 | my %valid_sids = map { ($_->{id} || 0) => 1 } @sf_rows; | |
| 100 | $db->db_disconnect($dbh); | |
| 101 | ||
| 102 | my @orphan_models; # full paths to delete | |
| 103 | my @orphan_storefronts; # storefront folders w/ no row at all | |
| 104 | my $kept_models = 0; | |
| 105 | ||
| 106 | opendir(my $sd, $BASE_DIR) or do { | |
| 107 | print qq~<div class="box err">Cannot open base directory.</div></body></html>~; | |
| 108 | exit; | |
| 109 | }; | |
| 110 | while (my $sid = readdir($sd)) { | |
| 111 | next if $sid eq '.' || $sid eq '..'; | |
| 112 | next unless $sid =~ /^\d+$/; # only numeric storefront folders | |
| 113 | my $sf_path = "$BASE_DIR/$sid"; | |
| 114 | next unless -d $sf_path; | |
| 115 | ||
| 116 | my $sid_valid = $valid_sids{$sid} ? 1 : 0; | |
| 117 | ||
| 118 | opendir(my $md, $sf_path) or next; | |
| 119 | my $contains_keepers = 0; | |
| 120 | while (my $mid = readdir($md)) { | |
| 121 | next if $mid eq '.' || $mid eq '..'; | |
| 122 | next unless $mid =~ /^\d+$/; | |
| 123 | my $mpath = "$sf_path/$mid"; | |
| 124 | next unless -d $mpath; | |
| 125 | ||
| 126 | if ($valid_ids{$mid}) { | |
| 127 | $kept_models++; | |
| 128 | $contains_keepers = 1; | |
| 129 | } else { | |
| 130 | push @orphan_models, { sid => $sid, mid => $mid, path => $mpath }; | |
| 131 | } | |
| 132 | } | |
| 133 | closedir($md); | |
| 134 | ||
| 135 | if (!$sid_valid && !$contains_keepers) { | |
| 136 | push @orphan_storefronts, { sid => $sid, path => $sf_path }; | |
| 137 | } | |
| 138 | } | |
| 139 | closedir($sd); | |
| 140 | ||
| 141 | my $total_orphans = scalar @orphan_models; | |
| 142 | ||
| 143 | if (!$confirm) { | |
| 144 | # Dry run -- just report. | |
| 145 | print qq~<div class="box">~; | |
| 146 | print qq~<div><strong>Found:</strong> <span class="ok">$kept_models</span> kept · <span class="warn">$total_orphans</span> orphan model folder(s)~; | |
| 147 | print qq~ · <span class="warn">~ . scalar(@orphan_storefronts) . qq~</span> orphan storefront folder(s)~ if @orphan_storefronts; | |
| 148 | print qq~</div>~; | |
| 149 | if ($total_orphans) { | |
| 150 | print qq~<div style="margin-top:14px">~; | |
| 151 | print qq~<a class="btn danger" href="/_cleanup_orphan_uploads.cgi?confirm=1" | |
| 152 | data-confirm-title="Permanently delete $total_orphans orphan folder(s)?" | |
| 153 | data-confirm-message="The folders have no matching DB row. This cannot be undone." | |
| 154 | data-confirm-label="Delete folders" | |
| 155 | data-confirm-style="danger">Delete $total_orphans orphan folder(s)</a> | |
| 156 | <script src="/assets/javascript/confirm.js?v=1"></script>~; | |
| 157 | print qq~<a class="btn" href="/_cleanup_orphan_uploads.cgi" style="background:#1e293b">Refresh dry run</a>~; | |
| 158 | print qq~</div></div>~; | |
| 159 | ||
| 160 | print qq~<div class="box"><strong>Orphan model folders:</strong><ul>~; | |
| 161 | foreach my $o (@orphan_models) { | |
| 162 | print qq~<li><code>~ . _h($o->{path}) . qq~</code> — storefront $o->{sid}, model_id $o->{mid}</li>~; | |
| 163 | } | |
| 164 | print qq~</ul></div>~; | |
| 165 | if (@orphan_storefronts) { | |
| 166 | print qq~<div class="box"><strong>Orphan storefront folders (whole tree is gone):</strong><ul>~; | |
| 167 | foreach my $o (@orphan_storefronts) { | |
| 168 | print qq~<li><code>~ . _h($o->{path}) . qq~</code></li>~; | |
| 169 | } | |
| 170 | print qq~</ul></div>~; | |
| 171 | } | |
| 172 | } else { | |
| 173 | print qq~ <span class="ok">✓ Nothing to clean — disk and DB are in sync.</span></div>~; | |
| 174 | } | |
| 175 | print "</body></html>"; | |
| 176 | exit; | |
| 177 | } | |
| 178 | ||
| 179 | # Confirmed delete pass. | |
| 180 | my $deleted = 0; | |
| 181 | my $failed = 0; | |
| 182 | my @errors; | |
| 183 | foreach my $o (@orphan_models) { | |
| 184 | # Safety: refuse to delete anything outside BASE_DIR. | |
| 185 | next unless index($o->{path}, $BASE_DIR . '/') == 0; | |
| 186 | my $err; | |
| 187 | eval { | |
| 188 | remove_tree($o->{path}, { safe => 1, error => \my $e }); | |
| 189 | if (ref($e) eq 'ARRAY' && @$e) { | |
| 190 | $err = join('; ', map { my ($p, $m) = %$_; "$p: $m" } @$e); | |
| 191 | } | |
| 192 | 1; | |
| 193 | } or $err = $@; | |
| 194 | if ($err) { | |
| 195 | $failed++; | |
| 196 | push @errors, "$o->{path}: $err"; | |
| 197 | } else { | |
| 198 | $deleted++; | |
| 199 | } | |
| 200 | } | |
| 201 | ||
| 202 | # Walk storefront folders again; if a storefront row is gone AND its | |
| 203 | # folder is now empty (all model folders cleaned above), rmdir it. | |
| 204 | foreach my $o (@orphan_storefronts) { | |
| 205 | next unless index($o->{path}, $BASE_DIR . '/') == 0; | |
| 206 | opendir(my $d, $o->{path}) or next; | |
| 207 | my @left = grep { $_ !~ /^\.\.?$/ } readdir($d); | |
| 208 | closedir($d); | |
| 209 | if (!@left) { rmdir $o->{path}; } | |
| 210 | } | |
| 211 | ||
| 212 | print qq~<div class="box">~; | |
| 213 | print qq~<div class="ok"><strong>✓ Cleanup complete.</strong></div>~; | |
| 214 | print qq~<ul>~; | |
| 215 | print qq~<li><span class="ok">Deleted:</span> $deleted folder(s)</li>~; | |
| 216 | print qq~<li><span class="err">Failed:</span> $failed folder(s)</li>~ if $failed; | |
| 217 | print qq~</ul>~; | |
| 218 | if (@errors) { | |
| 219 | print qq~<div class="err"><strong>Errors:</strong><ul>~; | |
| 220 | foreach my $e (@errors) { print qq~<li>~ . _h($e) . qq~</li>~; } | |
| 221 | print qq~</ul></div>~; | |
| 222 | } | |
| 223 | print qq~<div style="margin-top:14px"><a class="btn" href="/_cleanup_orphan_uploads.cgi">Run dry run again</a> <a class="btn" href="/admin.cgi" style="background:#1e293b">Back to admin</a></div>~; | |
| 224 | print qq~</div>~; | |
| 225 | print "</body></html>"; | |
| 226 | exit; | |
| 227 | ||
| 228 | sub _h { | |
| 229 | my $s = shift; $s = '' unless defined $s; | |
| 230 | $s =~ s/&/&/g; $s =~ s/</</g; $s =~ s/>/>/g; $s =~ s/"/"/g; | |
| 231 | return $s; | |
| 232 | } |