added on local at 2026-07-01 12:34:23
| 1 | package MODS::PTMatrix::Permissions; | |
| 2 | #====================================================================== | |
| 3 | # TaskForge -- fine-grained permission checks. | |
| 4 | # | |
| 5 | # Lookup model: | |
| 6 | # - super_admin: every permission, always. | |
| 7 | # - user has permission_groups_id: union the group's CSV of feature ids | |
| 8 | # against the permission_features catalog. Slug-based has_permission() | |
| 9 | # checks against that set. | |
| 10 | # - user has NO permission_groups_id: fall back to the user's `role` | |
| 11 | # (company_admin|manager|member|observer). The role gives a baseline | |
| 12 | # permission set (defined in %ROLE_DEFAULTS below). | |
| 13 | # | |
| 14 | # Caching: per-request, keyed by user_id. Each user's permission set is | |
| 15 | # resolved on first call and reused. | |
| 16 | #====================================================================== | |
| 17 | ||
| 18 | use strict; | |
| 19 | use warnings; | |
| 20 | ||
| 21 | use MODS::DBConnect; | |
| 22 | use MODS::PTMatrix::Config; | |
| 23 | ||
| 24 | my $db = MODS::DBConnect->new; | |
| 25 | my $config = MODS::PTMatrix::Config->new; | |
| 26 | my $DB = $config->settings('database_name'); | |
| 27 | ||
| 28 | # Per-request cache. Cleared automatically per-request since the package | |
| 29 | # is reloaded by CGI on every hit (in plain CGI mode). Under FCGI/mod_perl | |
| 30 | # it persists, which is fine — permissions rarely change mid-request. | |
| 31 | our %_USER_PERMS_CACHE; | |
| 32 | our %_FEATURE_BY_ID; | |
| 33 | our %_FEATURE_BY_SLUG; | |
| 34 | our $_FEATURES_LOADED = 0; | |
| 35 | ||
| 36 | sub new { | |
| 37 | my ($class) = @_; | |
| 38 | return bless({}, $class); | |
| 39 | } | |
| 40 | ||
| 41 | # ---- Role defaults ------------------------------------------------- | |
| 42 | # What every user with a given role can do when they have NO permission | |
| 43 | # group attached. This is the baseline for small businesses that haven't | |
| 44 | # set up granular permission groups yet. | |
| 45 | my %ROLE_DEFAULTS = ( | |
| 46 | company_admin => [qw( | |
| 47 | view_projects create_projects edit_any_project delete_projects manage_project_members manage_kanban_columns | |
| 48 | view_tasks create_tasks edit_own_tasks edit_any_task delete_tasks assign_tasks comment_on_tasks log_time manage_dependencies | |
| 49 | view_reports view_all_time export_data | |
| 50 | invite_users manage_users manage_departments manage_permission_groups | |
| 51 | manage_company manage_task_types manage_labels | |
| 52 | manage_billing manage_sso view_audit_log export_audit_log | |
| 53 | )], | |
| 54 | manager => [qw( | |
| 55 | view_projects create_projects edit_any_project manage_project_members manage_kanban_columns | |
| 56 | view_tasks create_tasks edit_own_tasks edit_any_task assign_tasks comment_on_tasks log_time manage_dependencies | |
| 57 | view_reports view_all_time | |
| 58 | invite_users | |
| 59 | manage_task_types manage_labels | |
| 60 | )], | |
| 61 | member => [qw( | |
| 62 | view_projects | |
| 63 | view_tasks create_tasks edit_own_tasks assign_tasks comment_on_tasks log_time manage_dependencies | |
| 64 | view_reports | |
| 65 | )], | |
| 66 | observer => [qw( | |
| 67 | view_projects view_tasks view_reports | |
| 68 | )], | |
| 69 | ); | |
| 70 | ||
| 71 | sub _load_features { | |
| 72 | return if $_FEATURES_LOADED; | |
| 73 | $_FEATURES_LOADED = 1; | |
| 74 | my $dbh = $db->db_connect(); | |
| 75 | return unless $dbh; | |
| 76 | my @rows = $db->db_readwrite_multiple($dbh, qq~ | |
| 77 | SELECT id, slug, name, category, sort_order FROM ${DB}.permission_features | |
| 78 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 79 | foreach my $r (@rows) { | |
| 80 | $_FEATURE_BY_ID{$r->{id}} = $r; | |
| 81 | $_FEATURE_BY_SLUG{$r->{slug}} = $r; | |
| 82 | } | |
| 83 | $db->db_disconnect($dbh); | |
| 84 | } | |
| 85 | ||
| 86 | # Return the full permission set (hash of slug => 1) for a user. | |
| 87 | sub user_perms { | |
| 88 | my ($self, $userinfo) = @_; | |
| 89 | return {} unless $userinfo && $userinfo->{user_id}; | |
| 90 | my $uid = $userinfo->{user_id} + 0; | |
| 91 | return $_USER_PERMS_CACHE{$uid} if exists $_USER_PERMS_CACHE{$uid}; | |
| 92 | ||
| 93 | _load_features(); | |
| 94 | ||
| 95 | # super_admin: hand back every feature | |
| 96 | if ($userinfo->{is_super_admin} || $userinfo->{_admin_is_super_admin}) { | |
| 97 | my %all = map { $_->{slug} => 1 } values %_FEATURE_BY_SLUG; | |
| 98 | return $_USER_PERMS_CACHE{$uid} = \%all; | |
| 99 | } | |
| 100 | ||
| 101 | my %set; | |
| 102 | ||
| 103 | # Try permission_groups_id first | |
| 104 | if ($userinfo->{permission_groups_id}) { | |
| 105 | my $dbh = $db->db_connect(); | |
| 106 | if ($dbh) { | |
| 107 | my $pgid = $userinfo->{permission_groups_id} + 0; | |
| 108 | my $r = $db->db_readwrite($dbh, qq~ | |
| 109 | SELECT permission_features_ids FROM ${DB}.permission_groups | |
| 110 | WHERE id='$pgid' AND group_status='1' LIMIT 1 | |
| 111 | ~, $ENV{SCRIPT_NAME}, __LINE__); | |
| 112 | $db->db_disconnect($dbh); | |
| 113 | if ($r && defined $r->{permission_features_ids}) { | |
| 114 | foreach my $fid (split /,/, $r->{permission_features_ids}) { | |
| 115 | $fid =~ s/\s+//g; | |
| 116 | next unless $fid; | |
| 117 | my $f = $_FEATURE_BY_ID{$fid}; | |
| 118 | $set{$f->{slug}} = 1 if $f; | |
| 119 | } | |
| 120 | } | |
| 121 | } | |
| 122 | } | |
| 123 | # Fall back to role defaults if no group OR group resolved to nothing | |
| 124 | unless (%set) { | |
| 125 | my $role = $userinfo->{role} || 'member'; | |
| 126 | foreach my $slug (@{ $ROLE_DEFAULTS{$role} || [] }) { | |
| 127 | $set{$slug} = 1; | |
| 128 | } | |
| 129 | } | |
| 130 | ||
| 131 | return $_USER_PERMS_CACHE{$uid} = \%set; | |
| 132 | } | |
| 133 | ||
| 134 | # Bool: does user have the named permission? | |
| 135 | sub has_permission { | |
| 136 | my ($self, $userinfo, $slug) = @_; | |
| 137 | return 0 unless $slug; | |
| 138 | my $set = $self->user_perms($userinfo); | |
| 139 | return $set->{$slug} ? 1 : 0; | |
| 140 | } | |
| 141 | ||
| 142 | # Throwing variant — call at the top of a CGI to gate access. | |
| 143 | sub require_permission { | |
| 144 | my ($self, $userinfo, $slug) = @_; | |
| 145 | unless ($self->has_permission($userinfo, $slug)) { | |
| 146 | print "Status: 302 Found\nLocation: /dashboard.cgi?err=perm\n\n"; exit; | |
| 147 | } | |
| 148 | return 1; | |
| 149 | } | |
| 150 | ||
| 151 | # Returns the catalog ordered by category + sort_order. Useful for the | |
| 152 | # permission_groups admin page so the UI can list checkboxes grouped by | |
| 153 | # category in the expected order. | |
| 154 | sub feature_catalog { | |
| 155 | my ($self) = @_; | |
| 156 | _load_features(); | |
| 157 | my @list = sort { | |
| 158 | $a->{category} cmp $b->{category} | |
| 159 | || $a->{sort_order} <=> $b->{sort_order} | |
| 160 | || $a->{name} cmp $b->{name} | |
| 161 | } values %_FEATURE_BY_SLUG; | |
| 162 | return @list; | |
| 163 | } | |
| 164 | ||
| 165 | # Returns the role-default slug list for the given role. Used by the | |
| 166 | # "Create from role template" button on the group admin page. | |
| 167 | sub role_defaults { | |
| 168 | my ($self, $role) = @_; | |
| 169 | return @{ $ROLE_DEFAULTS{$role || 'member'} || [] }; | |
| 170 | } | |
| 171 | ||
| 172 | 1; |