added on WebSTLs (webstls.com) at 2026-07-01 22:26:16
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # WebSTLs - Software Configuration (super-admin only) | |
| 4 | # | |
| 5 | # Edit DB-backed platform settings: Stripe keys, branding, email, | |
| 6 | # storage, default currency/timezone. Anything not in | |
| 7 | # MODS::WebSTLs::Config::%EDITABLE stays in code (database_name, | |
| 8 | # session/cookie, asset paths, feature-flag fallbacks) and is shown | |
| 9 | # read-only here so the admin can see the full configuration surface. | |
| 10 | # | |
| 11 | # Gated by Permissions::require_super_admin -- regular admins do NOT | |
| 12 | # see this page. The /admin_config_action.cgi handler runs the same | |
| 13 | # gate so a stale-tab POST from a downgraded admin still bounces. | |
| 14 | #====================================================================== | |
| 15 | use strict; | |
| 16 | use warnings; | |
| 17 | ||
| 18 | use lib '/var/www/vhosts/webstls.com/httpdocs'; | |
| 19 | use CGI; | |
| 20 | use MODS::Template; | |
| 21 | use MODS::DBConnect; | |
| 22 | use MODS::Login; | |
| 23 | use MODS::WebSTLs::Config; | |
| 24 | use MODS::WebSTLs::Wrapper; | |
| 25 | use MODS::WebSTLs::Permissions; | |
| 26 | ||
| 27 | my $q = CGI->new; | |
| 28 | my $form = $q->Vars; | |
| 29 | my $auth = MODS::Login->new; | |
| 30 | my $wrap = MODS::WebSTLs::Wrapper->new; | |
| 31 | my $tfile = MODS::Template->new; | |
| 32 | my $db = MODS::DBConnect->new; | |
| 33 | my $cfg = MODS::WebSTLs::Config->new; | |
| 34 | my $perm = MODS::WebSTLs::Permissions->new; | |
| 35 | my $DB = $cfg->settings('database_name'); | |
| 36 | ||
| 37 | $|=1; | |
| 38 | my $userinfo = $auth->login_verify(); | |
| 39 | if (!$userinfo) { | |
| 40 | print "Status: 302 Found\nLocation: /login.cgi\n\n"; | |
| 41 | exit; | |
| 42 | } | |
| 43 | ||
| 44 | my $entry = ($ENV{SCRIPT_NAME} || '') =~ m{/([^/]+)\.cgi$} ? $1 : 'admin_config'; | |
| 45 | ||
| 46 | if ($entry eq 'admin_config_action') { | |
| 47 | $perm->require_super_admin($userinfo); | |
| 48 | _handle_action($q, $form, $userinfo); | |
| 49 | exit; | |
| 50 | } | |
| 51 | ||
| 52 | $perm->require_super_admin($userinfo); | |
| 53 | ||
| 54 | # Group editable settings for the template. Order is fixed (Stripe | |
| 55 | # first -- most-asked-for, then Branding / Email / Storage / Defaults). | |
| 56 | # The template uses a nested loop: outer over group_blocks, inner over | |
| 57 | # loop1.rows. | |
| 58 | my @groups_order = qw(Stripe Branding Email Storage Defaults); | |
| 59 | my %by_group; | |
| 60 | foreach my $row ($cfg->editable_settings_meta) { | |
| 61 | push @{ $by_group{ $row->{group} } }, $row; | |
| 62 | } | |
| 63 | # Per-group help content (rich descriptions opened via ? button popup). | |
| 64 | my %group_help = ( | |
| 65 | 'Stripe' => { | |
| 66 | summary => 'Card-processing credentials. Without them, paid plans cannot collect money.', | |
| 67 | detail => q[<p><strong>Publishable key</strong> (starts <code>pk_</code>) is safe to expose in client-side code — it goes into the checkout JavaScript.</p> | |
| 68 | <p><strong>Secret key</strong> (starts <code>sk_</code>) <em>never</em> leaves the server. Anyone with this key can charge cards on your account — rotate it if exposed.</p> | |
| 69 | <p><strong>Webhook signing secret</strong> (starts <code>whsec_</code>) verifies that incoming webhook events actually came from Stripe (and not an attacker spoofing payment events). Generate it from the Stripe Dashboard <em>Developers → Webhooks → (your endpoint) → Signing secret</em>.</p> | |
| 70 | <p><strong>Connect client id</strong> (starts <code>ca_</code>) identifies your platform when sellers onboard their connected Stripe accounts via Stripe Express. Required for buyer-to-seller destination charges; not used for subscription billing.</p> | |
| 71 | <p><strong>Platform fee (basis points)</strong> is WebSTLs's cut of each buyer-to-seller transaction. 100 = 1%, 1000 = 10%, 250 = 2.5%. Stripe takes this as <code>application_fee_amount</code> from the seller payout.</p> | |
| 72 | <p><strong>Live vs. test:</strong> test keys (<code>pk_test_...</code>, <code>sk_test_...</code>) only process test card numbers. Live keys (<code>pk_live_...</code>) process real money. Always start in test mode.</p>], | |
| 73 | }, | |
| 74 | 'Branding' => { | |
| 75 | summary => 'How your store appears to creators and customers.', | |
| 76 | detail => q[<p><strong>Site name & tagline</strong> show in the topbar, marketing pages, and email footers.</p> | |
| 77 | <p><strong>Site title</strong> is the <title> tag of marketing pages — this is what shows in browser tabs and Google search results, so include a clear value-prop.</p> | |
| 78 | <p>Changes take effect on next page load (template cache).</p>], | |
| 79 | }, | |
| 80 | 'Email' => { | |
| 81 | summary => 'Outbound email delivery for receipts, signup confirmations, and notifications.', | |
| 82 | detail => q[<p><strong>SMTP host / port / user / password:</strong> credentials for the SMTP server WebSTLs will use to send mail. Common choices: SendGrid (<em>smtp.sendgrid.net:587</em>), Mailgun, Amazon SES, or your own mail server.</p> | |
| 83 | <p><strong>From address:</strong> the “From:” header on outbound mail. Use a real address on a domain whose DNS you control (SPF / DKIM passing) or deliverability tanks.</p> | |
| 84 | <p><strong>Support inbox:</strong> where customer replies are routed for the support flow.</p>], | |
| 85 | }, | |
| 86 | 'Storage' => { | |
| 87 | summary => 'Where uploaded model files, thumbnails, and assets are stored.', | |
| 88 | detail => q[<p><strong>Upload limits and paths</strong> control how large model files can be and where they live on disk. WebSTLs uses local filesystem storage for STL files and renders; cloud storage (S3, R2) integration would be a future feature.</p> | |
| 89 | <p><strong>Tip:</strong> set the limit just above your largest expected model file. Allowing very large uploads (> 100 MB) consumes server bandwidth and disk fast.</p>], | |
| 90 | }, | |
| 91 | 'Defaults' => { | |
| 92 | summary => 'Sensible defaults applied to new accounts and listings.', | |
| 93 | detail => q[<p><strong>Default timezone & currency</strong> are applied when a new creator signs up. Each creator can override their own settings later in their storefront preferences.</p>], | |
| 94 | }, | |
| 95 | ); | |
| 96 | ||
| 97 | my @group_blocks; | |
| 98 | foreach my $g (@groups_order) { | |
| 99 | next unless $by_group{$g}; | |
| 100 | my $h = $group_help{$g} || { summary => '', detail => '' }; | |
| 101 | my $slug = lc $g; $slug =~ s/[^a-z0-9]/_/g; | |
| 102 | my $has_help = (length($h->{summary}) || length($h->{detail})) ? 1 : 0; | |
| 103 | push @group_blocks, { | |
| 104 | name => $g, | |
| 105 | rows => $by_group{$g}, | |
| 106 | help_summary => $h->{summary}, | |
| 107 | help_detail => $h->{detail}, | |
| 108 | has_help => $has_help, | |
| 109 | slug => $slug, | |
| 110 | }; | |
| 111 | } | |
| 112 | ||
| 113 | # Read-only "in code" reference. We surface the deploy-coupled keys | |
| 114 | # so the admin understands the full surface without thinking "where | |
| 115 | # did session_minutes go?". | |
| 116 | my @code_only = ( | |
| 117 | { key => 'database_name', note => 'MODS/WebSTLs/Config.pm. Chicken-and-egg with the lookup itself.' }, | |
| 118 | { key => 'cookie_name', note => 'MODS/WebSTLs/Config.pm. Changing logs everyone out.' }, | |
| 119 | { key => 'secure_cookies', note => 'MODS/WebSTLs/Config.pm. Set to 0 only for local HTTP dev.' }, | |
| 120 | { key => 'assets', note => 'MODS/WebSTLs/Config.pm. Deploy-coupled.' }, | |
| 121 | { key => 'flag_default__*', note => 'MODS/WebSTLs/Config.pm. Used only when the DB is unreachable, so DB-backed values would never apply anyway.' }, | |
| 122 | ); | |
| 123 | ||
| 124 | # Flash from the action handler. | |
| 125 | my $flash_kind = ''; | |
| 126 | my $flash_msg = ''; | |
| 127 | if (defined $form->{ok}) { | |
| 128 | my $n = $form->{ok}; $n =~ s/[^0-9]//g; $n = 0 + ($n || 0); | |
| 129 | $flash_kind = 'ok'; | |
| 130 | $flash_msg = "Saved. $n setting" . ($n == 1 ? '' : 's') . ' updated.'; | |
| 131 | } | |
| 132 | if (defined $form->{err}) { | |
| 133 | my $k = $form->{err}; $k =~ s/[^a-z_]//g; | |
| 134 | $flash_kind = 'danger'; | |
| 135 | $flash_msg = 'bad_key' eq $k ? 'One of the submitted keys is not editable here.' | |
| 136 | : 'db' eq $k ? 'Database error while saving. No changes were applied.' | |
| 137 | : 'Something went wrong.'; | |
| 138 | } | |
| 139 | ||
| 140 | my $tvars = { | |
| 141 | user_id => $userinfo->{user_id}, | |
| 142 | group_blocks => \@group_blocks, | |
| 143 | code_only => \@code_only, | |
| 144 | has_flash => length $flash_msg ? 1 : 0, | |
| 145 | flash_kind => $flash_kind, | |
| 146 | flash_msg => $flash_msg, | |
| 147 | }; | |
| 148 | ||
| 149 | 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"; | |
| 150 | ||
| 151 | my $body = join('', $tfile->template('webstls_admin_config.html', $tvars, $userinfo)); | |
| 152 | ||
| 153 | $wrap->render({ | |
| 154 | userinfo => $userinfo, | |
| 155 | page_key => 'admin_config', | |
| 156 | title => 'Software Configuration', | |
| 157 | body => $body, | |
| 158 | }); | |
| 159 | ||
| 160 | #====================================================================== | |
| 161 | # admin_config_action entry: POST handler. Iterates the editable- | |
| 162 | # settings whitelist and UPSERTs into platform_settings. | |
| 163 | #====================================================================== | |
| 164 | sub _handle_action { | |
| 165 | my ($q, $form, $userinfo) = @_; | |
| 166 | ||
| 167 | my $uid = $userinfo->{user_id}; | |
| 168 | $uid =~ s/[^0-9]//g; | |
| 169 | ||
| 170 | my $dbh = $db->db_connect(); | |
| 171 | ||
| 172 | # Probe table exists -- if not, send the admin back with a clear error | |
| 173 | # rather than crashing. The Software Config page also shows the same | |
| 174 | # state so they know they need to run the migration first. | |
| 175 | my $tab = $db->db_readwrite($dbh, qq~ | |
| 176 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 177 | WHERE table_schema='$DB' AND table_name='platform_settings' | |
| 178 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 179 | unless ($tab && $tab->{n}) { | |
| 180 | $db->db_disconnect($dbh); | |
| 181 | _act_redirect('/admin_config.cgi?err=db'); | |
| 182 | return; | |
| 183 | } | |
| 184 | ||
| 185 | my $updated = 0; | |
| 186 | foreach my $field (keys %$form) { | |
| 187 | next unless $field =~ /^cfg_(.+)$/; | |
| 188 | my $key = $1; | |
| 189 | next unless $cfg->is_editable($key); | |
| 190 | ||
| 191 | my $meta = $cfg->editable_meta_for($key); | |
| 192 | my $value = defined $form->{$field} ? $form->{$field} : ''; | |
| 193 | ||
| 194 | # Secret fields: blank submission = "no change", don't overwrite | |
| 195 | # the existing row. Non-secret blanks DO clear the override so the | |
| 196 | # admin can reset to default by emptying the field. | |
| 197 | if ($meta->{secret} && $value eq '') { | |
| 198 | next; | |
| 199 | } | |
| 200 | ||
| 201 | # Quote-escape for the SQL string. Use single-quoted string + '' | |
| 202 | # escape per project convention. Numeric fields are coerced | |
| 203 | # implicitly by MySQL on read. | |
| 204 | my $sv = $value; | |
| 205 | $sv =~ s/'/''/g; | |
| 206 | my $sk = $key; | |
| 207 | $sk =~ s/[^a-zA-Z0-9_]//g; | |
| 208 | my $sec = $meta->{secret} ? 1 : 0; | |
| 209 | ||
| 210 | # Upsert: ON DUPLICATE KEY UPDATE on the unique setting_key. | |
| 211 | eval { | |
| 212 | $db->db_readwrite($dbh, qq~ | |
| 213 | INSERT INTO `${DB}`.platform_settings | |
| 214 | SET setting_key='$sk', | |
| 215 | setting_value='$sv', | |
| 216 | is_secret='$sec', | |
| 217 | updated_by_user_id='$uid' | |
| 218 | ON DUPLICATE KEY UPDATE | |
| 219 | setting_value=VALUES(setting_value), | |
| 220 | is_secret=VALUES(is_secret), | |
| 221 | updated_by_user_id=VALUES(updated_by_user_id) | |
| 222 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 223 | $updated++; | |
| 224 | 1; | |
| 225 | } or do { | |
| 226 | $db->db_disconnect($dbh); | |
| 227 | _act_redirect('/admin_config.cgi?err=db'); | |
| 228 | return; | |
| 229 | }; | |
| 230 | } | |
| 231 | ||
| 232 | $db->db_disconnect($dbh); | |
| 233 | _act_redirect('/admin_config.cgi?ok=' . $updated); | |
| 234 | } | |
| 235 | ||
| 236 | sub _act_redirect { | |
| 237 | my $url = shift; | |
| 238 | print "Status: 302 Found\nLocation: $url\n\n"; | |
| 239 | } |