Diff -- /var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Permissions.pm

O Operator
Diff

/var/www/vhosts/3dshawn.com/crm.3dshawn.com/MODS/ContactForge/Permissions.pm

added on local at 2026-07-01 15:02:54

Added
+0
lines
Removed
-0
lines
Context
231
unchanged
Blobs
from 6c29d3681bcb
to 6c29d3681bcb
Restore this content →
Unified diff
Naive LCS-based line diff. Additions in emerald, deletions in rose. Both sides decompressed live from BLOB_STORE.
11package MODS::ContactForge::Permissions;
22#======================================================================
33# ContactForge - role-based permission checks.
44#
55# Backs Wrapper.pm sidebar filtering and the require_feature() page
66# guards CGIs call before rendering. The model:
77#
88# * users.permission_groups_id IS NULL -> owner / unconstrained.
99# Every feature passes; no DB lookup needed.
1010# * users.permission_groups_id IS NOT NULL -> team member.
1111# The permission_groups row carries permission_features_ids (CSV
1212# of feature ids); only those slugs/ids resolve to true.
1313#
1414# Cached on $userinfo per-request: features_csv + slug_to_id. That way
1515# a page that calls has_feature() ten times only hits the DB once.
1616#======================================================================
1717use strict;
1818
1919my $db;
2020if (eval { require MODS::DBConnect; 1 }) {
2121 $db = MODS::DBConnect->new;
2222}
2323my $config;
2424if (eval { require MODS::Config; 1 }) {
2525 $config = MODS::Config->new;
2626}
2727my $DB = $config ? $config->settings('database_name') : '';
2828
2929sub new {
3030 my ($class) = @_;
3131 return bless({}, $class);
3232}
3333
3434#----------------------------------------------------------------------
3535# Returns 1 if $userinfo has access to the given feature, else 0.
3636# $userinfo -- hashref returned by Login::login_verify
3737# $slug_or_id -- 'edit_models' or numeric '13'
3838#
3939# Owners (permission_groups_id NULL) ALWAYS get 1. Unauthenticated
4040# callers get 0.
4141#----------------------------------------------------------------------
4242sub has_feature {
4343 my ($self, $userinfo, $slug_or_id) = @_;
4444 return 0 unless $userinfo && $userinfo->{user_id};
4545
4646 # Owner / unconstrained
4747 my $pg = $userinfo->{permission_groups_id};
4848 return 1 if !defined($pg) || $pg eq '';
4949
5050 my ($csv, $slug_map) = $self->_load_cached($userinfo);
5151 return 0 unless defined $csv;
5252
5353 my $id = ($slug_or_id =~ /^\d+$/) ? $slug_or_id : ($slug_map->{$slug_or_id} || 0);
5454 return 0 unless $id;
5555 return (",$csv," =~ m/,$id,/) ? 1 : 0;
5656}
5757
5858#----------------------------------------------------------------------
5959# Page-entry guard. If $userinfo lacks $slug_or_id, sends a redirect
6060# and exits. Owner accounts always pass through. Admins-impersonating
6161# pass through (impersonation gives admins target-user data scope but
6262# we don't want them locked out of admin tools mid-impersonation).
6363#
6464# $redirect_to is optional; defaults to /dashboard.cgi for reps,
6565# /admin.cgi for admins.
6666#----------------------------------------------------------------------
6767sub require_feature {
6868 my ($self, $userinfo, $slug_or_id, $redirect_to) = @_;
6969
7070 return if $self->has_feature($userinfo, $slug_or_id);
7171
7272 # Admin in impersonation mode: treat as owner-equivalent. Admins
7373 # should not get bounced out of admin pages just because they're
7474 # acting as a team-member-target.
7575 return if $userinfo && $userinfo->{_impersonating};
7676
7777 if (!$redirect_to) {
7878 $redirect_to = ($userinfo && $userinfo->{is_admin})
7979 ? '/admin.cgi?denied=' . $slug_or_id
8080 : '/dashboard.cgi?denied=' . $slug_or_id;
8181 }
8282 print "Status: 302 Found\nLocation: $redirect_to\n\n";
8383 exit;
8484}
8585
8686#----------------------------------------------------------------------
8787# require_owner($userinfo, [$redirect_to])
8888#
8989# Owner-only guard. Blocks team members (rows with non-null
9090# owner_user_id) entirely -- no role grants access. Used by billing,
9191# team management, plan changes, and any other "principal-only" pages.
9292# Admin impersonation passes through, same reasoning as require_feature.
9393#----------------------------------------------------------------------
9494sub require_owner {
9595 my ($self, $userinfo, $redirect_to) = @_;
9696 return if $userinfo && $userinfo->{_impersonating};
9797 return if $userinfo && !$userinfo->{owner_user_id};
9898
9999 $redirect_to ||= '/dashboard.cgi?denied=owner_only';
100100 print "Status: 302 Found\nLocation: $redirect_to\n\n";
101101 exit;
102102}
103103
104104#----------------------------------------------------------------------
105105# is_owner($userinfo) — bool. Convenience for templates / CGIs that
106106# need to *render* something differently rather than redirect.
107107#----------------------------------------------------------------------
108108sub is_owner {
109109 my ($self, $userinfo) = @_;
110110 return 0 unless $userinfo;
111111 return ($userinfo->{owner_user_id}) ? 0 : 1;
112112}
113113
114114#----------------------------------------------------------------------
115115# is_super_admin($userinfo) — bool. Super-admin is the platform owner
116116# (founder seat). Required for /admin_config.cgi which edits Stripe
117117# keys, branding, and other platform-wide secrets. is_admin alone is
118118# NOT enough -- a staff admin can manage users without holding the
119119# keys to the kingdom.
120120#
121121# Implicit invariant: is_super_admin implies is_admin. We check both
122122# because a downgraded super-admin row could otherwise still reach
123123# the platform-wide config surface.
124124#----------------------------------------------------------------------
125125sub is_super_admin {
126126 my ($self, $userinfo) = @_;
127127 return 0 unless $userinfo;
128128 return 0 unless $userinfo->{is_admin};
129129
130130 # Cached per request. Login.pm intentionally does NOT include
131131 # is_super_admin in its SELECT so the login query stays compatible
132132 # with pre-migration installs. We probe lazily here and stash.
133133 return $userinfo->{_super_admin} if exists $userinfo->{_super_admin};
134134
135135 my $uid = $userinfo->{user_id};
136136 $uid =~ s/[^0-9]//g if defined $uid;
137137 return 0 unless $uid;
138138 return 0 unless $db && $DB;
139139
140140 my $dbh = $db->db_connect();
141141 return 0 unless $dbh;
142142
143143 # Guard for the column-not-yet-migrated state so a brand-new
144144 # install doesn't 500 the admin pages.
145145 my $col_check = $db->db_readwrite($dbh, qq~
146146 SELECT COUNT(*) AS n FROM information_schema.columns
147147 WHERE table_schema='$DB' AND table_name='users'
148148 AND column_name='is_super_admin'
149149 ~, $ENV{SCRIPT_NAME}, __LINE__);
150150 unless ($col_check && $col_check->{n}) {
151151 $db->db_disconnect($dbh);
152152 $userinfo->{_super_admin} = 0;
153153 return 0;
154154 }
155155
156156 my $r = $db->db_readwrite($dbh, qq~
157157 SELECT is_super_admin FROM `${DB}`.users WHERE id='$uid' LIMIT 1
158158 ~, $ENV{SCRIPT_NAME}, __LINE__);
159159 $db->db_disconnect($dbh);
160160
161161 my $flag = ($r && $r->{is_super_admin}) ? 1 : 0;
162162 $userinfo->{_super_admin} = $flag;
163163 return $flag;
164164}
165165
166166#----------------------------------------------------------------------
167167# require_super_admin($userinfo, [$redirect_to])
168168#
169169# Page-entry guard for the Software Configuration surface and any
170170# other "platform owner only" controls. Bounces non-super-admins to
171171# /admin.cgi with a denied marker. Impersonation does NOT pass through
172172# here -- a regular admin acting as the super-admin still can't edit
173173# platform secrets.
174174#----------------------------------------------------------------------
175175sub require_super_admin {
176176 my ($self, $userinfo, $redirect_to) = @_;
177177 return if $self->is_super_admin($userinfo);
178178 $redirect_to ||= '/admin.cgi?denied=super_admin';
179179 print "Status: 302 Found\nLocation: $redirect_to\n\n";
180180 exit;
181181}
182182
183183#----------------------------------------------------------------------
184184# Returns ($csv, $slug_map) for this $userinfo. Hydrates from DB on
185185# first call and stashes on $userinfo so subsequent calls don't query.
186186#
187187# For owners returns (undef, {}). Callers should check the
188188# permission_groups_id before calling -- this method assumes a team
189189# member context.
190190#----------------------------------------------------------------------
191191sub _load_cached {
192192 my ($self, $userinfo) = @_;
193193
194194 if (exists $userinfo->{_perm_features_csv}) {
195195 return ($userinfo->{_perm_features_csv}, $userinfo->{_perm_slug_to_id} || {});
196196 }
197197
198198 my $pg = $userinfo->{permission_groups_id};
199199 return (undef, {}) unless $pg;
200200
201201 my $safe_pg = $pg;
202202 $safe_pg =~ s/[^0-9]//g;
203203 return (undef, {}) unless $safe_pg;
204204
205205 my $dbh = $db->db_connect();
206206 return (undef, {}) unless $dbh;
207207
208208 # Pull the CSV for this user's group + the full slug->id map in
209209 # one trip. The slug map is global (not per-user) so caching it on
210210 # $userinfo is fine -- it's also tiny (28 rows today).
211211 my $row = $db->db_readwrite($dbh, qq~
212212 SELECT permission_features_ids FROM `${DB}`.permission_groups
213213 WHERE id='$safe_pg' AND group_status=1 LIMIT 1
214214 ~, $ENV{SCRIPT_NAME}, __LINE__);
215215 my $csv = ($row && defined $row->{permission_features_ids})
216216 ? $row->{permission_features_ids} : '';
217217
218218 my @rows = $db->db_readwrite_multiple($dbh, qq~
219219 SELECT id, slug FROM `${DB}`.permission_features
220220 ~, $ENV{SCRIPT_NAME}, __LINE__);
221221 my %map;
222222 foreach my $r (@rows) { $map{$r->{slug}} = $r->{id}; }
223223
224224 $db->db_disconnect($dbh);
225225
226226 $userinfo->{_perm_features_csv} = $csv;
227227 $userinfo->{_perm_slug_to_id} = \%map;
228228 return ($csv, \%map);
229229}
230230
2312311;