1 # {{{ BEGIN BPS TAGGED BLOCK
5 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
6 # <jesse@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28 # CONTRIBUTION SUBMISSION POLICY:
30 # (The following paragraph is not intended to limit the rights granted
31 # to you to modify and distribute this software under the terms of
32 # the GNU General Public License and is only of importance to you if
33 # you choose to contribute your changes and enhancements to the
34 # community by submitting them to Best Practical Solutions, LLC.)
36 # By intentionally submitting any modifications, corrections or
37 # derivatives to this work, or any other work intended for use with
38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
39 # you are the copyright holder for those contributions and you grant
40 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
41 # royalty-free, perpetual, license to use, copy, create derivative
42 # works based on those contributions, and sublicense and distribute
43 # those contributions and any derivatives thereof.
45 # }}} END BPS TAGGED BLOCK
48 no warnings qw(redefine);
49 use vars qw(%_ACL_KEY_CACHE);
58 Returns true if this principal is a group.
59 Returns undef, otherwise
65 if ($self->PrincipalType eq 'Group') {
79 Returns true if this principal is a User.
80 Returns undef, otherwise
86 if ($self->PrincipalType eq 'User') {
100 Returns the user or group associated with this principal
107 unless ($self->{'object'}) {
109 $self->{'object'} = RT::User->new($self->CurrentUser);
111 elsif ($self->IsGroup) {
112 $self->{'object'} = RT::Group->new($self->CurrentUser);
115 $RT::Logger->crit("Found a principal (".$self->Id.") that was neither a user nor a group");
118 $self->{'object'}->Load($self->ObjectId());
120 return ($self->{'object'});
126 # {{{ ACL Related routines
130 =head2 GrantRight { Right => RIGHTNAME, Object => undef }
132 A helper function which calls RT::ACE->Create
138 my %args = ( Right => undef,
143 #if we haven't specified any sort of right, we're talking about a global right
144 if (!defined $args{'Object'} && !defined $args{'ObjectId'} && !defined $args{'ObjectType'}) {
145 $args{'Object'} = $RT::System;
148 unless ($args{'Right'}) {
149 return(0, $self->loc("Invalid Right"));
153 #ACL check handled in ACE.pm
154 my $ace = RT::ACE->new( $self->CurrentUser );
157 my $type = $self->_GetPrincipalTypeForACL();
159 # If it's a user, we really want to grant the right to their
160 # user equivalence group
161 return ( $ace->Create(RightName => $args{'Right'},
162 Object => $args{'Object'},
163 PrincipalType => $type,
164 PrincipalId => $self->Id
171 =head2 RevokeRight { Right => "RightName", Object => "object" }
173 Delete a right that a user has
186 #if we haven't specified any sort of right, we're talking about a global right
187 if (!defined $args{'Object'} && !defined $args{'ObjectId'} && !defined $args{'ObjectType'}) {
188 $args{'Object'} = $RT::System;
190 #ACL check handled in ACE.pm
191 my $type = $self->_GetPrincipalTypeForACL();
193 my $ace = RT::ACE->new( $self->CurrentUser );
195 RightName => $args{'Right'},
196 Object => $args{'Object'},
197 PrincipalType => $type,
198 PrincipalId => $self->Id
201 unless ( $ace->Id ) {
202 return ( 0, $self->loc("ACE not found") );
204 return ( $ace->Delete );
213 =head2 sub HasRight (Right => 'right' Object => undef)
216 Checks to see whether this principal has the right "Right" for the Object
217 specified. If the Object parameter is omitted, checks to see whether the
218 user has the right globally.
220 This still hard codes to check to see if a user has queue-level rights
221 if we ask about a specific ticket.
224 This takes the params:
226 Right => name of a right
230 Object => an RT style object (->id will get its id)
235 Returns 1 if a matching ACE was found.
237 Returns undef if no ACE was found.
244 my %args = ( Right => undef,
246 EquivObjects => undef,
249 if ( $self->Disabled ) {
250 $RT::Logger->err( "Disabled User: " . $self->id . " failed access check for " . $args{'Right'} );
254 if ( !defined $args{'Right'} ) {
256 $RT::Logger->debug( Carp::cluck("HasRight called without a right") );
260 if ( defined( $args{'Object'} )) {
261 return (undef) unless (UNIVERSAL::can( $args{'Object'}, 'id' ) );
262 push(@{$args{'EquivObjects'}}, $args{Object});
264 elsif ( $args{'ObjectId'} && $args{'ObjectType'} ) {
265 $RT::Logger->crit(Carp::cluck("API not supprted"));
268 $RT::Logger->crit("$self HasRight called with no valid object");
272 # If this object is a ticket, we care about ticket roles and queue roles
273 if ( (ref($args{'Object'}) eq 'RT::Ticket') && $args{'Object'}->Id) {
274 # this is a little bit hacky, but basically, now that we've done the ticket roles magic, we load the queue object
275 # and ask all the rest of our questions about the queue.
276 push (@{$args{'EquivObjects'}}, $args{'Object'}->QueueObj);
281 # {{{ If we've cached a win or loss for this lookup say so
283 # {{{ Construct a hashkey to cache decisions in
285 no warnings 'uninitialized';
287 # We don't worry about the hash ordering, as this is only
288 # temporarily used; also if the key changes it would be
289 # invalidated anyway.
291 ";:;", $self->Id, map {
292 $_, # the key of each arguments
293 ($_ eq 'EquivObjects') # for object arrayref...
294 ? map(_ReferenceId($_), @{$args{$_}}) # calculate each
295 : _ReferenceId( $args{$_} ) # otherwise just the value
301 #Anything older than 60 seconds needs to be rechecked
302 my $cache_timeout = ( time - 60 );
304 # {{{ if we've cached a positive result for this query, return 1
305 if ( ( defined $self->_ACLCache->{"$hashkey"} )
306 && ( $self->_ACLCache->{"$hashkey"}{'val'} == 1 )
307 && ( defined $self->_ACLCache->{"$hashkey"}{'set'} )
308 && ( $self->_ACLCache->{"$hashkey"}{'set'} > $cache_timeout ) ) {
310 #$RT::Logger->debug("Cached ACL win for ". $args{'Right'}.$args{'Scope'}. $args{'AppliesTo'}."\n");
315 # {{{ if we've cached a negative result for this query return undef
316 elsif ( ( defined $self->_ACLCache->{"$hashkey"} )
317 && ( $self->_ACLCache->{"$hashkey"}{'val'} == -1 )
318 && ( defined $self->_ACLCache->{"$hashkey"}{'set'} )
319 && ( $self->_ACLCache->{"$hashkey"}{'set'} > $cache_timeout ) ) {
321 #$RT::Logger->debug("Cached ACL loss decision for ". $args{'Right'}.$args{'Scope'}. $args{'AppliesTo'}."\n");
331 # {{{ Out of date docs
333 # We want to grant the right if:
336 # # The user has the right as a member of a system-internal or
337 # # user-defined group
339 # Find all records from the ACL where they're granted to a group
340 # of type "UserDefined" or "System"
341 # for the object "System or the object "Queue N" and the group we're looking
342 # at has the recursive member $self->Id
344 # # The user has the right based on a role
346 # Find all the records from ACL where they're granted to the role "foo"
347 # for the object "System" or the object "Queue N" and the group we're looking
348 # at is of domain ("RT::Queue-Role" and applies to the right queue)
349 # or ("RT::Ticket-Role" and applies to the right ticket)
350 # and the type is the same as the type of the ACL and the group has
351 # the recursive member $self->Id
356 my ( $or_look_at_object_rights, $or_check_roles );
357 my $right = $args{'Right'};
359 # {{{ Construct Right Match
361 # If an object is defined, we want to look at rights for that object
364 push (@look_at_objects, "ACL.ObjectType = 'RT::System'")
365 unless $self->can('_IsOverrideGlobalACL') and $self->_IsOverrideGlobalACL($args{Object});
369 foreach my $obj (@{$args{'EquivObjects'}}) {
370 next unless (UNIVERSAL::can($obj, 'id'));
371 my $type = ref($obj);
376 Carp::cluck("Trying to check $type rights for an unspecified $type");
377 $RT::Logger->crit("Trying to check $type rights for an unspecified $type");
379 push @look_at_objects, "(ACL.ObjectType = '$type' AND ACL.ObjectId = '$id')";
385 # {{{ Build that honkin-big SQL query
389 my $query_base = "SELECT ACL.id from ACL, Groups, Principals, CachedGroupMembers WHERE ".
390 # Only find superuser or rights with the name $right
391 "(ACL.RightName = 'SuperUser' OR ACL.RightName = '$right') ".
392 # Never find disabled groups.
393 "AND Principals.Disabled = 0 " .
394 "AND CachedGroupMembers.Disabled = 0 ".
395 "AND Principals.id = Groups.id " . # We always grant rights to Groups
397 # See if the principal is a member of the group recursively or _is the rightholder_
398 # never find recursively disabled group members
399 # also, check to see if the right is being granted _directly_ to this principal,
400 # as is the case when we want to look up group rights
401 "AND Principals.id = CachedGroupMembers.GroupId AND CachedGroupMembers.MemberId = '" . $self->Id . "' ".
403 # Make sure the rights apply to the entire system or to the object in question
404 "AND ( ".join(' OR ', @look_at_objects).") ";
408 # The groups query does the query based on group membership and individual user rights
410 my $groups_query = $query_base .
412 # limit the result set to groups of types ACLEquivalence (user) UserDefined, SystemInternal and Personal
413 "AND ( ( ACL.PrincipalId = Principals.id AND ACL.PrincipalType = 'Group' AND ".
414 "(Groups.Domain = 'SystemInternal' OR Groups.Domain = 'UserDefined' OR Groups.Domain = 'ACLEquivalence' OR Groups.Domain = 'Personal'))".
417 $self->_Handle->ApplyLimits(\$groups_query, 1); #only return one result
420 foreach my $object (@{$args{'EquivObjects'}}) {
421 push (@roles, $self->_RolesForObject(ref($object), $object->id));
424 # The roles query does the query based on roles
427 $roles_query = $query_base . "AND ".
428 " ( (".join (' OR ', @roles)." ) ".
429 " AND Groups.Type = ACL.PrincipalType AND Groups.Id = Principals.id AND Principals.PrincipalType = 'Group') ";
430 $self->_Handle->ApplyLimits(\$roles_query, 1); #only return one result
438 # {{{ Actually check the ACL by performing an SQL query
439 # $RT::Logger->debug("Now Trying $groups_query");
440 my $hitcount = $self->_Handle->FetchResult($groups_query);
444 # {{{ if there's a match, the right is granted
447 # Cache a positive hit.
448 $self->_ACLCache->{"$hashkey"}{'set'} = time;
449 $self->_ACLCache->{"$hashkey"}{'val'} = 1;
453 # {{{ If there's no match on groups, try it on roles
456 $hitcount = $self->_Handle->FetchResult($roles_query);
460 # Cache a positive hit.
461 $self->_ACLCache->{"$hashkey"}{'set'} = time;
462 $self->_ACLCache->{"$hashkey"}{'val'} = 1;
467 # cache a negative hit
468 $self->_ACLCache->{"$hashkey"}{'set'} = time;
469 $self->_ACLCache->{"$hashkey"}{'val'} = -1;
479 # {{{ _RolesForObject
483 =head2 _RolesForObject( $object_type, $object_id)
485 Returns an SQL clause finding role groups for Objects
490 sub _RolesForObject {
499 # This should never be true.
500 unless ($id =~ /^\d+$/) {
501 $RT::Logger->crit("RT::Prinicipal::_RolesForObject called with type $type and a non-integer id: '$id'");
505 my $clause = "(Groups.Domain = '".$type."-Role' AND Groups.Instance = $id) ";
520 # Function: _ACLCache
521 # Type : private instance
523 # Lvalue : hash: ACLCache
524 # Desc : Returns a reference to the Key cache hash
529 return(\%_ACL_KEY_CACHE);
534 # {{{ _InvalidateACLCache
536 =head2 _InvalidateACLCache
538 Cleans out and reinitializes the user rights key cache
542 sub _InvalidateACLCache {
543 %_ACL_KEY_CACHE = ();
551 # {{{ _GetPrincipalTypeForACL
553 =head2 _GetPrincipalTypeForACL
555 Gets the principal type. if it's a user, it's a user. if it's a role group and it has a Type,
556 return that. if it has no type, return group.
560 sub _GetPrincipalTypeForACL {
563 if ($self->PrincipalType eq 'Group' && $self->Object->Domain =~ /Role$/) {
564 $type = $self->Object->Type;
567 $type = $self->PrincipalType;
579 Returns a list uniquely representing an object or normal scalar.
581 For scalars, its string value is returned; for objects that has an
582 id() method, its class name and Id are returned as a string separated by a "-".
589 # just return the value for non-objects
590 return $scalar unless UNIVERSAL::can($scalar, 'id');
592 # an object -- return the class and id
593 return(ref($scalar)."-". $scalar->id);