added on local at 2026-07-01 16:00:52
| 1 | #!/usr/bin/perl | |
| 2 | #====================================================================== | |
| 3 | # ABForge - 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::ABForge::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/abforge.com/httpdocs'; | |
| 19 | use CGI; | |
| 20 | use MODS::Template; | |
| 21 | use MODS::DBConnect; | |
| 22 | use MODS::Login; | |
| 23 | use MODS::ABForge::Config; | |
| 24 | use MODS::ABForge::Wrapper; | |
| 25 | use MODS::ABForge::Permissions; | |
| 26 | ||
| 27 | my $q = CGI->new; | |
| 28 | my $form = $q->Vars; | |
| 29 | my $auth = MODS::Login->new; | |
| 30 | my $wrap = MODS::ABForge::Wrapper->new; | |
| 31 | my $tfile = MODS::Template->new; | |
| 32 | my $cfg = MODS::ABForge::Config->new; | |
| 33 | my $perm = MODS::ABForge::Permissions->new; | |
| 34 | my $db = MODS::DBConnect->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); | |
| 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 | my @group_blocks; | |
| 64 | foreach my $g (@groups_order) { | |
| 65 | next unless $by_group{$g}; | |
| 66 | push @group_blocks, { name => $g, rows => $by_group{$g} }; | |
| 67 | } | |
| 68 | ||
| 69 | # Read-only "in code" reference. We surface the deploy-coupled keys | |
| 70 | # so the admin understands the full surface without thinking "where | |
| 71 | # did session_minutes go?". | |
| 72 | my @code_only = ( | |
| 73 | { key => 'database_name', note => 'MODS/ABForge/Config.pm. Chicken-and-egg with the lookup itself.' }, | |
| 74 | { key => 'cookie_name', note => 'MODS/ABForge/Config.pm. Changing logs everyone out.' }, | |
| 75 | { key => 'secure_cookies', note => 'MODS/ABForge/Config.pm. Set to 0 only for local HTTP dev.' }, | |
| 76 | { key => 'assets', note => 'MODS/ABForge/Config.pm. Deploy-coupled.' }, | |
| 77 | { key => 'flag_default__*', note => 'MODS/ABForge/Config.pm. Used only when the DB is unreachable, so DB-backed values would never apply anyway.' }, | |
| 78 | ); | |
| 79 | ||
| 80 | # Flash from the action handler. | |
| 81 | my $flash_kind = ''; | |
| 82 | my $flash_msg = ''; | |
| 83 | if (defined $form->{ok}) { | |
| 84 | my $n = $form->{ok}; $n =~ s/[^0-9]//g; $n = 0 + ($n || 0); | |
| 85 | $flash_kind = 'ok'; | |
| 86 | $flash_msg = "Saved. $n setting" . ($n == 1 ? '' : 's') . ' updated.'; | |
| 87 | } | |
| 88 | if (defined $form->{err}) { | |
| 89 | my $k = $form->{err}; $k =~ s/[^a-z_]//g; | |
| 90 | $flash_kind = 'danger'; | |
| 91 | $flash_msg = 'bad_key' eq $k ? 'One of the submitted keys is not editable here.' | |
| 92 | : 'db' eq $k ? 'Database error while saving. No changes were applied.' | |
| 93 | : 'Something went wrong.'; | |
| 94 | } | |
| 95 | ||
| 96 | my $tvars = { | |
| 97 | user_id => $userinfo->{user_id}, | |
| 98 | group_blocks => \@group_blocks, | |
| 99 | code_only => \@code_only, | |
| 100 | has_flash => length $flash_msg ? 1 : 0, | |
| 101 | flash_kind => $flash_kind, | |
| 102 | flash_msg => $flash_msg, | |
| 103 | }; | |
| 104 | ||
| 105 | print "Content-Type: text/html; charset=utf-8\nCache-Control: no-cache\n\n"; | |
| 106 | ||
| 107 | my $body = join('', $tfile->template('abforge_admin_config.html', $tvars, $userinfo)); | |
| 108 | ||
| 109 | $wrap->render({ | |
| 110 | userinfo => $userinfo, | |
| 111 | page_key => 'admin_config', | |
| 112 | title => 'Software Configuration', | |
| 113 | body => $body, | |
| 114 | }); | |
| 115 | ||
| 116 | #====================================================================== | |
| 117 | # admin_config_action entry: POST handler | |
| 118 | # | |
| 119 | # POST-only. Iterates the editable-settings whitelist, takes whatever | |
| 120 | # the admin submitted, and UPSERTs into platform_settings. Skips | |
| 121 | # secret fields when the form value is blank (browsers can't repost | |
| 122 | # the masked value; an empty submit means "no change"). | |
| 123 | # | |
| 124 | # Empty non-secret values are saved as empty rows so the lookup falls | |
| 125 | # through to the file/code default. This lets the admin "blank" an | |
| 126 | # override. | |
| 127 | #====================================================================== | |
| 128 | sub _handle_action { | |
| 129 | my ($q, $form) = @_; | |
| 130 | ||
| 131 | my $uid = $userinfo->{user_id}; | |
| 132 | $uid =~ s/[^0-9]//g; | |
| 133 | ||
| 134 | my $dbh = $db->db_connect(); | |
| 135 | ||
| 136 | # Probe table exists -- if not, send the admin back with a clear error | |
| 137 | # rather than crashing. The Software Config page also shows the same | |
| 138 | # state so they know they need to run the migration first. | |
| 139 | my $tab = $db->db_readwrite($dbh, qq~ | |
| 140 | SELECT COUNT(*) AS n FROM information_schema.tables | |
| 141 | WHERE table_schema='$DB' AND table_name='platform_settings' | |
| 142 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 143 | unless ($tab && $tab->{n}) { | |
| 144 | $db->db_disconnect($dbh); | |
| 145 | _act_redirect('/admin_config.cgi?err=db'); | |
| 146 | return; | |
| 147 | } | |
| 148 | ||
| 149 | my $updated = 0; | |
| 150 | foreach my $field (keys %$form) { | |
| 151 | next unless $field =~ /^cfg_(.+)$/; | |
| 152 | my $key = $1; | |
| 153 | next unless $cfg->is_editable($key); | |
| 154 | ||
| 155 | my $meta = $cfg->editable_meta_for($key); | |
| 156 | my $value = defined $form->{$field} ? $form->{$field} : ''; | |
| 157 | ||
| 158 | # Secret fields: blank submission = "no change", don't overwrite | |
| 159 | # the existing row. Non-secret blanks DO clear the override so the | |
| 160 | # admin can reset to default by emptying the field. | |
| 161 | if ($meta->{secret} && $value eq '') { | |
| 162 | next; | |
| 163 | } | |
| 164 | ||
| 165 | # Quote-escape for the SQL string. Use single-quoted string + '' | |
| 166 | # escape per project convention. Numeric fields are coerced | |
| 167 | # implicitly by MySQL on read. | |
| 168 | my $sv = $value; | |
| 169 | $sv =~ s/'/''/g; | |
| 170 | my $sk = $key; | |
| 171 | $sk =~ s/[^a-zA-Z0-9_]//g; | |
| 172 | my $sec = $meta->{secret} ? 1 : 0; | |
| 173 | ||
| 174 | # Upsert: ON DUPLICATE KEY UPDATE on the unique setting_key. | |
| 175 | eval { | |
| 176 | $db->db_readwrite($dbh, qq~ | |
| 177 | INSERT INTO `${DB}`.platform_settings | |
| 178 | SET setting_key='$sk', | |
| 179 | setting_value='$sv', | |
| 180 | is_secret='$sec', | |
| 181 | updated_by_user_id='$uid' | |
| 182 | ON DUPLICATE KEY UPDATE | |
| 183 | setting_value=VALUES(setting_value), | |
| 184 | is_secret=VALUES(is_secret), | |
| 185 | updated_by_user_id=VALUES(updated_by_user_id) | |
| 186 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 187 | $updated++; | |
| 188 | 1; | |
| 189 | } or do { | |
| 190 | $db->db_disconnect($dbh); | |
| 191 | _act_redirect('/admin_config.cgi?err=db'); | |
| 192 | return; | |
| 193 | }; | |
| 194 | } | |
| 195 | ||
| 196 | $db->db_disconnect($dbh); | |
| 197 | _act_redirect('/admin_config.cgi?ok=' . $updated); | |
| 198 | } | |
| 199 | ||
| 200 | sub _act_redirect { | |
| 201 | my $url = shift; | |
| 202 | print "Status: 302 Found\nLocation: $url\n\n"; | |
| 203 | } |