[Rt-commit] rt branch, 4.2/extensible-roles, created. rt-4.0.6-518-gad7235c

Thomas Sibley trs at bestpractical.com
Wed Oct 31 19:28:14 EDT 2012


The branch, 4.2/extensible-roles has been created
        at  ad7235c12da6c1d1e774dd9eda45c95fe6ea7727 (commit)

- Log -----------------------------------------------------------------
commit dc22b7c0fa9e34f991e4a574440de492156629ef
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Aug 28 12:15:33 2012 -0700

    Convert tabs to spaces; whitespace only change

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index b367b2f..78d007c 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -187,32 +187,32 @@ Returns a user-readable description of what this group is for and what it's name
 =cut
 
 sub SelfDescription {
-	my $self = shift;
-	if ($self->Domain eq 'ACLEquivalence') {
-		my $user = RT::Principal->new($self->CurrentUser);
-		$user->Load($self->Instance);
-		return $self->loc("user [_1]",$user->Object->Name);
-	}
-	elsif ($self->Domain eq 'UserDefined') {
-		return $self->loc("group '[_1]'",$self->Name);
-	}
-	elsif ($self->Domain eq 'RT::System-Role') {
-		return $self->loc("system [_1]",$self->Type);
-	}
-	elsif ($self->Domain eq 'RT::Queue-Role') {
-		my $queue = RT::Queue->new($self->CurrentUser);
-		$queue->Load($self->Instance);
-		return $self->loc("queue [_1] [_2]",$queue->Name, $self->Type);
-	}
-	elsif ($self->Domain eq 'RT::Ticket-Role') {
-		return $self->loc("ticket #[_1] [_2]",$self->Instance, $self->Type);
-	}
-	elsif ($self->Domain eq 'SystemInternal') {
-		return $self->loc("system group '[_1]'",$self->Type);
-	}
-	else {
-		return $self->loc("undescribed group [_1]",$self->Id);
-	}
+    my $self = shift;
+    if ($self->Domain eq 'ACLEquivalence') {
+        my $user = RT::Principal->new($self->CurrentUser);
+        $user->Load($self->Instance);
+        return $self->loc("user [_1]",$user->Object->Name);
+    }
+    elsif ($self->Domain eq 'UserDefined') {
+        return $self->loc("group '[_1]'",$self->Name);
+    }
+    elsif ($self->Domain eq 'RT::System-Role') {
+        return $self->loc("system [_1]",$self->Type);
+    }
+    elsif ($self->Domain eq 'RT::Queue-Role') {
+        my $queue = RT::Queue->new($self->CurrentUser);
+        $queue->Load($self->Instance);
+        return $self->loc("queue [_1] [_2]",$queue->Name, $self->Type);
+    }
+    elsif ($self->Domain eq 'RT::Ticket-Role') {
+        return $self->loc("ticket #[_1] [_2]",$self->Instance, $self->Type);
+    }
+    elsif ($self->Domain eq 'SystemInternal') {
+        return $self->loc("system group '[_1]'",$self->Type);
+    }
+    else {
+        return $self->loc("undescribed group [_1]",$self->Id);
+    }
 }
 
 

commit 34dc7ebd9b2b4ee192c91abab3753b9a33a13261
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Aug 28 12:19:21 2012 -0700

    LimitToRolesForTicket never worked because of non-interpolating single quotes

diff --git a/lib/RT/Groups.pm b/lib/RT/Groups.pm
index 1bb571b..26e8224 100644
--- a/lib/RT/Groups.pm
+++ b/lib/RT/Groups.pm
@@ -194,7 +194,7 @@ sub LimitToRolesForTicket {
     my $self = shift;
     my $Ticket = shift;
     $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Ticket-Role');
-    $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => '$Ticket');
+    $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $Ticket);
 }
 
 

commit db5415304fe0ef98ba293cf9bbfc9f9c23797c98
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Aug 28 12:24:36 2012 -0700

    Handling roles on arbitrary objects in the rights editor
    
    The rights editor now supports editing rights on arbitrary roles on any
    object, not just queues and globally.  (It still requires you extend RT's
    core roles with your own, of course.)
    
    Adds a new method on RT::Groups, LimitToRolesForObject, which
    limits by Domain and Instance appropriately for the object given.  The
    new method abstracts away more of the details of roles on objects.

diff --git a/lib/RT/Groups.pm b/lib/RT/Groups.pm
index 26e8224..acfd823 100644
--- a/lib/RT/Groups.pm
+++ b/lib/RT/Groups.pm
@@ -166,11 +166,30 @@ sub LimitToUserDefinedGroups {
     #$self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => '');
 }
 
+=head2 LimitToRolesForObject OBJECT
 
+Limits the set of groups to role groups specifically for the object in question
+based on the object's class and ID.  If the object has no ID, the roles are not
+limited by group C<Instance>.  That is, calling this method on an unloaded
+object will find all role groups for that class of object.
 
+Replaces L</LimitToRolesForQueue>, L</LimitToRolesForTicket>, and
+L</LimitToRolesForSystem>.
+
+=cut
+
+sub LimitToRolesForObject {
+    my $self   = shift;
+    my $object = shift;
+    $self->Limit(FIELD => 'Domain',   OPERATOR => '=', VALUE => ref($object) . "-Role");
+    $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $object->id)
+        if $object->id and not ref($object) eq "RT::System";
+}
 
 =head2 LimitToRolesForQueue QUEUE_ID
 
+B<DEPRECATED>. Use L</LimitToRolesForObject> instead.
+
 Limits the set of groups found to role groups for queue QUEUE_ID
 
 =cut
@@ -178,6 +197,7 @@ Limits the set of groups found to role groups for queue QUEUE_ID
 sub LimitToRolesForQueue {
     my $self = shift;
     my $queue = shift;
+    RT->Logger->warning("LimitToRolesForQueue is deprecated; please change code to use LimitToRolesForObject (caller @{[join '/', caller]})");
     $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Queue-Role');
     $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $queue);
 }
