Master to 4.2.8
[usit-rt.git] / lib / RT / Record / Role / Roles.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2014 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;