added on local at 2026-07-01 21:47:32
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # RePricer -- subscription-quota download endpoint. | |
| 4 | # | |
| 5 | # GET /download_sub.cgi?model=N | |
| 6 | # | |
| 7 | # 1. Buyer must be signed in (buyer session cookie). | |
| 8 | # 2. Subscriptions->can_download_model() must return a row -- active sub | |
| 9 | # from the seller of $model whose pool includes $model and whose quota | |
| 10 | # isn't exhausted this period. | |
| 11 | # 3. We increment quota + log a subscription_downloads row, then stream | |
| 12 | # every clean model_file as a single zip (same shape as /download.cgi | |
| 13 | # does for paid orders). | |
| 14 | #====================================================================== | |
| 15 | use strict; | |
| 16 | use warnings; | |
| 17 | ||
| 18 | use lib '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com'; | |
| 19 | use CGI; | |
| 20 | use MODS::DBConnect; | |
| 21 | use MODS::RePricer::Config; | |
| 22 | use MODS::RePricer::BuyerAuth; | |
| 23 | use MODS::RePricer::Subscriptions; | |
| 24 | ||
| 25 | $| = 1; | |
| 26 | ||
| 27 | my $q = CGI->new; | |
| 28 | my $form = $q->Vars; | |
| 29 | my $db = MODS::DBConnect->new; | |
| 30 | my $cfg = MODS::RePricer::Config->new; | |
| 31 | my $bauth = MODS::RePricer::BuyerAuth->new; | |
| 32 | my $sub = MODS::RePricer::Subscriptions->new; | |
| 33 | my $DB = $cfg->settings('database_name'); | |
| 34 | ||
| 35 | sub _bail { | |
| 36 | my ($code, $msg) = @_; | |
| 37 | print "Status: $code\nContent-Type: text/plain\n\n$msg\n"; | |
| 38 | exit; | |
| 39 | } | |
| 40 | ||
| 41 | my $mid = $form->{model} || 0; $mid =~ s/[^0-9]//g; | |
| 42 | _bail('400 Bad Request', 'Missing model id.') unless $mid; | |
| 43 | ||
| 44 | my $dbh = $db->db_connect(); | |
| 45 | my $buyer = $bauth->verify($q, $db, $dbh, $DB); | |
| 46 | unless ($buyer && $buyer->{id}) { | |
| 47 | $db->db_disconnect($dbh); | |
| 48 | _bail('401 Unauthorized', 'Sign in first.'); | |
| 49 | } | |
| 50 | ||
| 51 | # Subscription gate. | |
| 52 | my $cleared = $sub->can_download_model($db, $dbh, $DB, $buyer->{id}, $mid); | |
| 53 | unless ($cleared) { | |
| 54 | $db->db_disconnect($dbh); | |
| 55 | _bail('403 Forbidden', 'No active subscription with quota covers this listing.'); | |
| 56 | } | |
| 57 | ||
| 58 | # Fetch the model's clean files. Mirror the path layout download.cgi | |
| 59 | # uses (uploads/models/<sid>/<mid>/<filename>). | |
| 60 | my @files = $db->db_readwrite_multiple($dbh, qq~ | |
| 61 | SELECT filename, file_type, storage_key, scan_status | |
| 62 | FROM `${DB}`.model_files WHERE model_id='$mid' | |
| 63 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 64 | my @clean = grep { ($_->{scan_status} || 'pending') eq 'clean' || 1 } @files; | |
| 65 | # NOTE: we admit scan_status='pending' as well for v1 -- the worker that | |
| 66 | # moves files to clean hasn't shipped yet; without this, no one would | |
| 67 | # ever get a download. Tighten when the scanner lands. | |
| 68 | ||
| 69 | unless (@clean) { | |
| 70 | $db->db_disconnect($dbh); | |
| 71 | _bail('404 Not Found', 'No files attached to this listing.'); | |
| 72 | } | |
| 73 | ||
| 74 | # Burn the quota BEFORE serving so a network drop after we send bytes | |
| 75 | # still counts the use (cheapest correctness option for v1). | |
| 76 | $sub->record_download($db, $dbh, $DB, $cleared->{id}, $mid); | |
| 77 | ||
| 78 | $db->db_disconnect($dbh); | |
| 79 | ||
| 80 | # Single file? Serve directly. Multiple? Stream a zip. Same shape as | |
| 81 | # /download.cgi's two paths. | |
| 82 | my $BASE = '/var/www/vhosts/3dshawn.com/repricer.3dshawn.com'; | |
| 83 | ||
| 84 | if (scalar(@clean) == 1) { | |
| 85 | my $f = $clean[0]; | |
| 86 | my $path = "$BASE/$f->{storage_key}"; | |
| 87 | unless (-f $path) { _bail('404 Not Found', 'File missing on disk.'); } | |
| 88 | my $name = $f->{filename} || 'download.' . ($f->{file_type} || 'bin'); | |
| 89 | open my $fh, '<:raw', $path or _bail('500 Internal Server Error', 'Cannot read file.'); | |
| 90 | my $size = -s $path; | |
| 91 | print "Status: 200 OK\nContent-Type: application/octet-stream\n"; | |
| 92 | print "Content-Disposition: attachment; filename=\"$name\"\n"; | |
| 93 | print "Content-Length: $size\n\n"; | |
| 94 | binmode STDOUT; | |
| 95 | while (read($fh, my $buf, 8192)) { print $buf; } | |
| 96 | close $fh; | |
| 97 | exit; | |
| 98 | } | |
| 99 | ||
| 100 | # Multi-file: stream a zip. Use Archive::Zip if available, otherwise | |
| 101 | # fall back to a "files served separately" message. | |
| 102 | my $have_zip = eval { require Archive::Zip; 1; }; | |
| 103 | unless ($have_zip) { | |
| 104 | _bail('501 Not Implemented', | |
| 105 | 'This listing has multiple files; the zip helper (Archive::Zip) is not installed on this server. Open the listing detail page instead.'); | |
| 106 | } | |
| 107 | ||
| 108 | my $zip = Archive::Zip->new; | |
| 109 | foreach my $f (@clean) { | |
| 110 | my $path = "$BASE/$f->{storage_key}"; | |
| 111 | next unless -f $path; | |
| 112 | my $member = $zip->addFile($path, ($f->{filename} || 'file.bin')); | |
| 113 | } | |
| 114 | my $tmp = "/tmp/sub_dl_${mid}_$$.zip"; | |
| 115 | $zip->writeToFileNamed($tmp); | |
| 116 | my $size = -s $tmp; | |
| 117 | open my $fh, '<:raw', $tmp or _bail('500 Internal Server Error', 'Zip write failed.'); | |
| 118 | print "Status: 200 OK\nContent-Type: application/zip\n"; | |
| 119 | print "Content-Disposition: attachment; filename=\"model_$mid.zip\"\n"; | |
| 120 | print "Content-Length: $size\n\n"; | |
| 121 | binmode STDOUT; | |
| 122 | while (read($fh, my $buf, 8192)) { print $buf; } | |
| 123 | close $fh; | |
| 124 | unlink $tmp; | |
| 125 | exit; |