+=head2 HasRights
+
+Returns a hash reference with all rights this principal has on an
+object. Takes Object as a named argument.
+
+Main use case of this method is the following:
+
+ $ticket->CurrentUser->PrincipalObj->HasRights( Object => $ticket );
+ ...
+ $ticket->CurrentUserHasRight('A');
+ ...
+ $ticket->CurrentUserHasRight('Z');
+
+Results are cached and the cache is used in this and, as well, in L</HasRight>
+method speeding it up. Don't use hash reference returned by this method
+directly for rights checks as it's more complicated then it seems, especially
+considering config options like 'DisallowExecuteCode'.
+
+=cut
+
+sub HasRights {
+ my $self = shift;
+ my %args = (
+ Object => undef,
+ EquivObjects => undef,
+ @_
+ );
+ return {} if $self->__Value('Disabled');
+
+ my $object = $args{'Object'};
+ unless ( eval { $object->id } ) {
+ $RT::Logger->crit("HasRights called with no valid object");
+ }
+
+ my $cache_key = $self->id .';:;'. ref($object) .'-'. $object->id;
+ my $cached = $_ACL_CACHE->{ $cache_key };
+ return $cached if $cached;
+
+ push @{ $args{'EquivObjects'} }, $object;
+ unshift @{ $args{'EquivObjects'} },
+ $args{'Object'}->ACLEquivalenceObjects;
+ unshift @{ $args{'EquivObjects'} }, $RT::System;
+
+ my %res = ();
+ {
+ my $query
+ = "SELECT DISTINCT ACL.RightName "
+ . $self->_HasGroupRightQuery(
+ EquivObjects => $args{'EquivObjects'}
+ );
+ my $rights = $RT::Handle->dbh->selectcol_arrayref($query);
+ unless ($rights) {
+ $RT::Logger->warning( $RT::Handle->dbh->errstr );
+ return ();
+ }
+ $res{$_} = 1 foreach @$rights;
+ }
+ my $roles;
+ {
+ my $query
+ = "SELECT DISTINCT Groups.Type "
+ . $self->_HasRoleRightQuery(
+ EquivObjects => $args{'EquivObjects'}
+ );
+ $roles = $RT::Handle->dbh->selectcol_arrayref($query);
+ unless ($roles) {
+ $RT::Logger->warning( $RT::Handle->dbh->errstr );
+ return ();
+ }
+ }
+ if ( @$roles ) {
+ my $query
+ = "SELECT DISTINCT ACL.RightName "
+ . $self->_RolesWithRightQuery(
+ EquivObjects => $args{'EquivObjects'}
+ )
+ . ' AND ('. join( ' OR ', map "PrincipalType = '$_'", @$roles ) .')'
+ ;
+ my $rights = $RT::Handle->dbh->selectcol_arrayref($query);
+ unless ($rights) {
+ $RT::Logger->warning( $RT::Handle->dbh->errstr );
+ return ();
+ }
+ $res{$_} = 1 foreach @$rights;
+ }
+
+ delete $res{'ExecuteCode'} if
+ RT->Config->Get('DisallowExecuteCode');
+
+ $_ACL_CACHE->{ $cache_key } = \%res;
+ return \%res;
+}
+
+=head2 _HasRight
+
+Low level HasRight implementation, use HasRight method instead.
+
+=cut
+
+sub _HasRight {
+ my $self = shift;
+ {
+ my ( $hit, @other ) = $self->_HasGroupRight(@_);
+ return ( $hit, @other ) if $hit;
+ }
+ {
+ my ( $hit, @other ) = $self->_HasRoleRight(@_);
+ return ( $hit, @other ) if $hit;
+ }
+ return (0);
+}
+
+# this method handles role rights partly in situations
+# where user plays role X on an object and as well the right is
+# assigned to this role X of the object, for example right CommentOnTicket
+# is granted to Cc role of a queue and user is in cc list of the queue
+sub _HasGroupRight {
+ my $self = shift;
+ my %args = ( Right => undef,
+ EquivObjects => [],
+ @_
+ );
+
+ my $query
+ = "SELECT ACL.id, ACL.ObjectType, ACL.ObjectId "
+ . $self->_HasGroupRightQuery( %args );
+
+ $self->_Handle->ApplyLimits( \$query, 1 );
+ my ( $hit, $obj, $id ) = $self->_Handle->FetchResult($query);
+ return (0) unless $hit;
+
+ $obj .= "-$id" if $id;
+ return ( 1, $obj );
+}
+
+sub _HasGroupRightQuery {
+ my $self = shift;
+ my %args = (
+ Right => undef,
+ EquivObjects => [],
+ @_
+ );
+
+ my $query
+ = "FROM ACL, Principals, CachedGroupMembers WHERE "
+
+ # Never find disabled groups.
+ . "Principals.id = ACL.PrincipalId "
+ . "AND Principals.PrincipalType = 'Group' "
+ . "AND Principals.Disabled = 0 "
+
+# See if the principal is a member of the group recursively or _is the rightholder_
+# never find recursively disabled group members
+# also, check to see if the right is being granted _directly_ to this principal,
+# as is the case when we want to look up group rights
+ . "AND CachedGroupMembers.GroupId = ACL.PrincipalId "
+ . "AND CachedGroupMembers.GroupId = Principals.id "
+ . "AND CachedGroupMembers.MemberId = ". $self->Id . " "
+ . "AND CachedGroupMembers.Disabled = 0 ";
+
+ my @clauses;
+ foreach my $obj ( @{ $args{'EquivObjects'} } ) {
+ my $type = ref($obj) || $obj;
+ my $clause = "ACL.ObjectType = '$type'";
+
+ if ( defined eval { $obj->id } ) { # it might be 0
+ $clause .= " AND ACL.ObjectId = " . $obj->id;
+ }
+
+ push @clauses, "($clause)";
+ }
+ if (@clauses) {
+ $query .= " AND (" . join( ' OR ', @clauses ) . ")";
+ }
+ if ( my $right = $args{'Right'} ) {
+ # Only find superuser or rights with the name $right
+ $query .= " AND (ACL.RightName = 'SuperUser' "
+ . ( $right ne 'SuperUser' ? "OR ACL.RightName = '$right'" : '' )
+ . ") ";
+ }
+ return $query;
+}
+
+sub _HasRoleRight {
+ my $self = shift;
+ my %args = ( Right => undef,
+ EquivObjects => [],
+ @_
+ );
+
+ my @roles = $self->RolesWithRight(%args);
+ return 0 unless @roles;
+
+ my $query = "SELECT Groups.id "
+ . $self->_HasRoleRightQuery( %args, Roles => \@roles );
+
+ $self->_Handle->ApplyLimits( \$query, 1 );
+ my ($hit) = $self->_Handle->FetchResult($query);
+ return (1) if $hit;
+
+ return 0;
+}
+
+sub _HasRoleRightQuery {
+ my $self = shift;
+ my %args = ( Right => undef,
+ EquivObjects => [],
+ Roles => undef,
+ @_
+ );
+
+ my $query =
+ " FROM Groups, Principals, CachedGroupMembers WHERE "
+
+ # Never find disabled things
+ . "Principals.Disabled = 0 " . "AND CachedGroupMembers.Disabled = 0 "
+
+ # We always grant rights to Groups
+ . "AND Principals.id = Groups.id "
+ . "AND Principals.PrincipalType = 'Group' "
+
+# See if the principal is a member of the group recursively or _is the rightholder_
+# never find recursively disabled group members
+# also, check to see if the right is being granted _directly_ to this principal,
+# as is the case when we want to look up group rights
+ . "AND Principals.id = CachedGroupMembers.GroupId "
+ . "AND CachedGroupMembers.MemberId = " . $self->Id . " "
+ ;
+
+ if ( $args{'Roles'} ) {
+ $query .= "AND (" . join( ' OR ',
+ map $RT::Handle->__MakeClauseCaseInsensitive('Groups.Name', '=', "'$_'"),
+ @{ $args{'Roles'} }
+ ) . ")";
+ }
+
+ my @object_clauses = RT::Users->_RoleClauses( Groups => @{ $args{'EquivObjects'} } );
+ $query .= " AND (" . join( ' OR ', @object_clauses ) . ")";
+ return $query;
+}
+
+=head2 RolesWithRight
+
+Returns list with names of roles that have right on
+set of objects. Takes Right, EquiveObjects,
+IncludeSystemRights and IncludeSuperusers arguments.
+
+IncludeSystemRights is true by default, rights
+granted systemwide are ignored when IncludeSystemRights
+is set to a false value.
+
+IncludeSuperusers is true by default, SuperUser right
+is not checked if it's set to a false value.
+
+=cut
+
+sub RolesWithRight {
+ my $self = shift;
+ my %args = ( Right => undef,
+ IncludeSystemRights => 1,
+ IncludeSuperusers => 1,
+ EquivObjects => [],
+ @_
+ );
+
+ return () if $args{'Right'} eq 'ExecuteCode'
+ and RT->Config->Get('DisallowExecuteCode');
+
+ my $query = "SELECT DISTINCT PrincipalType "
+ . $self->_RolesWithRightQuery( %args );
+
+ my $roles = $RT::Handle->dbh->selectcol_arrayref($query);
+ unless ($roles) {
+ $RT::Logger->warning( $RT::Handle->dbh->errstr );
+ return ();
+ }
+ return @$roles;
+}
+
+sub _RolesWithRightQuery {
+ my $self = shift;
+ my %args = ( Right => undef,
+ IncludeSystemRights => 1,
+ IncludeSuperusers => 1,
+ EquivObjects => [],
+ @_
+ );
+
+ my $query = " FROM ACL WHERE"
+
+ # we need only roles
+ . " PrincipalType != 'Group'";
+
+ if ( my $right = $args{'Right'} ) {
+ $query .=
+ # Only find superuser or rights with the requested right
+ " AND ( RightName = '$right' "
+
+ # Check SuperUser if we were asked to
+ . ( $args{'IncludeSuperusers'} ? "OR RightName = 'SuperUser' " : '' )
+ . ")";
+ }
+
+ # skip rights granted on system level if we were asked to
+ unless ( $args{'IncludeSystemRights'} ) {
+ $query .= " AND ObjectType != 'RT::System'";
+ }
+
+ my (@object_clauses);
+ foreach my $obj ( @{ $args{'EquivObjects'} } ) {
+ my $type = ref($obj) ? ref($obj) : $obj;
+
+ my $object_clause = "ObjectType = '$type'";
+ if ( my $id = eval { $obj->id } ) {
+ $object_clause .= " AND ObjectId = $id";
+ }
+ push @object_clauses, "($object_clause)";
+ }
+
+ # find ACLs that are related to our objects only
+ $query .= " AND (" . join( ' OR ', @object_clauses ) . ")"
+ if @object_clauses;
+
+ return $query;
+}
+
+
+=head2 InvalidateACLCache
+
+Cleans out and reinitializes the user rights cache
+
+=cut
+
+sub InvalidateACLCache {
+ $_ACL_CACHE = {}
+}
+
+
+
+
+
+=head2 _GetPrincipalTypeForACL
+
+Gets the principal type. if it's a user, it's a user. if it's a role group and it has a Type,
+return that. if it has no type, return group.
+
+=cut
+
+sub _GetPrincipalTypeForACL {
+ my $self = shift;
+ if ($self->IsRoleGroup) {
+ return $self->Object->Name;
+ } else {
+ return $self->PrincipalType;
+ }
+}
+
+
+
+=head2 _ReferenceId
+
+Returns a list uniquely representing an object or normal scalar.
+
+For a scalar, its string value is returned.
+For an object that has an id() method which returns a value, its class name and id are returned as a string separated by a "-".
+For an object that has an id() method which returns false, its class name is returned.
+
+=cut
+
+sub _ReferenceId {
+ my $self = shift;
+ my $scalar = shift;
+ my $id = eval { $scalar->id };
+ if ($@) {
+ return $scalar;
+ } elsif ($id) {
+ return ref($scalar) . "-" . $id;
+ } else {
+ return ref($scalar);
+ }
+}
+
+sub ObjectId {
+ my $self = shift;
+ RT->Deprecated( Instead => 'id', Remove => '4.4' );
+ return $self->_Value('ObjectId');
+}
+
+sub LoadByCols {
+ my $self = shift;
+ my %args = @_;
+ if ( exists $args{'ObjectId'} ) {
+ RT->Deprecated( Arguments => 'ObjectId', Instead => 'id', Remove => '4.4' );
+ }
+ return $self->SUPER::LoadByCols( %args );
+}
+
+