@@ -186,6 +206,8 @@ sub LimitToRolesForQueue {
 
 =head2 LimitToRolesForTicket Ticket_ID
 
+B<DEPRECATED>. Use L</LimitToRolesForObject> instead.
+
 Limits the set of groups found to role groups for Ticket Ticket_ID
 
 =cut
@@ -193,6 +215,7 @@ Limits the set of groups found to role groups for Ticket Ticket_ID
 sub LimitToRolesForTicket {
     my $self = shift;
     my $Ticket = shift;
+    RT->Logger->warning("LimitToRolesForTicket is deprecated; please change code to use LimitToRolesForObject (caller @{[join '/', caller]})");
     $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::Ticket-Role');
     $self->Limit(FIELD => 'Instance', OPERATOR => '=', VALUE => $Ticket);
 }
@@ -201,12 +224,15 @@ sub LimitToRolesForTicket {
 
 =head2 LimitToRolesForSystem System_ID
 
+B<DEPRECATED>. Use L</LimitToRolesForObject> instead.
+
 Limits the set of groups found to role groups for System System_ID
 
 =cut
 
 sub LimitToRolesForSystem {
     my $self = shift;
+    RT->Logger->warning("LimitToRolesForSystem is deprecated; please change code to use LimitToRolesForObject (caller @{[join '/', caller]})");
     $self->Limit(FIELD => 'Domain', OPERATOR => '=', VALUE => 'RT::System-Role');
 }
 
diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index d036518..2a39f9d 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -3051,17 +3051,7 @@ sub GetPrincipalsMap {
         }
         elsif (/Roles/) {
             my $roles = RT::Groups->new($session{'CurrentUser'});
-
-            if ($object->isa('RT::System')) {
-                $roles->LimitToRolesForSystem();
-            }
-            elsif ($object->isa('RT::Queue')) {
-                $roles->LimitToRolesForQueue($object->Id);
-            }
-            else {
-                $RT::Logger->warn("Skipping unknown object type ($object) for Role principals");
-                next;
-            }
+            $roles->LimitToRolesForObject($object);
             $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
             push @map, [
                 'Roles' => $roles,  # loc_left_pair

commit 3e4e5b9126363e45972b19c618940f0eeba9c6ea
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Aug 28 14:45:03 2012 -0700

    Automatic friendly descriptions for arbitrary role groups
    
    SelfDescription isn't used by core RT, but by providing generic support
    in core, extensions which add role groups don't need to override the
    method for any non-core code which may use it.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index 78d007c..dbdc102 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -207,6 +207,11 @@ sub SelfDescription {
     elsif ($self->Domain eq 'RT::Ticket-Role') {
         return $self->loc("ticket #[_1] [_2]",$self->Instance, $self->Type);
     }
+    elsif ($self->Domain =~ /^(.+)-Role$/) {
+        my $class = lc $1;
+           $class =~ s/^RT:://i;
+        return $self->loc("[_1] #[_2] [_3]", $self->loc($class), $self->Instance, $self->Type);
+    }
     elsif ($self->Domain eq 'SystemInternal') {
         return $self->loc("system group '[_1]'",$self->Type);
     }

commit f9d4e04f2694979ae21e48c03be9a3b8ca5dac17
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Aug 28 15:55:49 2012 -0700

    Convenience method to load arbitrary role groups based on an object
    
    Rather than requiring the caller to discern the class of object and call
    one of the class specific load methods, just pass in the object itself
    and be happy.
    
    RT::Test->add_rights now uses this and as such supports granting rights
    to role groups on objects other than queues or the global system.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index dbdc102..d6bcd93 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -316,6 +316,29 @@ sub LoadSystemInternalGroup {
     );
 }
 
+=head2 LoadRoleGroup
+
+Takes a paramhash of Object and Type and attempts to load the suitable role
+group for said object.
+
+=cut
+
+sub LoadRoleGroup {
+    my $self = shift;
+    my %args = (
+        Object  => undef,
+        Type    => undef,
+        @_
+    );
+
+    # Translate Object to Domain + Instance
+    my $object      = delete $args{Object};
+    $args{Domain}   = ref($object) . "-Role";
+    $args{Instance} = $object->id
+        if $object->id and not ref($object) eq 'RT::System';
+
+    return $self->LoadByCols(%args);
+}
 
 
 =head2 LoadTicketRoleGroup  { Ticket => TICKET_ID, Type => TYPE }
diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index 385ddf7..823da63 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -899,16 +899,16 @@ sub add_rights {
             if ( $principal =~ /^(everyone|(?:un)?privileged)$/i ) {
                 $principal = RT::Group->new( RT->SystemUser );
                 $principal->LoadSystemInternalGroup($1);
-            } elsif ( $principal =~ /^(Owner|Requestor|(?:Admin)?Cc)$/i ) {
+            } else {
+                my $type = $principal;
                 $principal = RT::Group->new( RT->SystemUser );
-                $principal->LoadByCols(
-                    Domain => (ref($e->{'Object'})||'RT::System').'-Role',
-                    Type => $1,
-                    ref($e->{'Object'})? (Instance => $e->{'Object'}->id): (),
+                $principal->LoadRoleGroup(
+                    Object  => ($e->{'Object'} || RT->System),
+                    Type    => $type
                 );
-            } else {
-                die "principal is not an object, but also is not name of a system group";
             }
+            die "Principal is not an object nor the name of a system or role group"
+                unless $principal->id;
         }
         unless ( $principal->isa('RT::Principal') ) {
             if ( $principal->can('PrincipalObj') ) {

commit 401616d42069d6f450a973c09cc412ac200b3ba1
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Thu Sep 13 17:13:16 2012 -0700

    CreateRoleGroup can take an Object in place of Domain and Instance
    
    Paves the way for easier creation of role groups on arbitrary objects.
    
    Flesh out the documentation for CreateRoleGroup while I'm at it.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index d6bcd93..f0049cb 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -606,16 +606,47 @@ sub _CreateACLEquivalenceGroup {
 
 
 
-=head2 CreateRoleGroup { Domain => DOMAIN, Type =>  TYPE, Instance => ID }
+=head2 CreateRoleGroup
 
-A helper subroutine which creates a  ticket group. (What RT 2.0 called Ticket watchers)
-Type is one of ( "Requestor" || "Cc" || "AdminCc" || "Owner") 
-Domain is one of (RT::Ticket-Role || RT::Queue-Role || RT::System-Role)
-Instance is the id of the ticket or queue in question
+A convenience method for creating a role group on an object.
 
-This routine expects to be called from {Ticket||Queue}->CreateTicketGroups _inside of a transaction_
+Takes a paramhash of:
 
-Returns a tuple of (Id, Message).  If id is 0, the create failed
+=over 4
+
+=item Type
+
+Required.  RT's core role types are C<Requestor>, C<Cc>, C<AdminCc>, and
+C<Owner>.  Extensions may add their own.
+
+=item Object
+
+Optional.  The object on which this role applies, used to set Domain and
+Instance automatically.
+
+=item Domain
+
+Optional.  The class on which this role applies, with C<-Role> appended.  RT's
+supported core role group domains are C<RT::Ticket-Role>, C<RT::Queue-Role>,
+and C<RT::System-Role>.
+
+Not required if you pass an Object.
+
+=item Instance
+
+Optional.  The numeric ID of the object (of the class encoded in Domain) on
+which this role applies.  If Domain is C<RT::System-Role>, Instance should be C<0>.
+
+Not required if you pass an Object.
+
+=back
+
+You must pass either an Object or both Domain and Instance.
+
+This method must be called from B<inside of a database transaction>!
+
+Returns a tuple of (id, Message).  If id is false, the create failed and
+Message should contain an error string.
 
 =cut
 
@@ -624,17 +655,24 @@ sub CreateRoleGroup {
     my %args = ( Instance => undef,
                  Type     => undef,
                  Domain   => undef,
+                 Object   => undef,
                  @_ );
 
+    # Translate Object to Domain + Instance
+    if ( my $object = delete $args{Object} ) {
+        $args{Domain}   = ref($object) . "-Role";
+        $args{Instance} = ref($object) eq "RT::System" ? 0 : $object->id;
+    }
+
     unless (RT::Queue->IsRoleGroupType($args{Type})) {
         return ( 0, $self->loc("Invalid Group Type") );
     }
 
+    return $self->_Create(
+        InsideTransaction => 1,
+        map { $_ => $args{$_} } qw(Domain Instance Type),
+    );
 
-    return ( $self->_Create( Domain            => $args{'Domain'},
-                             Instance          => $args{'Instance'},
-                             Type              => $args{'Type'},
-                             InsideTransaction => 1 ) );
 }
 
 
diff --git a/lib/RT/Queue.pm b/lib/RT/Queue.pm
index 4f3a051..be1f16f 100644
--- a/lib/RT/Queue.pm
+++ b/lib/RT/Queue.pm
@@ -790,9 +790,10 @@ sub _CreateQueueRoleGroup {
     my $type = shift;
 
     my $type_obj = RT::Group->new($self->CurrentUser);
-    my ($id, $msg) = $type_obj->CreateRoleGroup(Instance => $self->Id, 
-                                                    Type => $type,
-                                                    Domain => 'RT::Queue-Role');
+    my ($id, $msg) = $type_obj->CreateRoleGroup(
+        Type    => $type,
+        Object  => $self,
+    );
     unless ($id) {
         $RT::Logger->error("Couldn't create a Queue group of type '$type' for queue ".
                             $self->Id.": ".$msg);
diff --git a/lib/RT/Ticket.pm b/lib/RT/Ticket.pm
index 427241f..bfa1fc3 100644
--- a/lib/RT/Ticket.pm
+++ b/lib/RT/Ticket.pm
@@ -995,9 +995,10 @@ sub _CreateTicketGroups {
 
     foreach my $type (@types) {
         my $type_obj = RT::Group->new($self->CurrentUser);
-        my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role',
-                                                       Instance => $self->Id, 
-                                                       Type => $type);
+        my ($id, $msg) = $type_obj->CreateRoleGroup(
+            Type    => $type,
+            Object  => $self,
+        );
         unless ($id) {
             $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ".
                                $self->Id.": ".$msg);     

commit b4a295cf78f79315728bf14e6bafc8120cbc374d
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Thu Sep 13 17:16:10 2012 -0700

    Don't assume new role groups are for tickets/queues
    
    CreateRoleGroup no longer assumes the role is one RT::Queue will know
    about when validating.  Instead, RT::Group maintains a map of role names
    to valid classes.  The core roles are hardcoded, but extensions are free
    to push into the %ROLES package variable and start using CreateRoleGroup
    for roles on other object types.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index f0049cb..f5c93d6 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -62,12 +62,6 @@ my $group = RT::Group->new($CurrentUser);
 
 An RT group object.
 
-=head1 METHODS
-
-
-
-
-
 =cut
 
 
@@ -119,8 +113,35 @@ $RIGHT_CATEGORIES = {
 # Tell RT::ACE that this sort of object can get acls granted
 $RT::ACE::OBJECT_TYPES{'RT::Group'} = 1;
 
+=head1 PACKAGE VARIABLES
+
+=head2 %ROLES
+
+If you need to know the roles provided by a class, use L</RolesOf>.  If you
+want to validate a role type and domain pair, use L</ValidateRoleGroup>.
+
+B<You should not need to touch this variable directly unless you're adding new
+roles into RT.>
+
+Defines which roles are valid for which classes.  In terms of groups, this maps
+group Types to Domains (minus the C<-Role> suffix), providing valid (Domain,
+Type) pairs.
+
+L<RT::System> is implicitly valid for all roles, as the ACL system assumes such
+and there's not much value requiring it repeated here.
+
+The right hand side essentially lists the class names for the possible
+ACLEquivalenceObjects.
+
+=cut
+
+our %ROLES = (
+    Requestor   => [qw(RT::Ticket RT::Queue)],
+    Cc          => [qw(RT::Ticket RT::Queue)],
+    Owner       => [qw(RT::Ticket RT::Queue)],
+    AdminCc     => [qw(RT::Ticket RT::Queue)],
+);
 
-#
 
 # TODO: This should be refactored out into an RT::ACLedObject or something
 # stuff the rights into a hash of rights that can exist.
@@ -128,6 +149,8 @@ $RT::ACE::OBJECT_TYPES{'RT::Group'} = 1;
 __PACKAGE__->AddRights(%$RIGHTS);
 __PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES);
 
+=head1 METHODS
+
 =head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...]
 
 Adds the given rights to the list of possible rights.  This method
@@ -664,18 +687,63 @@ sub CreateRoleGroup {
         $args{Instance} = ref($object) eq "RT::System" ? 0 : $object->id;
     }
 
-    unless (RT::Queue->IsRoleGroupType($args{Type})) {
-        return ( 0, $self->loc("Invalid Group Type") );
+    # XXX I WISH: If this was Moose and we had Roles to implement roles, we'd
+    # take a class or object, check $class->DOES('ACLRole'), and then call
+    # $class->IsValidRole($Type) or similar if DOES was true.
+    unless ($self->ValidateRoleGroup(%args)) {
+        return ( 0, $self->loc("Invalid Group Type and Domain") );
     }
 
     return $self->_Create(
         InsideTransaction => 1,
         map { $_ => $args{$_} } qw(Domain Instance Type),
     );
+}
+
+=head2 ValidateRoleGroup
+
+Takes a param hash containing Domain and Type which are expected to be values
+passed into L</CreateRoleGroup>.  Returns true if the specified Type is a valid
+role on the specified Domain.  Otherwise returns false.
+
+All roles are valid for the global Domain (C<RT::System-Role>).
+
+=cut
+
+sub ValidateRoleGroup {
+    my $self = shift;
+    my %args = (@_);
+    return 0 unless $args{Domain} and $args{Type};
+
+    my $classes = $ROLES{ $args{Type} };
+    return 0 unless $classes and ref($classes) eq 'ARRAY';
 
+    my ($domain) = $args{Domain} =~ /^(.+)-Role$/;
+
+    # All roles are valid for the global domain (RT::System), and we've already
+    # determined this is a role defined in %ROLES.
+    return 1 if $domain eq "RT::System";
+    return 1 if grep { $_ eq $domain } @$classes;
+    return 0;
 }
 
+=head2 RolesOf
+
+Takes a class name or object, and returns the names of the roles which apply to
+the class.
 
+=cut
+
+sub RolesOf {
+    my $self  = shift;
+    my $class = ref($_[0]) || $_[0];
+    my @roles;
+    for my $role (keys %ROLES) {
+        push @roles, $role
+            if grep { $_ eq $class } @{$ROLES{$role}};
+    }
+    return @roles;
+}
 
 =head2 Delete
 

commit 006e54101a71751218a083cce34b74be294cbfee
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Thu Sep 13 17:23:09 2012 -0700

    Implement RT::Queue's methods about roles using the new methods of RT::Group
    
    Now extensions can add new roles to queues/tickets as well, at least at
    the API level.

diff --git a/lib/RT/Queue.pm b/lib/RT/Queue.pm
index be1f16f..8370185 100644
--- a/lib/RT/Queue.pm
+++ b/lib/RT/Queue.pm
@@ -703,15 +703,22 @@ sub TicketTransactionCustomFields {
 
 =head2 AllRoleGroupTypes
 
-Returns a list of the names of the various role group types that this queue
-has, including Requestor and Owner. If you don't want them, see
-L</ManageableRoleGroupTypes>.
+B<DEPRECATED> and will be removed in a future release. Use L<RT::Group/RolesOf>
+instead.
+
+Returns a list of the names of the various role group types for Queues,
+including roles used only for ACLs like Requestor and Owner. If you don't want
+them, see L</ManageableRoleGroupTypes>.
 
 =cut
 
 sub AllRoleGroupTypes {
-    my $self = shift;
-    return ($self->ManageableRoleGroupTypes, qw(Requestor Owner));
+    RT->Logger->warn(<<"    .");
+RT::Queue->AllRoleGroupTypes is DEPRECATED and will be removed in a future release.
+
+Please use RT::Group->RolesOf('RT::Queue') instead at @{[join '/', caller]}.
+    .
+    RT::Group->RolesOf('RT::Queue')
 }
 
 =head2 IsRoleGroupType
@@ -724,22 +731,24 @@ sub IsRoleGroupType {
     my $self = shift;
     my $type = shift;
 
-    for my $valid_type ($self->AllRoleGroupTypes) {
-        return 1 if $type eq $valid_type;
-    }
-
-    return 0;
+    return RT::Group->ValidateRoleGroup(
+        Domain  => 'RT::Queue-Role',
+        Type    => $type,
+    );
 }
 
 =head2 ManageableRoleGroupTypes
 
-Returns a list of the names of the various role group types that this queue
-has, excluding Requestor and Owner. If you want them, see L</AllRoleGroupTypes>.
+Returns a list of the names of the various role group types for Queues,
+excluding ones used only for ACLs such as Requestor and Owner. If you want
+them, see L<RT::Group/RolesOf>.
 
 =cut
 
 sub ManageableRoleGroupTypes {
-    return qw(Cc AdminCc);
+    # This grep is a little hacky, but I don't want to introduce the concept of
+    # manageable vs. unmanageable roles globally (yet).
+    return grep { not /^(Requestor|Owner)$/ } RT::Group->RolesOf('RT::Queue');
 }
 
 =head2 IsManageableRoleGroupType
@@ -775,9 +784,7 @@ It will return true on success and undef on failure.
 sub _CreateQueueGroups {
     my $self = shift;
 
-    my @types = $self->AllRoleGroupTypes;
-
-    foreach my $type (@types) {
+    foreach my $type (RT::Group->RolesOf($self)) {
         my $ok = $self->_CreateQueueRoleGroup($type);
         return undef if !$ok;
     }
diff --git a/lib/RT/Ticket.pm b/lib/RT/Ticket.pm
index bfa1fc3..5b6a061 100644
--- a/lib/RT/Ticket.pm
+++ b/lib/RT/Ticket.pm
@@ -991,9 +991,7 @@ It will return true on success and undef on failure.
 sub _CreateTicketGroups {
     my $self = shift;
     
-    my @types = (qw(Requestor Owner Cc AdminCc));
-
-    foreach my $type (@types) {
+    foreach my $type (RT::Group->RolesOf($self)) {
         my $type_obj = RT::Group->new($self->CurrentUser);
         my ($id, $msg) = $type_obj->CreateRoleGroup(
             Type    => $type,

commit 28c05ea4d2b0d9a8d0ac3dab99d42e31c5d886c3
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 12:40:04 2012 -0700

    Refactor role registration metadata into RT::Record
    
    The RegisterRole method replaces pushing into %RT::Group::ROLES and
    knows how to handle equivalent classes and RT::System.  This allows
    greater flexibility to add metadata in the future (such as manageable
    vs. unmanageable role types).
    
    RT::Record->Roles replaces RT::Group->RolesOf(RT::Record).

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index f5c93d6..1f48df1 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -113,36 +113,6 @@ $RIGHT_CATEGORIES = {
 # Tell RT::ACE that this sort of object can get acls granted
 $RT::ACE::OBJECT_TYPES{'RT::Group'} = 1;
 
-=head1 PACKAGE VARIABLES
-
-=head2 %ROLES
-
-If you need to know the roles provided by a class, use L</RolesOf>.  If you
-want to validate a role type and domain pair, use L</ValidateRoleGroup>.
-
-B<You should not need to touch this variable directly unless you're adding new
-roles into RT.>
-
-Defines which roles are valid for which classes.  In terms of groups, this maps
-group Types to Domains (minus the C<-Role> suffix), providing valid (Domain,
-Type) pairs.
-
-L<RT::System> is implicitly valid for all roles, as the ACL system assumes such
-and there's not much value requiring it repeated here.
-
-The right hand side essentially lists the class names for the possible
-ACLEquivalenceObjects.
-
-=cut
-
-our %ROLES = (
-    Requestor   => [qw(RT::Ticket RT::Queue)],
-    Cc          => [qw(RT::Ticket RT::Queue)],
-    Owner       => [qw(RT::Ticket RT::Queue)],
-    AdminCc     => [qw(RT::Ticket RT::Queue)],
-);
-
-
 # TODO: This should be refactored out into an RT::ACLedObject or something
 # stuff the rights into a hash of rights that can exist.
 
@@ -703,10 +673,8 @@ sub CreateRoleGroup {
 =head2 ValidateRoleGroup
 
 Takes a param hash containing Domain and Type which are expected to be values
-passed into L</CreateRoleGroup>.  Returns true if the specified Type is a valid
-role on the specified Domain.  Otherwise returns false.
-
-All roles are valid for the global Domain (C<RT::System-Role>).
+passed into L</CreateRoleGroup>.  Returns true if the specified Type is a
+registered role on the specified Domain.  Otherwise returns false.
 
 =cut
 
@@ -715,36 +683,13 @@ sub ValidateRoleGroup {
     my %args = (@_);
     return 0 unless $args{Domain} and $args{Type};
 
-    my $classes = $ROLES{ $args{Type} };
-    return 0 unless $classes and ref($classes) eq 'ARRAY';
-
-    my ($domain) = $args{Domain} =~ /^(.+)-Role$/;
+    my ($class) = $args{Domain} =~ /^(.+)-Role$/;
+    return 0 unless $class and $class->can('Roles');
 
-    # All roles are valid for the global domain (RT::System), and we've already
-    # determined this is a role defined in %ROLES.
-    return 1 if $domain eq "RT::System";
-    return 1 if grep { $_ eq $domain } @$classes;
+    return 1 if grep { $args{Type} eq $_ } $class->Roles;
     return 0;
 }
 
-=head2 RolesOf
-
-Takes a class name or object, and returns the names of the roles which apply to
-the class.
-
-=cut
-
-sub RolesOf {
-    my $self  = shift;
-    my $class = ref($_[0]) || $_[0];
-    my @roles;
-    for my $role (keys %ROLES) {
-        push @roles, $role
-            if grep { $_ eq $class } @{$ROLES{$role}};
-    }
-    return @roles;
-}
-
 =head2 Delete
 
 Delete this object
diff --git a/lib/RT/Queue.pm b/lib/RT/Queue.pm
index 8370185..e8beccb 100644
--- a/lib/RT/Queue.pm
+++ b/lib/RT/Queue.pm
@@ -703,7 +703,7 @@ sub TicketTransactionCustomFields {
 
 =head2 AllRoleGroupTypes
 
-B<DEPRECATED> and will be removed in a future release. Use L<RT::Group/RolesOf>
+B<DEPRECATED> and will be removed in a future release. Use L</Roles>
 instead.
 
 Returns a list of the names of the various role group types for Queues,
@@ -716,9 +716,9 @@ sub AllRoleGroupTypes {
     RT->Logger->warn(<<"    .");
 RT::Queue->AllRoleGroupTypes is DEPRECATED and will be removed in a future release.
 
-Please use RT::Group->RolesOf('RT::Queue') instead at @{[join '/', caller]}.
+Please use RT::Queue->Roles instead at @{[join '/', caller]}.
     .
-    RT::Group->RolesOf('RT::Queue')
+    shift->Roles;
 }
 
 =head2 IsRoleGroupType
@@ -741,14 +741,14 @@ sub IsRoleGroupType {
 
 Returns a list of the names of the various role group types for Queues,
 excluding ones used only for ACLs such as Requestor and Owner. If you want
-them, see L<RT::Group/RolesOf>.
+them, see L</Roles>.
 
 =cut
 
 sub ManageableRoleGroupTypes {
     # This grep is a little hacky, but I don't want to introduce the concept of
     # manageable vs. unmanageable roles globally (yet).
-    return grep { not /^(Requestor|Owner)$/ } RT::Group->RolesOf('RT::Queue');
+    return grep { not /^(Requestor|Owner)$/ } shift->Roles;
 }
 
 =head2 IsManageableRoleGroupType
@@ -784,7 +784,7 @@ It will return true on success and undef on failure.
 sub _CreateQueueGroups {
     my $self = shift;
 
-    foreach my $type (RT::Group->RolesOf($self)) {
+    foreach my $type ($self->Roles) {
         my $ok = $self->_CreateQueueRoleGroup($type);
         return undef if !$ok;
     }
diff --git a/lib/RT/Record.pm b/lib/RT/Record.pm
index e788e54..d3bcd86 100644
--- a/lib/RT/Record.pm
+++ b/lib/RT/Record.pm
@@ -1948,6 +1948,77 @@ sub WikiBase {
     return RT->Config->Get('WebPath'). "/index.html?q=";
 }
 
+=head2 RegisterRole
+
+Registers an RT role which applies to this class for role-based access control.
+Arguments:
+
+=over 4
+
+=item Name
+
+Required.  The role name (i.e. Requestor, Owner, AdminCc, etc).
+
+=item EquivClasses
+
+Optional.  Array ref of classes through which this role percolates up to
+L<RT::System>.  You can think of this list as:
+
+    map { ref } $record_object->ACLEquivalenceObjects;
+
+You should not include L<RT::System> itself in this list.
+
+Simply calls RegisterRole on each equivalent class.
+
+=back
+
+=cut
+
+sub RegisterRole {
+    my $self  = shift;
+    my $class = ref($self) || $self;
+    my %role  = (
+        Name            => undef,
+        EquivClasses    => [],
+        @_
+    );
+    return unless $role{Name};
+
+    # Stash the role on ourself
+    $class->_ROLES->{ $role{Name} } = \%role;
+
+    # Register it with any equivalent classes...
+    my $equiv = delete $role{EquivClasses} || [];
+
+    # ... and globally unless we ARE global
+    unless ($class eq "RT::System") {
+        require RT::System;
+        push @$equiv, "RT::System";
+    }
+
+    $_->RegisterRole(%role) for @$equiv;
+
+    # XXX TODO: Register which classes have roles on them somewhere?
+
+    return 1;
+}
+
+=head2 Roles
+
+Returns a list of role names registered for this class.
+
+=cut
+
+sub Roles { sort { $a cmp $b } keys %{ shift->_ROLES } }
+
+{
+    my %ROLES;
+    sub _ROLES {
+        my $class = ref($_[0]) || $_[0];
+        return $ROLES{$class} ||= {};
+    }
+}
+
 RT::Base->_ImportOverlays();
 
 1;
diff --git a/lib/RT/Ticket.pm b/lib/RT/Ticket.pm
index 5b6a061..9467a0c 100644
--- a/lib/RT/Ticket.pm
+++ b/lib/RT/Ticket.pm
@@ -83,6 +83,12 @@ use RT::URI;
 use MIME::Entity;
 use Devel::GlobalDestruction;
 
+for my $role (qw(Requestor Cc AdminCc Owner)) {
+    RT::Ticket->RegisterRole(
+        Name            => $role,
+        EquivClasses    => ['RT::Queue'],
+    );
+}
 
 # A helper table for links mapping to make it easier
 # to build and parse links between tickets
@@ -991,7 +997,7 @@ It will return true on success and undef on failure.
 sub _CreateTicketGroups {
     my $self = shift;
     
-    foreach my $type (RT::Group->RolesOf($self)) {
+    foreach my $type ($self->Roles) {
         my $type_obj = RT::Group->new($self->CurrentUser);
         my ($id, $msg) = $type_obj->CreateRoleGroup(
             Type    => $type,

commit 189da39ba59892180aad7670be49633d369c7270
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 13:14:40 2012 -0700

    HasRole method to check role existence on a class

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index 1f48df1..f8414b7 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -657,9 +657,6 @@ sub CreateRoleGroup {
         $args{Instance} = ref($object) eq "RT::System" ? 0 : $object->id;
     }
 
-    # XXX I WISH: If this was Moose and we had Roles to implement roles, we'd
-    # take a class or object, check $class->DOES('ACLRole'), and then call
-    # $class->IsValidRole($Type) or similar if DOES was true.
     unless ($self->ValidateRoleGroup(%args)) {
         return ( 0, $self->loc("Invalid Group Type and Domain") );
     }
@@ -684,10 +681,9 @@ sub ValidateRoleGroup {
     return 0 unless $args{Domain} and $args{Type};
 
     my ($class) = $args{Domain} =~ /^(.+)-Role$/;
-    return 0 unless $class and $class->can('Roles');
+    return 0 unless $class and $class->can('HasRole');
 
-    return 1 if grep { $args{Type} eq $_ } $class->Roles;
-    return 0;
+    return $class->HasRole($args{Type});
 }
 
 =head2 Delete
diff --git a/lib/RT/Queue.pm b/lib/RT/Queue.pm
index e8beccb..62d0656 100644
--- a/lib/RT/Queue.pm
+++ b/lib/RT/Queue.pm
@@ -723,18 +723,19 @@ Please use RT::Queue->Roles instead at @{[join '/', caller]}.
 
 =head2 IsRoleGroupType
 
+B<DEPRECATED> and will be removed in a future release. Use L</HasRole> instead.
+
 Returns whether the passed-in type is a role group type.
 
 =cut
 
 sub IsRoleGroupType {
-    my $self = shift;
-    my $type = shift;
+    RT->Logger->warn(<<"    .");
+RT::Queue->IsRoleGroupType is DEPRECATED and will be removed in a future release.
 
-    return RT::Group->ValidateRoleGroup(
-        Domain  => 'RT::Queue-Role',
-        Type    => $type,
-    );
+Please use RT::Queue->HasRole instead at @{[join '/', caller]}.
+    .
+    shift->HasRole(@_);
 }
 
 =head2 ManageableRoleGroupTypes
@@ -877,7 +878,7 @@ sub AddWatcher {
     }
 
     return ( 0, "Unknown watcher type [_1]", $args{Type} )
-        unless $self->IsRoleGroupType($args{Type});
+        unless $self->HasRole($args{Type});
 
     my ($ok, $msg) = $self->_HasModifyWatcherRight(%args);
     return ($ok, $msg) if !$ok;
@@ -1024,7 +1025,7 @@ sub DeleteWatcher {
     }
 
     return ( 0, $self->loc('Unknown watcher type [_1]', $args{Type}) )
-        unless $self->IsRoleGroupType($args{Type});
+        unless $self->HasRole($args{Type});
 
     my ($ok, $msg) = $self->_HasModifyWatcherRight(%args);
     return ($ok, $msg) if !$ok;
diff --git a/lib/RT/Record.pm b/lib/RT/Record.pm
index d3bcd86..281d096 100644
--- a/lib/RT/Record.pm
+++ b/lib/RT/Record.pm
@@ -2019,6 +2019,19 @@ sub Roles { sort { $a cmp $b } keys %{ shift->_ROLES } }
     }
 }
 
+=head2 HasRole
+
+Returns true if the name provided is a registered role for this class.
+Otherwise returns false.
+
+=cut
+
+sub HasRole {
+    my $self = shift;
+    my $type = shift;
+    return scalar grep { $type eq $_ } $self->Roles;
+}
+
 RT::Base->_ImportOverlays();
 
 1;

commit a1035b59b95c305e04d6c6192b12f35f61a0709b
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 14:24:28 2012 -0700

    Bail out of LoadRoleGroup if the object passed is unloaded
    
    Avoids loading up a random role instance.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index f8414b7..563a84e 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -324,11 +324,16 @@ sub LoadRoleGroup {
         @_
     );
 
+    my $object = delete $args{Object};
+
+    return (0, $self->loc("Object passed is not loaded"))
+        if ref($object) ne "RT::System"
+       and not $object->id;
+
     # Translate Object to Domain + Instance
-    my $object      = delete $args{Object};
     $args{Domain}   = ref($object) . "-Role";
     $args{Instance} = $object->id
-        if $object->id and not ref($object) eq 'RT::System';
+        unless ref($object) eq 'RT::System';
 
     return $self->LoadByCols(%args);
 }

commit 717974d1c678e11bd8bcbf00d347afcc123e0ea0
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 14:28:51 2012 -0700

    Require Instance (even if it's 0) when creating a new role group

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index 563a84e..3260e34 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -662,6 +662,10 @@ sub CreateRoleGroup {
         $args{Instance} = ref($object) eq "RT::System" ? 0 : $object->id;
     }
 
+    unless (defined $args{Instance}) {
+        return ( 0, $self->loc("An Instance must be provided") );
+    }
+
     unless ($self->ValidateRoleGroup(%args)) {
         return ( 0, $self->loc("Invalid Group Type and Domain") );
     }

commit 3185d7029ef5a89c7377964ea0fadb6204e2d918
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 14:37:50 2012 -0700

    Block duplicate role group creation

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index 3260e34..df25d68 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -670,9 +670,17 @@ sub CreateRoleGroup {
         return ( 0, $self->loc("Invalid Group Type and Domain") );
     }
 
+    my %create = map { $_ => $args{$_} } qw(Domain Instance Type);
+
+    my $duplicate = RT::Group->new( RT->SystemUser );
+    $duplicate->LoadByCols( %create );
+    if ($duplicate->id) {
+        return ( 0, $self->loc("Role group exists already") );
+    }
+
     return $self->_Create(
         InsideTransaction => 1,
-        map { $_ => $args{$_} } qw(Domain Instance Type),
+        %create,
     );
 }
 

commit a4e42233adb630fbe4657468f9a1c66044a521f0
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Tue Sep 18 15:49:45 2012 -0700

    Set system role groups' Instance to RT->System->id
    
    These role groups are now consistent with other role groups instead of
    using the legacy Instance value of 0 (which doesn't match
    RT->System->id).

diff --git a/etc/upgrade/4.1.4/schema.Oracle b/etc/upgrade/4.1.4/schema.Oracle
new file mode 100644
index 0000000..e530ede
--- /dev/null
+++ b/etc/upgrade/4.1.4/schema.Oracle
@@ -0,0 +1 @@
+UPDATE Groups SET Instance = 1 WHERE Domain = 'RT::System-Role' AND Instance = 0;
diff --git a/etc/upgrade/4.1.4/schema.Pg b/etc/upgrade/4.1.4/schema.Pg
new file mode 100644
index 0000000..e530ede
--- /dev/null
+++ b/etc/upgrade/4.1.4/schema.Pg
@@ -0,0 +1 @@
+UPDATE Groups SET Instance = 1 WHERE Domain = 'RT::System-Role' AND Instance = 0;
diff --git a/etc/upgrade/4.1.4/schema.SQLite b/etc/upgrade/4.1.4/schema.SQLite
new file mode 100644
index 0000000..e530ede
--- /dev/null
+++ b/etc/upgrade/4.1.4/schema.SQLite
@@ -0,0 +1 @@
+UPDATE Groups SET Instance = 1 WHERE Domain = 'RT::System-Role' AND Instance = 0;
diff --git a/etc/upgrade/4.1.4/schema.mysql b/etc/upgrade/4.1.4/schema.mysql
new file mode 100644
index 0000000..e530ede
--- /dev/null
+++ b/etc/upgrade/4.1.4/schema.mysql
@@ -0,0 +1 @@
+UPDATE Groups SET Instance = 1 WHERE Domain = 'RT::System-Role' AND Instance = 0;
diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index df25d68..7700a95 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -327,13 +327,11 @@ sub LoadRoleGroup {
     my $object = delete $args{Object};
 
     return (0, $self->loc("Object passed is not loaded"))
-        if ref($object) ne "RT::System"
-       and not $object->id;
+       unless $object->id;
 
     # Translate Object to Domain + Instance
     $args{Domain}   = ref($object) . "-Role";
-    $args{Instance} = $object->id
-        unless ref($object) eq 'RT::System';
+    $args{Instance} = $object->id;
 
     return $self->LoadByCols(%args);
 }
@@ -633,7 +631,7 @@ Not required if you pass an Object.
 =item Instance
 
 Optional.  The numeric ID of the object (of the class encoded in Domain) on
-which this role applies.  If Domain is C<RT::System-Role>, Instance should be C<0>.
+which this role applies.  If Domain is C<RT::System-Role>, Instance should be C<1>.
 
 Not required if you pass an Object.
 
@@ -659,10 +657,10 @@ sub CreateRoleGroup {
     # Translate Object to Domain + Instance
     if ( my $object = delete $args{Object} ) {
         $args{Domain}   = ref($object) . "-Role";
-        $args{Instance} = ref($object) eq "RT::System" ? 0 : $object->id;
+        $args{Instance} = $object->id;
     }
 
-    unless (defined $args{Instance}) {
+    unless ($args{Instance}) {
         return ( 0, $self->loc("An Instance must be provided") );
     }
 
diff --git a/lib/RT/Handle.pm b/lib/RT/Handle.pm
index c77ad57..20a9c4d 100644
--- a/lib/RT/Handle.pm
+++ b/lib/RT/Handle.pm
@@ -715,12 +715,10 @@ sub InsertInitialData {
         }
 
         $group = RT::Group->new( RT->SystemUser );
-        my ( $val, $msg ) = $group->_Create(
+        my ( $val, $msg ) = $group->CreateRoleGroup(
             Type        => $name,
-            Domain      => 'RT::System-Role',
+            Object      => RT->System,
             Description => 'SystemRolegroup for internal use',  # loc
-            Name        => '',
-            Instance    => '',
         );
         return ($val, $msg) unless $val;
     }

commit 2240273fc73c8d1bb6f325926356d6bed2d6f17f
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 19 14:08:55 2012 -0700

    Group.Instance is numeric, drop quoting and incorrect comment
    
    This comment used to be true but became false many moons ago.

diff --git a/lib/RT/Principal.pm b/lib/RT/Principal.pm
index 4c225c4..9520ef0 100644
--- a/lib/RT/Principal.pm
+++ b/lib/RT/Principal.pm
@@ -577,11 +577,8 @@ sub _HasRoleRightQuery {
 
         my $clause = "Groups.Domain = '$type-Role'";
 
-        # XXX: Groups.Instance is VARCHAR in DB, we should quote value
-        # if we want mysql 4.0 use indexes here. we MUST convert that
-        # field to integer and drop this quotes.
         if ( my $id = eval { $obj->id } ) {
-            $clause .= " AND Groups.Instance = '$id'";
+            $clause .= " AND Groups.Instance = $id";
         }
         push @object_clauses, "($clause)";
     }
diff --git a/lib/RT/Users.pm b/lib/RT/Users.pm
index 787ac10..d56f4ec 100644
--- a/lib/RT/Users.pm
+++ b/lib/RT/Users.pm
@@ -461,10 +461,7 @@ sub _RoleClauses {
         $id = $obj->id if ref($obj) && UNIVERSAL::can($obj, 'id') && $obj->id;
 
         my $role_clause = "$groups.Domain = '$type-Role'";
-        # XXX: Groups.Instance is VARCHAR in DB, we should quote value
-        # if we want mysql 4.0 use indexes here. we MUST convert that
-        # field to integer and drop this quotes.
-        $role_clause   .= " AND $groups.Instance = '$id'" if $id;
+        $role_clause   .= " AND $groups.Instance = $id" if $id;
         push @groups_clauses, "($role_clause)";
     }
     return @groups_clauses;

commit fc27179066a15829b9e3dc9cf31260441712ade1
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 19 16:09:26 2012 -0700

    Document transaction requirement of CreateRoleGroup and follow our own advice
    
    System role groups weren't created inside a transaction despite role
    group creation expecting to be able to Rollback.  Document how to toggle
    the expected transaction state and then use it in
    RT::Handle->InsertInitialData.

diff --git a/lib/RT/Group.pm b/lib/RT/Group.pm
index 7700a95..f5548ed 100644
--- a/lib/RT/Group.pm
+++ b/lib/RT/Group.pm
@@ -606,6 +606,10 @@ sub _CreateACLEquivalenceGroup {
 
 A convenience method for creating a role group on an object.
 
+This method expects to be called from B<inside of a database transaction>!  If
+you're calling it outside of one, you B<MUST> pass a false value for
+InsideTransaction.
+
 Takes a paramhash of:
 
 =over 4
@@ -635,12 +639,16 @@ which this role applies.  If Domain is C<RT::System-Role>, Instance should be C<
 
 Not required if you pass an Object.
 
+=item InsideTransaction
+
+Optional.  Defaults to true in expectation of usual call sites.  If you call
+this method while not inside a transaction, you C<MUST> pass a false value for
+this parameter.
+
 =back
 
 You must pass either an Object or both Domain and Instance.
 
-This method must be called from B<inside of a database transaction>!
-
 Returns a tuple of (id, Message).  If id is false, the create failed and
 Message should contain an error string.
 
diff --git a/lib/RT/Handle.pm b/lib/RT/Handle.pm
index 20a9c4d..79c23a0 100644
--- a/lib/RT/Handle.pm
+++ b/lib/RT/Handle.pm
@@ -716,9 +716,10 @@ sub InsertInitialData {
 
         $group = RT::Group->new( RT->SystemUser );
         my ( $val, $msg ) = $group->CreateRoleGroup(
-            Type        => $name,
-            Object      => RT->System,
-            Description => 'SystemRolegroup for internal use',  # loc
+            Type                => $name,
+            Object              => RT->System,
+            Description         => 'SystemRolegroup for internal use',  # loc
+            InsideTransaction   => 0,
         );
         return ($val, $msg) unless $val;
     }

commit 98c752ddd9bd9b75910b463232513a4725017f47
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 19 20:07:07 2012 -0700

    Refactor role group check on Principal into a public method
    
    Greater abstraction of the /-Role$/ check means easier changes down the
    road as necessary.

diff --git a/lib/RT/Principal.pm b/lib/RT/Principal.pm
index 9520ef0..4c5a4c4 100644
--- a/lib/RT/Principal.pm
+++ b/lib/RT/Principal.pm
@@ -88,7 +88,18 @@ sub IsGroup {
     return undef;
 }
 
+=head2 IsRoleGroup
 
+Returns true if this principal is a role group.
+Returns undef, otherwise.
+
+=cut
+
+sub IsRoleGroup {
+    my $self = shift;
+    return ($self->IsGroup and $self->Object->Domain =~ /-Role$/)
+        ? 1 : undef;
+}
 
 =head2 IsUser 
 
@@ -698,7 +709,7 @@ return that. if it has no type, return group.
 
 sub _GetPrincipalTypeForACL {
     my $self = shift;
-    if ($self->PrincipalType eq 'Group' && $self->Object->Domain =~ /Role$/) {
+    if ($self->IsRoleGroup) {
         return $self->Object->Type;
     } else {
         return $self->PrincipalType;

commit 728d9eb16e18a08edf6211f00de3667484517126
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 19 20:14:25 2012 -0700

    Sort object types for stability when combining ACE hashes
    
    Some rights are announced by multiple classes but currently have
    different descriptions.  Sorting at least makes the descriptions stable
    in the global rights list.

diff --git a/lib/RT/System.pm b/lib/RT/System.pm
index 68f1564..558e98e 100644
--- a/lib/RT/System.pm
+++ b/lib/RT/System.pm
@@ -138,7 +138,7 @@ sub _ForAllACEObjectTypes {
     return {} unless $method;
 
     my %data;
-    for my $class (keys %RT::ACE::OBJECT_TYPES) {
+    for my $class (sort keys %RT::ACE::OBJECT_TYPES) {
         next unless $RT::ACE::OBJECT_TYPES{$class};
 
         # Skip ourselves otherwise we'd loop infinitely

commit 2c2b408d5d06f3bf40c123d376ad6e348e8ba77d
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 19 20:31:54 2012 -0700

    Restrict rights granted to system role groups
    
    All roles include a system-level group which is used for global role
    rights.  System level rights are a combination of global-only rights
    (those announced in RT::System itself) and rights announced by other
    ACL-able classes (%RT::ACE::OBJECT_TYPES).  System role groups, however,
    are only registered to certain classes, and displaying or allowing
    granting of rights announced by classes other than those to which the
    role is registered makes no sense as those rights will never be checked.
    
    This only matters for system role groups because AvailableRights in
    other classes is restricted to the correct class by virtue of being in
    the correct class itself.

diff --git a/lib/RT/ACE.pm b/lib/RT/ACE.pm
index ae3eda4..461801d 100644
--- a/lib/RT/ACE.pm
+++ b/lib/RT/ACE.pm
@@ -266,7 +266,7 @@ sub Create {
 
     #check if it's a valid RightName
     if ( $args{'Object'}->can('AvailableRights') ) {
-        my $available = $args{'Object'}->AvailableRights;
+        my $available = $args{'Object'}->AvailableRights($princ_obj);
         unless ( grep $_ eq $args{'RightName'}, map $self->CanonicalizeRightName( $_ ), keys %$available ) {
             $RT::Logger->warning(
                 "Couldn't validate right name '$args{'RightName'}'"
diff --git a/lib/RT/System.pm b/lib/RT/System.pm
index 558e98e..28fea07 100644
--- a/lib/RT/System.pm
+++ b/lib/RT/System.pm
@@ -117,28 +117,46 @@ This method as well returns rights of other RT objects,
 like L<RT::Queue> or L<RT::Group>. To allow users to apply
 those rights globally.
 
+If an L<RT::Principal> is passed as the first argument, the available rights
+will be limited to ones which make sense for the principal.  Currently only
+role groups are supported and rights announced by object types to which the
+role group doesn't apply are not returned.
+
 =cut
 
 sub AvailableRights {
-    my $self = shift;
+    my $self        = shift;
+    my $principal   = shift;
+    my @types       = keys %RT::ACE::OBJECT_TYPES;
+
+    # Include global system rights by default
+    my %rights = %{ $RIGHTS };
+
+    # Only return rights on classes which support the role asked for
+    if ($principal and $principal->IsRoleGroup) {
+        my $role = $principal->Object->Type;
+        @types   = grep { $_->HasRole($role) } @types;
+        %rights  = ();
+    }
 
-    # Build a merged list of all system wide rights, queue rights, group rights, etc.
-    my %rights = (
-        %{ $RIGHTS },
-        %{ $self->_ForAllACEObjectTypes('AvailableRights') },
+    # Build a merged list of system wide rights, queue rights, group rights, etc.
+    %rights = (
+        %rights,
+        %{ $self->_ForACEObjectTypes(\@types => 'AvailableRights', @_) },
     );
     delete $rights{ExecuteCode} if RT->Config->Get('DisallowExecuteCode');
 
     return(\%rights);
 }
 
-sub _ForAllACEObjectTypes {
-    my $self = shift;
+sub _ForACEObjectTypes {
+    my $self   = shift;
+    my $types  = shift || [];
     my $method = shift;
-    return {} unless $method;
+    return {} unless @$types and $method;
 
     my %data;
-    for my $class (sort keys %RT::ACE::OBJECT_TYPES) {
+    for my $class (sort @$types) {
         next unless $RT::ACE::OBJECT_TYPES{$class};
 
         # Skip ourselves otherwise we'd loop infinitely
@@ -154,7 +172,7 @@ sub _ForAllACEObjectTypes {
         # embrace and extend
         %data = (
             %data,
-            %{ $object->$method || {} },
+            %{ $object->$method(@_) || {} },
         );
     }
 
@@ -174,7 +192,7 @@ sub RightCategories {
     # Build a merged list of all right categories system wide, per-queue, per-group, etc.
     my %categories = (
         %{ $RIGHT_CATEGORIES },
-        %{ $self->_ForAllACEObjectTypes('RightCategories') },
+        %{ $self->_ForACEObjectTypes([keys %RT::ACE::OBJECT_TYPES] => 'RightCategories') },
     );
 
     return \%categories;
diff --git a/share/html/Admin/Elements/EditRightsCategoryTabs b/share/html/Admin/Elements/EditRightsCategoryTabs
index 786cafd..ae10d90 100644
--- a/share/html/Admin/Elements/EditRightsCategoryTabs
+++ b/share/html/Admin/Elements/EditRightsCategoryTabs
@@ -52,15 +52,10 @@ $id
 $acldesc => ''
 </%args>
 <%init>
-# XXX OPTIMIZATION: Moving the calls to AvailableRights and RightCategories up
-# one component to avoid calling them for every principal would be a win, but
-# it's cleaner to do it here.  The values can really be computed once per
-# $Context.
-
 # Find all our available rights...
 my (%available_rights, %categories);
 if ( blessed($Context) and $Context->can('AvailableRights') ) {
-    %available_rights = %{$Context->AvailableRights};
+    %available_rights = %{$Context->AvailableRights( $Principal ? $Principal->PrincipalObj : undef )};
 } else {
     %available_rights = ( loc('System Error') => loc("No rights found") );
 }

commit c015cd8f87c894f9922bd66042457e3840e8d846
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Thu Sep 20 12:37:04 2012 -0700

    Basic tests for variable AvailableRights
    
    Adds a new dep for testing, Set::Tiny, which is currently used for a
    single test.  The expectation is it will be used more in the future,
    hence the inclusion as a dep.

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 2376da1..7ed3d4a 100755
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -296,6 +296,7 @@ Log::Dispatch::Perl
 Test::WWW::Mechanize::PSGI
 Plack::Middleware::Test::StashWarnings 0.06
 Test::LongString
+Set::Tiny
 .
 
 $deps{'FASTCGI'} = [ text_to_hash( << '.') ];
diff --git a/t/api/system-available-rights.t b/t/api/system-available-rights.t
new file mode 100644
index 0000000..9c374d6
--- /dev/null
+++ b/t/api/system-available-rights.t
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+
+use RT::Test tests => undef;
+use Set::Tiny;
+
+my @warnings;
+local $SIG{__WARN__} = sub {
+    push @warnings, "@_";
+};
+
+my $requestor = RT::Group->new( RT->SystemUser );
+$requestor->LoadRoleGroup(
+    Object  => RT->System,
+    Type    => "Requestor",
+);
+ok $requestor->id, "Loaded global requestor role group";
+
+$requestor = $requestor->PrincipalObj;
+ok $requestor->id, "Loaded global requestor role group principal";
+
+note "Try granting an article right to a system role group";
+{
+    my ($ok, $msg) = $requestor->GrantRight(
+        Right   => "ShowArticle",
+        Object  => RT->System,
+    );
+    ok !$ok, "Couldn't grant nonsensical right to global Requestor role: $msg";
+    like shift @warnings, qr/Couldn't validate right name.*?ShowArticle/;
+
+    ($ok, $msg) = $requestor->GrantRight(
+        Right   => "ShowTicket",
+        Object  => RT->System,
+    );
+    ok $ok, "Granted queue right to global queue role: $msg";
+
+    ($ok, $msg) = RT->PrivilegedUsers->PrincipalObj->GrantRight(
+        Right   => "ShowArticle",
+        Object  => RT->System,
+    );
+    ok $ok, "Granted article right to non-role global group: $msg";
+
+    reset_rights();
+}
+
+note "AvailableRights";
+{
+    my @available = (
+        [ keys %{RT->System->AvailableRights} ],
+        [ keys %{RT->System->AvailableRights( $requestor )} ],
+    );
+
+    my $all  = Set::Tiny->new( @{$available[0]} );
+    my $role = Set::Tiny->new( @{$available[1]} );
+
+    ok $role->is_proper_subset($all), "role rights are a proper subset of all";
+}
+
+ok !@warnings, "No uncaught warnings"
+    or diag explain \@warnings;
+
+# for clarity
+sub reset_rights { RT::Test->set_rights() }
+
+done_testing;

commit e83d0e0e8422be2083686f17a8b210678c9886d0
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Thu Sep 20 13:01:58 2012 -0700

    Move unused role data structure used for l10n closer to role registration
    
    The variable is no longer a package variable since we have an API.

diff --git a/lib/RT/ACE.pm b/lib/RT/ACE.pm
index 461801d..ad8e44d 100644
--- a/lib/RT/ACE.pm
+++ b/lib/RT/ACE.pm
@@ -78,7 +78,6 @@ use RT::Groups;
 use vars qw (
   %LOWERCASERIGHTNAMES
   %OBJECT_TYPES
-  %TICKET_METAPRINCIPALS
 );
 
 
@@ -90,21 +89,6 @@ use vars qw (
 
 =cut
 
-
-
-
-
-
-%TICKET_METAPRINCIPALS = (
-    Owner     => 'The owner of a ticket',                             # loc_pair
-    Requestor => 'The requestor of a ticket',                         # loc_pair
-    Cc        => 'The CC of a ticket',                                # loc_pair
-    AdminCc   => 'The administrative CC of a ticket',                 # loc_pair
-);
-
-
-
-
 =head2 LoadByValues PARAMHASH
 
 Load an ACE by specifying a paramhash with the following fields:
diff --git a/lib/RT/Ticket.pm b/lib/RT/Ticket.pm
index 9467a0c..1071edb 100644
--- a/lib/RT/Ticket.pm
+++ b/lib/RT/Ticket.pm
@@ -83,7 +83,15 @@ use RT::URI;
 use MIME::Entity;
 use Devel::GlobalDestruction;
 
-for my $role (qw(Requestor Cc AdminCc Owner)) {
+my %ROLES = (
+    # name    =>  description
+    Owner     => 'The owner of a ticket',                             # loc_pair
+    Requestor => 'The requestor of a ticket',                         # loc_pair
+    Cc        => 'The CC of a ticket',                                # loc_pair
+    AdminCc   => 'The administrative CC of a ticket',                 # loc_pair
+);
+
+for my $role (sort keys %ROLES) {
     RT::Ticket->RegisterRole(
         Name            => $role,
         EquivClasses    => ['RT::Queue'],

commit 165905ef49cc67298f6e50de4c8c16982abed21b
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Fri Sep 21 12:59:12 2012 -0700

    Remove nonsensical rights granted to system role groups
    
    These rights are invalidated by ed7a3304 and no longer displayed in the
    rights editor.  Existing installations which previously granted the
    invalid rights would see a slew of "Right removed" messages when the
    rights editor pages were submited, even though the user hadn't actively
    removed any rights.  To avoid confusion, and clean up the database,
    preemptively remove the useless rights during upgrade.
    
    The set of removed rights for each role is the difference between the set of
    global rights (RT->System->AvailableRights) and the set of role rights
    (RT->System->AvailableRights($PrincipalObjectForSystemRoleGroup)).

diff --git a/etc/upgrade/4.1.4/content b/etc/upgrade/4.1.4/content
new file mode 100644
index 0000000..b3f59f6
--- /dev/null
+++ b/etc/upgrade/4.1.4/content
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+
+our (@Final);
+
+push @Final, sub {
+    my %global = %{ RT->System->AvailableRights };
+    my $handle = RT->DatabaseHandle;
+
+    for my $role (RT::System->Roles) {
+        my $group       = RT::Group->new( RT->SystemUser );
+        my ($ok, $msg)  = $group->LoadRoleGroup(
+            Object  => RT->System,
+            Type    => $role,
+        );
+
+        unless ($group->id) {
+            RT->Logger->error("Can't load role group $role: $msg");
+            next;
+        }
+
+        my %rights = %{ RT->System->AvailableRights( $group->PrincipalObj ) };
+
+        # Global rights which aren't available on the role anymore
+        my @remove = grep { not $rights{$_} }
+                     keys %global;
+        my $placeholders = join ",", map { "?" } 1 .. scalar @remove;
+
+        my $query = <<"        SQL";
+            DELETE FROM ACL
+                  WHERE PrincipalType = ?
+                    AND PrincipalId   = ?
+                    AND ObjectType    = 'RT::System'
+                    AND RightName    IN ($placeholders)
+        SQL
+
+        my $res = $handle->SimpleQuery(
+            $query,
+            $role,                  # Type
+            $group->PrincipalId,    # Id
+            @remove,                # Right names
+        );
+
+        unless ($res) {
+            RT->Logger->error("Failed to delete invalid rights on system role $role!");
+            next;
+        }
+    }
+};

commit 37e2aea3dbd2e1ebb5446bd185a5331a4ec23007
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Fri Sep 21 16:51:42 2012 -0700

    Convenience method for loading role groups on records

diff --git a/lib/RT/Record.pm b/lib/RT/Record.pm
index 281d096..fec8eac 100644
--- a/lib/RT/Record.pm
+++ b/lib/RT/Record.pm
@@ -2032,6 +2032,28 @@ sub HasRole {
     return scalar grep { $type eq $_ } $self->Roles;
 }
 
+=head2 RoleGroup
+
+Expects a role name as the first parameter which is used to load the
+L<RT::Group> for the specified role on this record.  Returns an unloaded
+L<RT::Group> object on failure.
+
+=cut
+
+sub RoleGroup {
+    my $self  = shift;
+    my $type  = shift;
+    my $group = RT::Group->new( $self->CurrentUser );
+
+    if ($self->HasRole($type)) {
+        $group->LoadRoleGroup(
+            Object  => $self,
+            Type    => $type,
+        );
+    }
+    return $group;
+}
+
 RT::Base->_ImportOverlays();
 
 1;

commit ad7235c12da6c1d1e774dd9eda45c95fe6ea7727
Author: Thomas Sibley <trs at bestpractical.com>
Date:   Wed Sep 26 15:40:38 2012 -0700

    Convenience methods to add/delete members from record role groups

diff --git a/lib/RT/Record.pm b/lib/RT/Record.pm
index fec8eac..3dded63 100644
--- a/lib/RT/Record.pm
+++ b/lib/RT/Record.pm
@@ -2054,6 +2054,99 @@ sub RoleGroup {
     return $group;
 }
 
+=head2 AddRoleMember
+
+Adds the described L<RT::Principal> to the specified role group for this record.
+
+Takes a set of key-value pairs:
+
+=over 4
+
+=item PrincipalId
+
+Optional.  The ID of the L<RT::Principal> object to add.
+
+=item User
+
+=item Group
+
+Optional.  The Name of an L<RT::User> or L<RT::Group>, respectively, to use as
+the principal.
+
+=item Type
+
+Required.  One of the valid roles for this record, as returned by L</Roles>.
+
+=back
+
+One, and only one, of I<PrincipalId>, I<User>, or I<Group> is required.
+
+Returns a tuple of (status, message).
+
+=cut
+
+sub AddRoleMember {
+    my $self = shift;
+    my %args = (@_);
+
+    return (0, $self->loc("One, and only one, of PrincipalId/User/Group is required"))
+        if 1 != grep { $_ } @args{qw/PrincipalId User Group/};
+
+    return (0, $self->loc("No valid Type specified"))
+        unless $args{Type} and $self->HasRole($args{Type});
+
+    unless ($args{PrincipalId}) {
+        my $object;
+        if ($args{User}) {
+            $object = RT::User->new( $self->CurrentUser );
+            $object->Load(delete $args{User});
+        }
+        elsif ($args{Group}) {
+            $object = RT::Group->new( $self->CurrentUser );
+            $object->LoadUserDefinedGroup(delete $args{Group});
+        }
+        $args{PrincipalId} = $object->PrincipalObj->id;
+    }
+
+    return (0, $self->loc("No valid PrincipalId"))
+        unless $args{PrincipalId};
+
+    return $self->RoleGroup(delete $args{Type})->_AddMember(%args);
+}
+
+=head2 DeleteRoleMember
+
+Removes the specified L<RT::Principal> from the specified role group for this
+record.
+
+Takes a set of key-value pairs:
+
+=over 4
+
+=item PrincipalId
+
+Required.  The ID of the L<RT::Principal> object to remove.
+
+=item Type
+
+Required.  One of the valid roles for this record, as returned by L</Roles>.
+
+=back
+
+Returns a tuple of (status, message).
+
+=cut
+
+sub DeleteRoleMember {
+    my $self = shift;
+    my %args = (@_);
+
+    return (0, $self->loc("No valid Type specified"))
+        unless $args{Type} and $self->HasRole($args{Type});
+
+    return $self->RoleGroup($args{Type})->_DeleteMember(delete $args{PrincipalId});
+}
+
 RT::Base->_ImportOverlays();
 
 1;

-----------------------------------------------------------------------


More information about the Rt-commit mailing list