Upgrade to 4.2.2
[usit-rt.git] / lib / RT / Record / Role / Roles.pm
CommitLineData
af59614d
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
af59614d
MKG
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
49use strict;
50use warnings;
51
52package RT::Record::Role::Roles;
53use Role::Basic;
54use Scalar::Util qw(blessed);
55
56=head1 NAME
57
58RT::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
66with 'RT::Record::Role';
67
68require RT::System;
69require RT::Principal;
70require RT::Group;
71require RT::User;
72
73require RT::EmailParser;
74
75=head1 PROVIDES
76
77=head2 RegisterRole
78
79Registers an RT role which applies to this class for role-based access control.
80Arguments:
81
82=over 4
83
84=item Name
85
86Required. The role name (i.e. Requestor, Owner, AdminCc, etc).
87
88=item EquivClasses
89
90Optional. Array ref of classes through which this role percolates up to
91L<RT::System>. You can think of this list as:
92
93 map { ref } $record_object->ACLEquivalenceObjects;
94
95You should not include L<RT::System> itself in this list.
96
97Simply calls RegisterRole on each equivalent class.
98
99=item Single
100
101Optional. A true value indicates that this role may only contain a single user
102as a member at any given time. When adding a new member to a Single role, any
103existing member will be removed. If all members are removed, L<RT/Nobody> is
104added automatically.
105
106=item Column
107
108Optional, implies Single. Specifies a column on the announcing class into
109which the single role member's user ID is denormalized. The column will be
110kept updated automatically as the role member changes. This is used, for
111example, for ticket owners and makes searching simpler (among other benefits).
112
113=item ACLOnly
114
115Optional. A true value indicates this role is only used for ACLs and should
116not be populated with members.
117
118This flag is advisory only, and the Perl API still allows members to be added
119to ACLOnly roles.
120
121=item ACLOnlyInEquiv
122
123Optional. Automatically sets the ACLOnly flag for all EquivClasses, but not
124the announcing class.
125
126=item SortOrder
127
128Optional. A numeric value indicating the position of this role when sorted
129ascending with other roles in a list. Roles with the same sort order are
130ordered alphabetically by name within themselves.
131
132=back
133
134=cut
135
136sub 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
176Removes an RT role which applies to this class for role-based access control.
177Any roles on equivalent classes (via EquivClasses passed to L</RegisterRole>)
178are also unregistered.
179
180Takes a role name as the sole argument.
181
182B<Use this carefully:> Objects created after a role is unregistered will not
183have an associated L<RT::Group> for the removed role. If you later decide to
184stop unregistering the role, operations on those objects created in the
185meantime will fail when trying to interact with the missing role groups.
186
187B<Unregistering a role may break code which assumes the role exists.>
188
189=cut
190
191sub 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
206Takes a role name; returns a hashref describing the role. This hashref
207contains the same attributes used to register the role (see L</RegisterRole>),
208as well as some extras, including:
209
210=over
211
212=item Class
213
214The original class which announced the role. This is set automatically by
215L</RegisterRole> and is the same across all EquivClasses.
216
217=back
218
219Returns an empty hashref if the role doesn't exist.
220
221=cut
222
223sub Role {
224 return \%{ $_[0]->_ROLES->{$_[1]} || {} };
225}
226
227=head2 Roles
228
229Returns a list of role names registered for this class, sorted ascending by
230SortOrder and then alphabetically by name.
231
232Optionally takes a hash specifying attributes the returned roles must possess
233or lack. Testing is done on a simple truthy basis and the actual values of
234the role attributes and arguments you pass are not compared string-wise or
235numerically; they must simply evaluate to the same truthiness.
236
237For 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
248sub 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
275Returns true if the name provided is a registered role for this class.
276Otherwise returns false.
277
278=cut
279
280sub HasRole {
281 my $self = shift;
282 my $type = shift;
283 return scalar grep { $type eq $_ } $self->Roles;
284}
285
286=head2 RoleGroup
287
288Expects a role name as the first parameter which is used to load the
289L<RT::Group> for the specified role on this record. Returns an unloaded
290L<RT::Group> object on failure.
291
292=cut
293
294sub 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
310Adds the described L<RT::Principal> to the specified role group for this record.
311
312Takes a set of key-value pairs:
313
314=over 4
315
316=item PrincipalId
317
318Optional. The ID of the L<RT::Principal> object to add.
319
320=item User
321
322Optional. The Name or EmailAddress of an L<RT::User> to use as the
323principal. If an email address is given, but a user matching it cannot
324be found, a new user will be created.
325
326=item Group
327
328Optional. The Name of an L<RT::Group> to use as the principal.
329
330=item Type
331
332Required. One of the valid roles for this record, as returned by L</Roles>.
333
334=item ACL
335
336Optional. A subroutine reference which will be passed the role type and
337principal being added. If it returns false, the method will fail with a
338status of "Permission denied".
339
340=back
341
342One, and only one, of I<PrincipalId>, I<User>, or I<Group> is required.
343
344Returns a tuple of (principal object which was added, message).
345
346=cut
347
348sub 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
434Removes the specified L<RT::Principal> from the specified role group for this
435record.
436
437Takes a set of key-value pairs:
438
439=over 4
440
441=item PrincipalId
442
443Optional. The ID of the L<RT::Principal> object to remove.
444
445=item User
446
447Optional. The Name or EmailAddress of an L<RT::User> to use as the
448principal
449
450=item Type
451
452Required. One of the valid roles for this record, as returned by L</Roles>.
453
454=back
455
456One, and only one, of I<PrincipalId> or I<User> is required.
457
458Returns a tuple of (principal object that was removed, message).
459
460=cut
461
462sub DeleteRoleMember {
463 my $self = shift;
464 my %args = (@_);
465
466 return (0, $self->loc("No valid Type specified"))
467 unless $args{Type} and $self->HasRole($args{Type});
468
469 if ($args{User}) {
470 my $user = RT::User->new( $self->CurrentUser );
471 $user->LoadByEmail( $args{User} );
472 $user->Load( $args{User} ) unless $user->id;
473 return (0, $self->loc("Could not load user '[_1]'", $args{User}) )
474 unless $user->id;
475 $args{PrincipalId} = $user->PrincipalId;
476 }
477
478 return (0, $self->loc("No valid PrincipalId"))
479 unless $args{PrincipalId};
480
481 my $principal = RT::Principal->new( $self->CurrentUser );
482 $principal->Load( $args{PrincipalId} );
483
484 my $acl = delete $args{ACL};
485 return (0, $self->loc("Permission denied"))
486 if $acl and not $acl->($principal);
487
488 my $group = $self->RoleGroup( $args{Type} );
489 return (0, $self->loc("Role group '[_1]' not found", $args{Type}))
490 unless $group->id;
491
492 return ( 0, $self->loc( '[_1] is not a [_2]',
493 $principal->Object->Name, $self->loc($args{Type}) ) )
494 unless $group->HasMember($principal);
495
496 my ($ok, $msg) = $group->_DeleteMember($args{PrincipalId}, RecordTransaction => !$args{Silent});
497 unless ($ok) {
498 $RT::Logger->error("Failed to remove $args{PrincipalId} as a member of group ".$group->Id.": ".$msg);
499
500 return ( 0, $self->loc('Could not remove [_1] as a [_2]',
501 $principal->Object->Name, $self->loc($args{Type})) );
502 }
503
504 return ($principal, $msg);
505}
506
507sub _ResolveRoles {
508 my $self = shift;
509 my ($roles, %args) = (@_);
510
511 my @errors;
512 for my $role ($self->Roles) {
513 if ($self->_ROLES->{$role}{Single}) {
514 # Default to nobody if unspecified
515 my $value = $args{$role} || RT->Nobody;
516 if (Scalar::Util::blessed($value) and $value->isa("RT::User")) {
517 # Accept a user; it may not be loaded, which we catch below
518 $roles->{$role} = $value->PrincipalObj;
519 } else {
520 # Try loading by id, name, then email. If all fail, catch that below
521 my $user = RT::User->new( $self->CurrentUser );
522 $user->Load( $value );
523 # XXX: LoadOrCreateByEmail ?
524 $user->LoadByEmail( $value ) unless $user->id;
525 $roles->{$role} = $user->PrincipalObj;
526 }
527 unless ($roles->{$role}->id) {
528 push @errors, $self->loc("Invalid value for [_1]",loc($role));
529 $roles->{$role} = RT->Nobody->PrincipalObj unless $roles->{$role}->id;
530 }
531 # For consistency, we always return an arrayref
532 $roles->{$role} = [ $roles->{$role} ];
533 } else {
534 $roles->{$role} = [];
535 my @values = ref $args{ $role } ? @{ $args{$role} } : ($args{$role});
536 for my $value (grep {defined} @values) {
537 if ( $value =~ /^\d+$/ ) {
538 # This implicitly allows groups, if passed by id.
539 my $principal = RT::Principal->new( $self->CurrentUser );
540 my ($ok, $msg) = $principal->Load( $value );
541 if ($ok) {
542 push @{ $roles->{$role} }, $principal;
543 } else {
544 push @errors,
545 $self->loc("Couldn't load principal: [_1]", $msg);
546 }
547 } else {
548 my @addresses = RT::EmailParser->ParseEmailAddress( $value );
549 for my $address ( @addresses ) {
550 my $user = RT::User->new( RT->SystemUser );
551 my ($id, $msg) = $user->LoadOrCreateByEmail( $address );
552 if ( $id ) {
553 # Load it back as us, not as the system
554 # user, to be completely safe.
555 $user = RT::User->new( $self->CurrentUser );
556 $user->Load( $id );
557 push @{ $roles->{$role} }, $user->PrincipalObj;
558 } else {
559 push @errors,
560 $self->loc("Couldn't load or create user: [_1]", $msg);
561 }
562 }
563 }
564 }
565 }
566 }
567 return (@errors);
568}
569
570sub _CreateRoleGroups {
571 my $self = shift;
572 my %args = (@_);
573 for my $name ($self->Roles) {
574 my $type_obj = RT::Group->new($self->CurrentUser);
575 my ($id, $msg) = $type_obj->CreateRoleGroup(
576 Name => $name,
577 Object => $self,
578 %args,
579 );
580 unless ($id) {
581 $RT::Logger->error("Couldn't create a role group of type '$name' for ".ref($self)." ".
582 $self->id.": ".$msg);
583 return(undef);
584 }
585 }
586 return(1);
587}
588
589sub _AddRolesOnCreate {
590 my $self = shift;
591 my ($roles, %acls) = @_;
592
593 my @errors;
594 {
595 my $changed = 0;
596
597 for my $role (keys %{$roles}) {
598 my $group = $self->RoleGroup($role);
599 my @left;
600 for my $principal (@{$roles->{$role}}) {
601 if ($acls{$role}->($principal)) {
602 next if $group->HasMember($principal);
603 my ($ok, $msg) = $group->_AddMember(
604 PrincipalId => $principal->id,
605 InsideTransaction => 1,
606 RecordTransaction => 0,
607 Object => $self,
608 );
609 push @errors, $self->loc("Couldn't set [_1] watcher: [_2]", $role, $msg)
610 unless $ok;
611 $changed++;
612 } else {
613 push @left, $principal;
614 }
615 }
616 $roles->{$role} = [ @left ];
617 }
618
619 redo if $changed;
620 }
621
622 return @errors;
623}
624
625
6261;