rt/lib/RT/Principal.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  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
  16 # from www.gnu.org.
  17 #
  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.
  22 #
  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., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 #
  50
  51 package RT::Principal;
  52
  53 use strict;
  54 use warnings;
  55
  56
  57 use base 'RT::Record';
  58
  59 sub Table {'Principals'}
  60
  61
  62
  63 use RT;
  64 use RT::Group;
  65 use RT::User;
  66
  67 # Set up the ACL cache on startup
  68 our $_ACL_CACHE;
  69 InvalidateACLCache();
  70
  71 require RT::ACE;
  72 RT::ACE->RegisterCacheHandler(sub { RT::Principal->InvalidateACLCache() });
  73
  74 =head2 IsGroup
  75
  76 Returns true if this principal is a group.
  77 Returns undef, otherwise
  78
  79 =cut
  80
  81 sub IsGroup {
  82     my $self = shift;
  83     if ( defined $self->PrincipalType &&
  84             $self->PrincipalType eq 'Group' ) {
  85         return 1;
  86     }
  87     return undef;
  88 }
  89
  90 =head2 IsRoleGroup
  91
  92 Returns true if this principal is a role group.
  93 Returns undef, otherwise.
  94
  95 =cut
  96
  97 sub IsRoleGroup {
  98     my $self = shift;
  99     return ($self->IsGroup and $self->Object->RoleClass)
 100         ? 1 : undef;
 101 }
 102
 103 =head2 IsUser
 104
 105 Returns true if this principal is a User.
 106 Returns undef, otherwise
 107
 108 =cut
 109
 110 sub IsUser {
 111     my $self = shift;
 112     if ($self->PrincipalType eq 'User') {
 113         return(1);
 114     }
 115     else {
 116         return undef;
 117     }
 118 }
 119
 120
 121
 122 =head2 Object
 123
 124 Returns the user or group associated with this principal
 125
 126 =cut
 127
 128 sub Object {
 129     my $self = shift;
 130
 131     unless ( $self->{'object'} ) {
 132         if ( $self->IsUser ) {
 133            $self->{'object'} = RT::User->new($self->CurrentUser);
 134         }
 135         elsif ( $self->IsGroup ) {
 136             $self->{'object'}  = RT::Group->new($self->CurrentUser);
 137         }
 138         else {
 139             $RT::Logger->crit("Found a principal (".$self->Id.") that was neither a user nor a group");
 140             return(undef);
 141         }
 142         $self->{'object'}->Load( $self->id );
 143     }
 144     return ($self->{'object'});
 145
 146
 147 }
 148
 149
 150
 151 =head2 GrantRight  { Right => RIGHTNAME, Object => undef }
 152
 153 A helper function which calls RT::ACE->Create
 154
 155
 156
 157    Returns a tuple of (STATUS, MESSAGE);  If the call succeeded, STATUS is true. Otherwise it's
 158    false.
 159
 160 =cut
 161
 162 sub GrantRight {
 163     my $self = shift;
 164     my %args = (
 165         Right => undef,
 166         Object => undef,
 167         @_
 168     );
 169
 170     return (0, "Permission Denied") if $args{'Right'} eq 'ExecuteCode'
 171         and RT->Config->Get('DisallowExecuteCode');
 172
 173     #ACL check handled in ACE.pm
 174     my $ace = RT::ACE->new( $self->CurrentUser );
 175
 176     my $type = $self->_GetPrincipalTypeForACL();
 177
 178     # If it's a user, we really want to grant the right to their
 179     # user equivalence group
 180     my ($id, $msg) = $ace->Create(
 181         RightName     => $args{'Right'},
 182         Object        => $args{'Object'},
 183         PrincipalType => $type,
 184         PrincipalId   => $self->Id,
 185     );
 186
 187     return ($id, $msg);
 188 }
 189
 190
 191 =head2 RevokeRight { Right => "RightName", Object => "object" }
 192
 193 Delete a right that a user has
 194
 195
 196    Returns a tuple of (STATUS, MESSAGE);  If the call succeeded, STATUS is true. Otherwise it's
 197       false.
 198
 199
 200 =cut
 201
 202 sub RevokeRight {
 203
 204     my $self = shift;
 205     my %args = (
 206         Right  => undef,
 207         Object => undef,
 208         @_
 209     );
 210
 211     #if we haven't specified any sort of right, we're talking about a global right
 212     if (!defined $args{'Object'} && !defined $args{'ObjectId'} && !defined $args{'ObjectType'}) {
 213         $args{'Object'} = $RT::System;
 214     }
 215     #ACL check handled in ACE.pm
 216     my $type = $self->_GetPrincipalTypeForACL();
 217
 218     my $ace = RT::ACE->new( $self->CurrentUser );
 219     my ($status, $msg) = $ace->LoadByValues(
 220         RightName     => $args{'Right'},
 221         Object        => $args{'Object'},
 222         PrincipalType => $type,
 223         PrincipalId   => $self->Id
 224     );
 225
 226     if ( not $status and $msg =~ /Invalid right/ ) {
 227         $RT::Logger->warn("Tried to revoke the invalid right '$args{Right}', ignoring it.");
 228         return (1);
 229     }
 230
 231     return ($status, $msg) unless $status;
 232
 233     my $right = $ace->RightName;
 234     ($status, $msg) = $ace->Delete;
 235
 236     return ($status, $msg);
 237 }
 238
 239
 240
 241 =head2 HasRight (Right => 'right' Object => undef)
 242
 243 Checks to see whether this principal has the right "Right" for the Object
 244 specified. This takes the params:
 245
 246 =over 4
 247
 248 =item Right
 249
 250 name of a right
 251
 252 =item Object
 253
 254 an RT style object (->id will get its id)
 255
 256 =back
 257
 258 Returns 1 if a matching ACE was found. Returns undef if no ACE was found.
 259
 260 Use L</HasRights> to fill a fast cache, especially if you're going to
 261 check many different rights with the same principal and object.
 262
 263 =cut
 264
 265 sub HasRight {
 266
 267     my $self = shift;
 268     my %args = ( Right        => undef,
 269                  Object       => undef,
 270                  EquivObjects => undef,
 271                  @_,
 272                );
 273
 274     # RT's SystemUser always has all rights
 275     if ( $self->id == RT->SystemUser->id ) {
 276         return 1;
 277     }
 278
 279     if ( my $right = RT::ACE->CanonicalizeRightName( $args{'Right'} ) ) {
 280         $args{'Right'} = $right;
 281     } else {
 282         $RT::Logger->error(
 283                "Invalid right. Couldn't canonicalize right '$args{'Right'}'");
 284         return undef;
 285     }
 286
 287     return undef if $args{'Right'} eq 'ExecuteCode'
 288         and RT->Config->Get('DisallowExecuteCode');
 289
 290     $args{'EquivObjects'} = [ @{ $args{'EquivObjects'} } ]
 291         if $args{'EquivObjects'};
 292
 293     if ( $self->__Value('Disabled') ) {
 294         $RT::Logger->debug(   "Disabled User #"
 295                             . $self->id
 296                             . " failed access check for "
 297                             . $args{'Right'} );
 298         return (undef);
 299     }
 300
 301     if ( eval { $args{'Object'}->id } ) {
 302         push @{ $args{'EquivObjects'} }, $args{'Object'};
 303     } else {
 304         $RT::Logger->crit("HasRight called with no valid object");
 305         return (undef);
 306     }
 307
 308     {
 309         my $cached = $_ACL_CACHE->{
 310             $self->id .';:;'. ref($args{'Object'}) .'-'. $args{'Object'}->id
 311         };
 312         return $cached->{'SuperUser'} || $cached->{ $args{'Right'} }
 313             if $cached;
 314     }
 315
 316     unshift @{ $args{'EquivObjects'} },
 317         $args{'Object'}->ACLEquivalenceObjects;
 318     unshift @{ $args{'EquivObjects'} }, $RT::System;
 319
 320     # If we've cached a win or loss for this lookup say so
 321
 322 # Construct a hashkeys to cache decisions:
 323 # 1) full_hashkey - key for any result and for full combination of uid, right and objects
 324 # 2) short_hashkey - one key for each object to store positive results only, it applies
 325 # only to direct group rights and partly to role rights
 326     my $full_hashkey = join (";:;", $self->id, $args{'Right'});
 327     foreach ( @{ $args{'EquivObjects'} } ) {
 328         my $ref_id = $self->_ReferenceId($_);
 329         $full_hashkey .= ";:;".$ref_id;
 330
 331         my $short_hashkey = join(";:;", $self->id, $args{'Right'}, $ref_id);
 332         my $cached_answer = $_ACL_CACHE->{ $short_hashkey };
 333         return $cached_answer > 0 if defined $cached_answer;
 334     }
 335
 336     {
 337         my $cached_answer = $_ACL_CACHE->{ $full_hashkey };
 338         return $cached_answer > 0 if defined $cached_answer;
 339     }
 340
 341     my ( $hitcount, $via_obj ) = $self->_HasRight(%args);
 342
 343     $_ACL_CACHE->{ $full_hashkey } = $hitcount ? 1 : -1;
 344     $_ACL_CACHE->{ join ';:;',  $self->id, $args{'Right'}, $via_obj } = 1
 345         if $via_obj && $hitcount;
 346
 347     return ($hitcount);
 348 }
 349
 350 =head2 HasRights
 351
 352 Returns a hash reference with all rights this principal has on an
 353 object. Takes Object as a named argument.
 354
 355 Main use case of this method is the following:
 356
 357     $ticket->CurrentUser->PrincipalObj->HasRights( Object => $ticket );
 358     ...
 359     $ticket->CurrentUserHasRight('A');
 360     ...
 361     $ticket->CurrentUserHasRight('Z');
 362
 363 Results are cached and the cache is used in this and, as well, in L</HasRight>
 364 method speeding it up. Don't use hash reference returned by this method
 365 directly for rights checks as it's more complicated then it seems, especially
 366 considering config options like 'DisallowExecuteCode'.
 367
 368 =cut
 369
 370 sub HasRights {
 371     my $self = shift;
 372     my %args = (
 373         Object       => undef,
 374         EquivObjects => undef,
 375         @_
 376     );
 377     return {} if $self->__Value('Disabled');
 378
 379     my $object = $args{'Object'};
 380     unless ( eval { $object->id } ) {
 381         $RT::Logger->crit("HasRights called with no valid object");
 382     }
 383
 384     my $cache_key = $self->id .';:;'. ref($object) .'-'. $object->id;
 385     my $cached = $_ACL_CACHE->{ $cache_key };
 386     return $cached if $cached;
 387
 388     push @{ $args{'EquivObjects'} }, $object;
 389     unshift @{ $args{'EquivObjects'} },
 390         $args{'Object'}->ACLEquivalenceObjects;
 391     unshift @{ $args{'EquivObjects'} }, $RT::System;
 392
 393     my %res = ();
 394     {
 395         my $query
 396             = "SELECT DISTINCT ACL.RightName "
 397             . $self->_HasGroupRightQuery(
 398                 EquivObjects => $args{'EquivObjects'}
 399             );
 400         my $rights = $RT::Handle->dbh->selectcol_arrayref($query);
 401         unless ($rights) {
 402             $RT::Logger->warning( $RT::Handle->dbh->errstr );
 403             return ();
 404         }
 405         $res{$_} = 1 foreach @$rights;
 406     }
 407     my $roles;
 408     {
 409         my $query
 410             = "SELECT DISTINCT Groups.Type "
 411             . $self->_HasRoleRightQuery(
 412                 EquivObjects => $args{'EquivObjects'}
 413             );
 414         $roles = $RT::Handle->dbh->selectcol_arrayref($query);
 415         unless ($roles) {
 416             $RT::Logger->warning( $RT::Handle->dbh->errstr );
 417             return ();
 418         }
 419     }
 420     if ( @$roles ) {
 421         my $query
 422             = "SELECT DISTINCT ACL.RightName "
 423             . $self->_RolesWithRightQuery(
 424                 EquivObjects => $args{'EquivObjects'}
 425             )
 426             . ' AND ('. join( ' OR ', map "PrincipalType = '$_'", @$roles ) .')'
 427         ;
 428         my $rights = $RT::Handle->dbh->selectcol_arrayref($query);
 429         unless ($rights) {
 430             $RT::Logger->warning( $RT::Handle->dbh->errstr );
 431             return ();
 432         }
 433         $res{$_} = 1 foreach @$rights;
 434     }
 435
 436     delete $res{'ExecuteCode'} if
 437         RT->Config->Get('DisallowExecuteCode');
 438
 439     $_ACL_CACHE->{ $cache_key } = \%res;
 440     return \%res;
 441 }
 442
 443 =head2 _HasRight
 444
 445 Low level HasRight implementation, use HasRight method instead.
 446
 447 =cut
 448
 449 sub _HasRight {
 450     my $self = shift;
 451     {
 452         my ( $hit, @other ) = $self->_HasGroupRight(@_);
 453         return ( $hit, @other ) if $hit;
 454     }
 455     {
 456         my ( $hit, @other ) = $self->_HasRoleRight(@_);
 457         return ( $hit, @other ) if $hit;
 458     }
 459     return (0);
 460 }
 461
 462 # this method handles role rights partly in situations
 463 # where user plays role X on an object and as well the right is
 464 # assigned to this role X of the object, for example right CommentOnTicket
 465 # is granted to Cc role of a queue and user is in cc list of the queue
 466 sub _HasGroupRight {
 467     my $self = shift;
 468     my %args = ( Right        => undef,
 469                  EquivObjects => [],
 470                  @_
 471                );
 472
 473     my $query
 474         = "SELECT ACL.id, ACL.ObjectType, ACL.ObjectId "
 475         . $self->_HasGroupRightQuery( %args );
 476
 477     $self->_Handle->ApplyLimits( \$query, 1 );
 478     my ( $hit, $obj, $id ) = $self->_Handle->FetchResult($query);
 479     return (0) unless $hit;
 480
 481     $obj .= "-$id" if $id;
 482     return ( 1, $obj );
 483 }
 484
 485 sub _HasGroupRightQuery {
 486     my $self = shift;
 487     my %args = (
 488         Right        => undef,
 489         EquivObjects => [],
 490         @_
 491     );
 492
 493     my $query
 494         = "FROM ACL, Principals, CachedGroupMembers WHERE "
 495
 496         # Never find disabled groups.
 497         . "Principals.id = ACL.PrincipalId "
 498         . "AND Principals.PrincipalType = 'Group' "
 499         . "AND Principals.Disabled = 0 "
 500
 501 # See if the principal is a member of the group recursively or _is the rightholder_
 502 # never find recursively disabled group members
 503 # also, check to see if the right is being granted _directly_ to this principal,
 504 #  as is the case when we want to look up group rights
 505         . "AND CachedGroupMembers.GroupId  = ACL.PrincipalId "
 506         . "AND CachedGroupMembers.GroupId  = Principals.id "
 507         . "AND CachedGroupMembers.MemberId = ". $self->Id . " "
 508         . "AND CachedGroupMembers.Disabled = 0 ";
 509
 510     my @clauses;
 511     foreach my $obj ( @{ $args{'EquivObjects'} } ) {
 512         my $type = ref($obj) || $obj;
 513         my $clause = "ACL.ObjectType = '$type'";
 514
 515         if ( defined eval { $obj->id } ) {    # it might be 0
 516             $clause .= " AND ACL.ObjectId = " . $obj->id;
 517         }
 518
 519         push @clauses, "($clause)";
 520     }
 521     if (@clauses) {
 522         $query .= " AND (" . join( ' OR ', @clauses ) . ")";
 523     }
 524     if ( my $right = $args{'Right'} ) {
 525         # Only find superuser or rights with the name $right
 526         $query .= " AND (ACL.RightName = 'SuperUser' "
 527             . ( $right ne 'SuperUser' ? "OR ACL.RightName = '$right'" : '' )
 528         . ") ";
 529     }
 530     return $query;
 531 }
 532
 533 sub _HasRoleRight {
 534     my $self = shift;
 535     my %args = ( Right        => undef,
 536                  EquivObjects => [],
 537                  @_
 538                );
 539
 540     my @roles = $self->RolesWithRight(%args);
 541     return 0 unless @roles;
 542
 543     my $query = "SELECT Groups.id "
 544         . $self->_HasRoleRightQuery( %args, Roles => \@roles );
 545
 546     $self->_Handle->ApplyLimits( \$query, 1 );
 547     my ($hit) = $self->_Handle->FetchResult($query);
 548     return (1) if $hit;
 549
 550     return 0;
 551 }
 552
 553 sub _HasRoleRightQuery {
 554     my $self = shift;
 555     my %args = ( Right        => undef,
 556                  EquivObjects => [],
 557                  Roles        => undef,
 558                  @_
 559                );
 560
 561     my $query =
 562         " FROM Groups, Principals, CachedGroupMembers WHERE "
 563
 564         # Never find disabled things
 565         . "Principals.Disabled = 0 " . "AND CachedGroupMembers.Disabled = 0 "
 566
 567         # We always grant rights to Groups
 568         . "AND Principals.id = Groups.id "
 569         . "AND Principals.PrincipalType = 'Group' "
 570
 571 # See if the principal is a member of the group recursively or _is the rightholder_
 572 # never find recursively disabled group members
 573 # also, check to see if the right is being granted _directly_ to this principal,
 574 #  as is the case when we want to look up group rights
 575         . "AND Principals.id = CachedGroupMembers.GroupId "
 576         . "AND CachedGroupMembers.MemberId = " . $self->Id . " "
 577     ;
 578
 579     if ( $args{'Roles'} ) {
 580         $query .= "AND (" . join( ' OR ',
 581             map $RT::Handle->__MakeClauseCaseInsensitive('Groups.Name', '=', "'$_'"),
 582             @{ $args{'Roles'} }
 583         ) . ")";
 584     }
 585
 586     my @object_clauses = RT::Users->_RoleClauses( Groups => @{ $args{'EquivObjects'} } );
 587     $query .= " AND (" . join( ' OR ', @object_clauses ) . ")";
 588     return $query;
 589 }
 590
 591 =head2 RolesWithRight
 592
 593 Returns list with names of roles that have right on
 594 set of objects. Takes Right, EquiveObjects,
 595 IncludeSystemRights and IncludeSuperusers arguments.
 596
 597 IncludeSystemRights is true by default, rights
 598 granted systemwide are ignored when IncludeSystemRights
 599 is set to a false value.
 600
 601 IncludeSuperusers is true by default, SuperUser right
 602 is not checked if it's set to a false value.
 603
 604 =cut
 605
 606 sub RolesWithRight {
 607     my $self = shift;
 608     my %args = ( Right               => undef,
 609                  IncludeSystemRights => 1,
 610                  IncludeSuperusers   => 1,
 611                  EquivObjects        => [],
 612                  @_
 613                );
 614
 615     return () if $args{'Right'} eq 'ExecuteCode'
 616         and RT->Config->Get('DisallowExecuteCode');
 617
 618     my $query = "SELECT DISTINCT PrincipalType "
 619         . $self->_RolesWithRightQuery( %args );
 620
 621     my $roles = $RT::Handle->dbh->selectcol_arrayref($query);
 622     unless ($roles) {
 623         $RT::Logger->warning( $RT::Handle->dbh->errstr );
 624         return ();
 625     }
 626     return @$roles;
 627 }
 628
 629 sub _RolesWithRightQuery {
 630     my $self = shift;
 631     my %args = ( Right               => undef,
 632                  IncludeSystemRights => 1,
 633                  IncludeSuperusers   => 1,
 634                  EquivObjects        => [],
 635                  @_
 636                );
 637
 638     my $query = " FROM ACL WHERE"
 639
 640         # we need only roles
 641         . " PrincipalType != 'Group'";
 642
 643     if ( my $right = $args{'Right'} ) {
 644         $query .=
 645             # Only find superuser or rights with the requested right
 646             " AND ( RightName = '$right' "
 647
 648             # Check SuperUser if we were asked to
 649             . ( $args{'IncludeSuperusers'} ? "OR RightName = 'SuperUser' " : '' )
 650             . ")";
 651     }
 652
 653     # skip rights granted on system level if we were asked to
 654     unless ( $args{'IncludeSystemRights'} ) {
 655         $query .= " AND ObjectType != 'RT::System'";
 656     }
 657
 658     my (@object_clauses);
 659     foreach my $obj ( @{ $args{'EquivObjects'} } ) {
 660         my $type = ref($obj) ? ref($obj) : $obj;
 661
 662         my $object_clause = "ObjectType = '$type'";
 663         if ( my $id = eval { $obj->id } ) {
 664             $object_clause .= " AND ObjectId = $id";
 665         }
 666         push @object_clauses, "($object_clause)";
 667     }
 668
 669     # find ACLs that are related to our objects only
 670     $query .= " AND (" . join( ' OR ', @object_clauses ) . ")"
 671         if @object_clauses;
 672
 673     return $query;
 674 }
 675
 676
 677 =head2 InvalidateACLCache
 678
 679 Cleans out and reinitializes the user rights cache
 680
 681 =cut
 682
 683 sub InvalidateACLCache {
 684     $_ACL_CACHE = {}
 685 }
 686
 687
 688
 689
 690
 691 =head2 _GetPrincipalTypeForACL
 692
 693 Gets the principal type. if it's a user, it's a user. if it's a role group and it has a Type,
 694 return that. if it has no type, return group.
 695
 696 =cut
 697
 698 sub _GetPrincipalTypeForACL {
 699     my $self = shift;
 700     if ($self->IsRoleGroup) {
 701         return $self->Object->Name;
 702     } else {
 703         return $self->PrincipalType;
 704     }
 705 }
 706
 707
 708
 709 =head2 _ReferenceId
 710
 711 Returns a list uniquely representing an object or normal scalar.
 712
 713 For a scalar, its string value is returned.
 714 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 "-".
 715 For an object that has an id() method which returns false, its class name is returned.
 716
 717 =cut
 718
 719 sub _ReferenceId {
 720     my $self = shift;
 721     my $scalar = shift;
 722     my $id = eval { $scalar->id };
 723     if ($@) {
 724         return $scalar;
 725     } elsif ($id) {
 726         return ref($scalar) . "-" . $id;
 727     } else {
 728         return ref($scalar);
 729     }
 730 }
 731
 732 sub ObjectId {
 733     my $self = shift;
 734     RT->Deprecated( Instead => 'id', Remove => '4.4' );
 735     return $self->_Value('ObjectId');
 736 }
 737
 738 sub LoadByCols {
 739     my $self = shift;
 740     my %args = @_;
 741     if ( exists $args{'ObjectId'} ) {
 742         RT->Deprecated( Arguments => 'ObjectId', Instead => 'id', Remove => '4.4' );
 743     }
 744     return $self->SUPER::LoadByCols( %args );
 745 }
 746
 747
 748
 749
 750 =head2 id
 751
 752 Returns the current value of id.
 753 (In the database, id is stored as int(11).)
 754
 755
 756 =cut
 757
 758
 759 =head2 PrincipalType
 760
 761 Returns the current value of PrincipalType.
 762 (In the database, PrincipalType is stored as varchar(16).)
 763
 764
 765
 766 =head2 SetPrincipalType VALUE
 767
 768
 769 Set PrincipalType to VALUE.
 770 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 771 (In the database, PrincipalType will be stored as a varchar(16).)
 772
 773
 774 =cut
 775
 776
 777 =head2 ObjectId
 778
 779 Returns the current value of ObjectId.
 780 (In the database, ObjectId is stored as int(11).)
 781
 782
 783
 784 =head2 SetObjectId VALUE
 785
 786
 787 Set ObjectId to VALUE.
 788 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 789 (In the database, ObjectId will be stored as a int(11).)
 790
 791
 792 =cut
 793
 794
 795 =head2 Disabled
 796
 797 Returns the current value of Disabled.
 798 (In the database, Disabled is stored as smallint(6).)
 799
 800
 801
 802 =head2 SetDisabled VALUE
 803
 804
 805 Set Disabled to VALUE.
 806 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 807 (In the database, Disabled will be stored as a smallint(6).)
 808
 809
 810 =cut
 811
 812
 813
 814 sub _CoreAccessible {
 815     {
 816
 817         id =>
 818                 {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
 819         PrincipalType =>
 820                 {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
 821         ObjectId =>
 822                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
 823         Disabled =>
 824                 {read => 1, write => 1, sql_type => 5, length => 6,  is_blob => 0,  is_numeric => 1,  type => 'smallint(6)', default => '0'},
 825
 826  }
 827 };
 828
 829
 830 sub __DependsOn {
 831     my $self = shift;
 832     my %args = (
 833         Shredder => undef,
 834         Dependencies => undef,
 835         @_,
 836     );
 837     my $deps = $args{'Dependencies'};
 838     my $list = [];
 839
 840 # Group or User
 841 # Could be wiped allready
 842     my $obj = $self->Object;
 843     if( defined $obj->id ) {
 844         push( @$list, $obj );
 845     }
 846
 847 # Access Control List
 848     my $objs = RT::ACL->new( $self->CurrentUser );
 849     $objs->Limit(
 850         FIELD => 'PrincipalId',
 851         OPERATOR        => '=',
 852         VALUE           => $self->Id
 853     );
 854     push( @$list, $objs );
 855
 856 # AddWatcher/DelWatcher txns
 857     foreach my $type ( qw(AddWatcher DelWatcher) ) {
 858         my $objs = RT::Transactions->new( $self->CurrentUser );
 859         $objs->Limit( FIELD => $type =~ /Add/? 'NewValue': 'OldValue', VALUE => $self->Id );
 860         $objs->Limit( FIELD => 'Type', VALUE => $type );
 861         push( @$list, $objs );
 862     }
 863
 864     $deps->_PushDependencies(
 865         BaseObject => $self,
 866         Flags => RT::Shredder::Constants::DEPENDS_ON,
 867         TargetObjects => $list,
 868         Shredder => $args{'Shredder'}
 869     );
 870     return $self->SUPER::__DependsOn( %args );
 871 }
 872
 873 RT::Base->_ImportOverlays();
 874
 875 1;