rt/lib/RT/Record/Role/Roles.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2017 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 use strict;
  50 use warnings;
  51
  52 package RT::Record::Role::Roles;
  53 use Role::Basic;
  54 use Scalar::Util qw(blessed);
  55
  56 =head1 NAME
  57
  58 RT::Record::Role::Roles - Common methods for records which "watchers" or "roles"
  59
  60 =head1 REQUIRES
  61
  62 =head2 L<RT::Record::Role>
  63
  64 =cut
  65
  66 with 'RT::Record::Role';
  67
  68 require RT::System;
  69 require RT::Principal;
  70 require RT::Group;
  71 require RT::User;
  72
  73 require RT::EmailParser;
  74
  75 =head1 PROVIDES
  76
  77 =head2 RegisterRole
  78
  79 Registers an RT role which applies to this class for role-based access control.
  80 Arguments:
  81
  82 =over 4
  83
  84 =item Name
  85
  86 Required.  The role name (i.e. Requestor, Owner, AdminCc, etc).
  87
  88 =item EquivClasses
  89
  90 Optional.  Array ref of classes through which this role percolates up to
  91 L<RT::System>.  You can think of this list as:
  92
  93     map { ref } $record_object->ACLEquivalenceObjects;
  94
  95 You should not include L<RT::System> itself in this list.
  96
  97 Simply calls RegisterRole on each equivalent class.
  98
  99 =item Single
 100
 101 Optional.  A true value indicates that this role may only contain a single user
 102 as a member at any given time.  When adding a new member to a Single role, any
 103 existing member will be removed.  If all members are removed, L<RT/Nobody> is
 104 added automatically.
 105
 106 =item Column
 107
 108 Optional, implies Single.  Specifies a column on the announcing class into
 109 which the single role member's user ID is denormalized.  The column will be
 110 kept updated automatically as the role member changes.  This is used, for
 111 example, for ticket owners and makes searching simpler (among other benefits).
 112
 113 =item ACLOnly
 114
 115 Optional.  A true value indicates this role is only used for ACLs and should
 116 not be populated with members.
 117
 118 This flag is advisory only, and the Perl API still allows members to be added
 119 to ACLOnly roles.
 120
 121 =item ACLOnlyInEquiv
 122
 123 Optional.  Automatically sets the ACLOnly flag for all EquivClasses, but not
 124 the announcing class.
 125
 126 =item SortOrder
 127
 128 Optional.  A numeric value indicating the position of this role when sorted
 129 ascending with other roles in a list.  Roles with the same sort order are
 130 ordered alphabetically by name within themselves.
 131
 132 =back
 133
 134 =cut
 135
 136 sub RegisterRole {
 137     my $self  = shift;
 138     my $class = ref($self) || $self;
 139     my %role  = (
 140         Name            => undef,
 141         EquivClasses    => [],
 142         SortOrder       => 0,
 143         @_
 144     );
 145     return unless $role{Name};
 146
 147     # Keep track of the class this role came from originally
 148     $role{ Class } ||= $class;
 149
 150     # Some groups are limited to a single user
 151     $role{ Single } = 1 if $role{Column};
 152
 153     # Stash the role on ourself
 154     $class->_ROLES->{ $role{Name} } = { %role };
 155
 156     # Register it with any equivalent classes...
 157     my $equiv = delete $role{EquivClasses} || [];
 158
 159     # ... and globally unless we ARE global
 160     unless ($class eq "RT::System") {
 161         push @$equiv, "RT::System";
 162     }
 163
 164     # ... marked as "for ACLs only" if flagged as such by the announcing class
 165     $role{ACLOnly} = 1 if delete $role{ACLOnlyInEquiv};
 166
 167     $_->RegisterRole(%role) for @$equiv;
 168
 169     # XXX TODO: Register which classes have roles on them somewhere?
 170
 171     return 1;
 172 }
 173
 174 =head2 UnregisterRole
 175
 176 Removes an RT role which applies to this class for role-based access control.
 177 Any roles on equivalent classes (via EquivClasses passed to L</RegisterRole>)
 178 are also unregistered.
 179
 180 Takes a role name as the sole argument.
 181
 182 B<Use this carefully:> Objects created after a role is unregistered will not
 183 have an associated L<RT::Group> for the removed role.  If you later decide to
 184 stop unregistering the role, operations on those objects created in the
 185 meantime will fail when trying to interact with the missing role groups.
 186
 187 B<Unregistering a role may break code which assumes the role exists.>
 188
 189 =cut
 190
 191 sub UnregisterRole {
 192     my $self  = shift;
 193     my $class = ref($self) || $self;
 194     my $name  = shift
 195         or return;
 196
 197     my $role = delete $self->_ROLES->{$name}
 198         or return;
 199
 200     $_->UnregisterRole($name)
 201         for "RT::System", reverse @{$role->{EquivClasses}};
 202 }
 203
 204 =head2 Role
 205
 206 Takes a role name; returns a hashref describing the role.  This hashref
 207 contains the same attributes used to register the role (see L</RegisterRole>),
 208 as well as some extras, including:
 209
 210 =over
 211
 212 =item Class
 213
 214 The original class which announced the role.  This is set automatically by
 215 L</RegisterRole> and is the same across all EquivClasses.
 216
 217 =back
 218
 219 Returns an empty hashref if the role doesn't exist.
 220
 221 =cut
 222
 223 sub Role {
 224     return \%{ $_[0]->_ROLES->{$_[1]} || {} };
 225 }
 226
 227 =head2 Roles
 228
 229 Returns a list of role names registered for this class, sorted ascending by
 230 SortOrder and then alphabetically by name.
 231
 232 Optionally takes a hash specifying attributes the returned roles must possess
 233 or lack.  Testing is done on a simple truthy basis and the actual values of
 234 the role attributes and arguments you pass are not compared string-wise or
 235 numerically; they must simply evaluate to the same truthiness.
 236
 237 For example:
 238
 239     # Return role names which are not only for ACL purposes
 240     $object->Roles( ACLOnly => 0 );
 241
 242     # Return role names which are denormalized into a column; note that the
 243     # role's Column attribute contains a string.
 244     $object->Roles( Column => 1 );
 245
 246 =cut
 247
 248 sub Roles {
 249     my $self = shift;
 250     my %attr = @_;
 251
 252     return   map { $_->[0] }
 253             sort {   $a->[1]{SortOrder} <=> $b->[1]{SortOrder}
 254                   or $a->[0] cmp $b->[0] }
 255             grep {
 256                 my $ok = 1;
 257                 for my $k (keys %attr) {
 258                     $ok = 0, last if $attr{$k} xor $_->[1]{$k};
 259                 }
 260                 $ok }
 261              map { [ $_, $self->Role($_) ] }
 262             keys %{ $self->_ROLES };
 263 }
 264
 265 {
 266     my %ROLES;
 267     sub _ROLES {
 268         my $class = ref($_[0]) || $_[0];
 269         return $ROLES{$class} ||= {};
 270     }
 271 }
 272
 273 =head2 HasRole
 274
 275 Returns true if the name provided is a registered role for this class.
 276 Otherwise returns false.
 277
 278 =cut
 279
 280 sub HasRole {
 281     my $self = shift;
 282     my $type = shift;
 283     return scalar grep { $type eq $_ } $self->Roles;
 284 }
 285
 286 =head2 RoleGroup
 287
 288 Expects a role name as the first parameter which is used to load the
 289 L<RT::Group> for the specified role on this record.  Returns an unloaded
 290 L<RT::Group> object on failure.
 291
 292 =cut
 293
 294 sub RoleGroup {
 295     my $self  = shift;
 296     my $name  = shift;
 297     my $group = RT::Group->new( $self->CurrentUser );
 298
 299     if ($self->HasRole($name)) {
 300         $group->LoadRoleGroup(
 301             Object  => $self,
 302             Name    => $name,
 303         );
 304     }
 305     return $group;
 306 }
 307
 308 =head2 AddRoleMember
 309
 310 Adds the described L<RT::Principal> to the specified role group for this record.
 311
 312 Takes a set of key-value pairs:
 313
 314 =over 4
 315
 316 =item PrincipalId
 317
 318 Optional.  The ID of the L<RT::Principal> object to add.
 319
 320 =item User
 321
 322 Optional.  The Name or EmailAddress of an L<RT::User> to use as the
 323 principal.  If an email address is given, but a user matching it cannot
 324 be found, a new user will be created.
 325
 326 =item Group
 327
 328 Optional.  The Name of an L<RT::Group> to use as the principal.
 329
 330 =item Type
 331
 332 Required.  One of the valid roles for this record, as returned by L</Roles>.
 333
 334 =item ACL
 335
 336 Optional.  A subroutine reference which will be passed the role type and
 337 principal being added.  If it returns false, the method will fail with a
 338 status of "Permission denied".
 339
 340 =back
 341
 342 One, and only one, of I<PrincipalId>, I<User>, or I<Group> is required.
 343
 344 Returns a tuple of (principal object which was added, message).
 345
 346 =cut
 347
 348 sub AddRoleMember {
 349     my $self = shift;
 350     my %args = (@_);
 351
 352     return (0, $self->loc("One, and only one, of PrincipalId/User/Group is required"))
 353         if 1 != grep { $_ } @args{qw/PrincipalId User Group/};
 354
 355     my $type = delete $args{Type};
 356     return (0, $self->loc("No valid Type specified"))
 357         unless $type and $self->HasRole($type);
 358
 359     if ($args{PrincipalId}) {
 360         # Check the PrincipalId for loops
 361         my $principal = RT::Principal->new( $self->CurrentUser );
 362         $principal->Load($args{'PrincipalId'});
 363         if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) {
 364             return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop",
 365                                   $email, $self->loc($type)))
 366                 if RT::EmailParser->IsRTAddress( $email );
 367         }
 368     } else {
 369         if ($args{User}) {
 370             my $name = delete $args{User};
 371             # Sanity check the address
 372             return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop",
 373                                   $name, $self->loc($type) ))
 374                 if RT::EmailParser->IsRTAddress( $name );
 375
 376             # Create as the SystemUser, not the current user
 377             my $user = RT::User->new(RT->SystemUser);
 378             my ($ok, $msg);
 379             if ($name =~ /@/) {
 380                 ($ok, $msg) = $user->LoadOrCreateByEmail( $name );
 381             } else {
 382                 ($ok, $msg) = $user->Load( $name );
 383             }
 384             unless ($user->Id) {
 385                 # If we can't find this watcher, we need to bail.
 386                 $RT::Logger->error("Could not load or create a user '$name' to add as a watcher: $msg");
 387                 return (0, $self->loc("Could not find or create user '[_1]'", $name));
 388             }
 389             $args{PrincipalId} = $user->PrincipalId;
 390         }
 391         elsif ($args{Group}) {
 392             my $name = delete $args{Group};
 393             my $group = RT::Group->new( $self->CurrentUser );
 394             $group->LoadUserDefinedGroup($name);
 395             unless ($group->id) {
 396                 $RT::Logger->error("Could not load group '$name' to add as a watcher");
 397                 return (0, $self->loc("Could not find group '[_1]'", $name));
 398             }
 399             $args{PrincipalId} = $group->PrincipalObj->id;
 400         }
 401     }
 402
 403     my $principal = RT::Principal->new( $self->CurrentUser );
 404     $principal->Load( $args{PrincipalId} );
 405
 406     my $acl = delete $args{ACL};
 407     return (0, $self->loc("Permission denied"))
 408         if $acl and not $acl->($type => $principal);
 409
 410     my $group = $self->RoleGroup( $type );
 411     return (0, $self->loc("Role group '[_1]' not found", $type))
 412         unless $group->id;
 413
 414     return (0, $self->loc('[_1] is already a [_2]',
 415                           $principal->Object->Name, $self->loc($type)) )
 416             if $group->HasMember( $principal );
 417
 418     return (0, $self->loc('[_1] cannot be a group', $self->loc($type)) )
 419                 if $group->SingleMemberRoleGroup and $principal->IsGroup;
 420
 421     my ( $ok, $msg ) = $group->_AddMember( %args, RecordTransaction => !$args{Silent} );
 422     unless ($ok) {
 423         $RT::Logger->error("Failed to add $args{PrincipalId} as a member of group ".$group->Id.": ".$msg);
 424
 425         return ( 0, $self->loc('Could not make [_1] a [_2]',
 426                     $principal->Object->Name, $self->loc($type)) );
 427     }
 428
 429     return ($principal, $msg);
 430 }
 431
 432 =head2 DeleteRoleMember
 433
 434 Removes the specified L<RT::Principal> from the specified role group for this
 435 record.
 436
 437 Takes a set of key-value pairs:
 438
 439 =over 4
 440
 441 =item PrincipalId
 442
 443 Optional.  The ID of the L<RT::Principal> object to remove.
 444
 445 =item User
 446
 447 Optional.  The Name or EmailAddress of an L<RT::User> to use as the
 448 principal
 449
 450 =item Type
 451
 452 Required.  One of the valid roles for this record, as returned by L</Roles>.
 453
 454 =item ACL
 455
 456 Optional.  A subroutine reference which will be passed the role type and
 457 principal being removed.  If it returns false, the method will fail with a
 458 status of "Permission denied".
 459
 460 =back
 461
 462 One, and only one, of I<PrincipalId> or I<User> is required.
 463
 464 Returns a tuple of (principal object that was removed, message).
 465
 466 =cut
 467
 468 sub DeleteRoleMember {
 469     my $self = shift;
 470     my %args = (@_);
 471
 472     return (0, $self->loc("No valid Type specified"))
 473         unless $args{Type} and $self->HasRole($args{Type});
 474
 475     if ($args{User}) {
 476         my $user = RT::User->new( $self->CurrentUser );
 477         $user->LoadByEmail( $args{User} );
 478         $user->Load( $args{User} ) unless $user->id;
 479         return (0, $self->loc("Could not load user '[_1]'", $args{User}) )
 480             unless $user->id;
 481         $args{PrincipalId} = $user->PrincipalId;
 482     }
 483
 484     return (0, $self->loc("No valid PrincipalId"))
 485         unless $args{PrincipalId};
 486
 487     my $principal = RT::Principal->new( $self->CurrentUser );
 488     $principal->Load( $args{PrincipalId} );
 489
 490     my $acl = delete $args{ACL};
 491     return (0, $self->loc("Permission denied"))
 492         if $acl and not $acl->($args{Type} => $principal);
 493
 494     my $group = $self->RoleGroup( $args{Type} );
 495     return (0, $self->loc("Role group '[_1]' not found", $args{Type}))
 496         unless $group->id;
 497
 498     return ( 0, $self->loc( '[_1] is not a [_2]',
 499                             $principal->Object->Name, $self->loc($args{Type}) ) )
 500         unless $group->HasMember($principal);
 501
 502     my ($ok, $msg) = $group->_DeleteMember($args{PrincipalId}, RecordTransaction => !$args{Silent});
 503     unless ($ok) {
 504         $RT::Logger->error("Failed to remove $args{PrincipalId} as a member of group ".$group->Id.": ".$msg);
 505
 506         return ( 0, $self->loc('Could not remove [_1] as a [_2]',
 507                     $principal->Object->Name, $self->loc($args{Type})) );
 508     }
 509
 510     return ($principal, $msg);
 511 }
 512
 513 sub _ResolveRoles {
 514     my $self = shift;
 515     my ($roles, %args) = (@_);
 516
 517     my @errors;
 518     for my $role ($self->Roles) {
 519         if ($self->_ROLES->{$role}{Single}) {
 520             # Default to nobody if unspecified
 521             my $value = $args{$role} || RT->Nobody;
 522                $value = $value->[0] if ref $value eq 'ARRAY';
 523             if (Scalar::Util::blessed($value) and $value->isa("RT::User")) {
 524                 # Accept a user; it may not be loaded, which we catch below
 525                 $roles->{$role} = $value->PrincipalObj;
 526             } else {
 527                 # Try loading by id, name, then email.  If all fail, catch that below
 528                 my $user = RT::User->new( $self->CurrentUser );
 529                 $user->Load( $value );
 530                 # XXX: LoadOrCreateByEmail ?
 531                 $user->LoadByEmail( $value ) unless $user->id;
 532                 $roles->{$role} = $user->PrincipalObj;
 533             }
 534             unless (Scalar::Util::blessed($roles->{$role}) and $roles->{$role}->id) {
 535                 push @errors, $self->loc("Invalid value for [_1]",$self->loc($role));
 536                 $roles->{$role} = RT->Nobody->PrincipalObj;
 537             }
 538             # For consistency, we always return an arrayref
 539             $roles->{$role} = [ $roles->{$role} ];
 540         } else {
 541             $roles->{$role} = [];
 542             my @values = ref $args{ $role } ? @{ $args{$role} } : ($args{$role});
 543             for my $value (grep {defined} @values) {
 544                 if ( $value =~ /^\d+$/ ) {
 545                     # This implicitly allows groups, if passed by id.
 546                     my $principal = RT::Principal->new( $self->CurrentUser );
 547                     my ($ok, $msg) = $principal->Load( $value );
 548                     if ($ok) {
 549                         push @{ $roles->{$role} }, $principal;
 550                     } else {
 551                         push @errors,
 552                             $self->loc("Couldn't load principal: [_1]", $msg);
 553                     }
 554                 } else {
 555                     my @addresses = RT::EmailParser->ParseEmailAddress( $value );
 556                     for my $address ( @addresses ) {
 557                         my $user = RT::User->new( RT->SystemUser );
 558                         my ($id, $msg) = $user->LoadOrCreateByEmail( $address );
 559                         if ( $id ) {
 560                             # Load it back as us, not as the system
 561                             # user, to be completely safe.
 562                             $user = RT::User->new( $self->CurrentUser );
 563                             $user->Load( $id );
 564                             push @{ $roles->{$role} }, $user->PrincipalObj;
 565                         } else {
 566                             push @errors,
 567                                 $self->loc("Couldn't load or create user: [_1]", $msg);
 568                         }
 569                     }
 570                 }
 571             }
 572         }
 573     }
 574     return (@errors);
 575 }
 576
 577 sub _CreateRoleGroups {
 578     my $self = shift;
 579     my %args = (@_);
 580     for my $name ($self->Roles) {
 581         my $type_obj = RT::Group->new($self->CurrentUser);
 582         my ($id, $msg) = $type_obj->CreateRoleGroup(
 583             Name    => $name,
 584             Object  => $self,
 585             %args,
 586         );
 587         unless ($id) {
 588             $RT::Logger->error("Couldn't create a role group of type '$name' for ".ref($self)." ".
 589                                    $self->id.": ".$msg);
 590             return(undef);
 591         }
 592     }
 593     return(1);
 594 }
 595
 596 sub _AddRolesOnCreate {
 597     my $self = shift;
 598     my ($roles, %acls) = @_;
 599
 600     my @errors;
 601     {
 602         my $changed = 0;
 603
 604         for my $role (keys %{$roles}) {
 605             my $group = $self->RoleGroup($role);
 606             my @left;
 607             for my $principal (@{$roles->{$role}}) {
 608                 if ($acls{$role}->($principal)) {
 609                     next if $group->HasMember($principal);
 610                     my ($ok, $msg) = $group->_AddMember(
 611                         PrincipalId       => $principal->id,
 612                         InsideTransaction => 1,
 613                         RecordTransaction => 0,
 614                         Object            => $self,
 615                     );
 616                     push @errors, $self->loc("Couldn't set [_1] watcher: [_2]", $role, $msg)
 617                         unless $ok;
 618                     $changed++;
 619                 } else {
 620                     push @left, $principal;
 621                 }
 622             }
 623             $roles->{$role} = [ @left ];
 624         }
 625
 626         redo if $changed;
 627     }
 628
 629     return @errors;
 630 }
 631
 632
 633 1;