[Jifty-commit] r3223 - in apps/CASPlus/trunk: lib lib/CASPlus
lib/CASPlus/Model t
jifty-commit at lists.jifty.org
jifty-commit at lists.jifty.org
Fri May 11 08:31:23 EDT 2007
Author: sterling
Date: Fri May 11 08:31:20 2007
New Revision: 3223
Added:
apps/CASPlus/trunk/Makefile.PL
- copied, changed from r3216, /apps/CASPlus/trunk/Makefile.PL
apps/CASPlus/trunk/lib/
- copied from r3216, /apps/CASPlus/trunk/lib/
apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermission.pm
apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionLimit.pm
apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionProperty.pm
apps/CASPlus/trunk/t/
- copied from r3216, /apps/CASPlus/trunk/t/
apps/CASPlus/trunk/t/10-model-ProfilePermission.t
apps/CASPlus/trunk/t/10-model-ProfilePermissionLimit.t
apps/CASPlus/trunk/t/10-model-ProfilePermissionProperty.t
Modified:
apps/CASPlus/trunk/ (props changed)
apps/CASPlus/trunk/lib/CASPlus/CurrentUser.pm
apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm
apps/CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm
apps/CASPlus/trunk/lib/CASPlus/Model/Role.pm
apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
apps/CASPlus/trunk/lib/CASPlus/Model/User.pm
apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm
apps/CASPlus/trunk/t/00-dependencies.t
apps/CASPlus/trunk/t/50-me.t
Log:
r4972 at dynpc145: andrew | 2007-05-11 07:30:23 -0500
Added the initial ACL system for CAS+ profile access.
Copied: apps/CASPlus/trunk/Makefile.PL (from r3216, /apps/CASPlus/trunk/Makefile.PL)
==============================================================================
--- /apps/CASPlus/trunk/Makefile.PL (original)
+++ apps/CASPlus/trunk/Makefile.PL Fri May 11 08:31:20 2007
@@ -8,6 +8,7 @@
requires 'Jifty' => '0.70129';
requires 'Jifty::DBI';
requires 'IO::String';
+requires 'List::MoreUtils';
requires 'List::Util';
requires 'LWP::UserAgent';
requires 'Readonly';
Modified: apps/CASPlus/trunk/lib/CASPlus/CurrentUser.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/CurrentUser.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/CurrentUser.pm Fri May 11 08:31:20 2007
@@ -37,6 +37,71 @@
$self->SUPER::_init(%args);
}
+=head2 roles
+
+ my @roles = $current_user->roles;
+
+Returns a list of all the L<CASPlus::Model::Role> objects associated with the current user or an empty list if the user has none or is anonymous.
+
+=cut
+
+sub roles {
+ my $self = shift;
+ my $as_superuser = shift;
+
+ if ($self->id) {
+ my $user = $as_superuser ? $self->user_object->as_superuser
+ : $self->user_object;
+
+ my $member_roles = $user->member_roles;
+ return map { $_->the_role } @{ $member_roles->items_array_ref };
+ }
+
+ else {
+ return ();
+ }
+}
+
+=head2 profile_permissions
+
+ my @permissions = $current_user->profile_ermissions;
+
+Returns a list of all the L<CASPlus::Model::ProfilePermission> objects associated with the current user.
+
+=cut
+
+sub profile_permissions {
+ my $self = shift;
+ my $as_superuser = shift;
+
+ my @permissions;
+ for my $role ($self->roles($as_superuser)) {
+ push @permissions, @{ $role->profile_permissions->items_array_ref };
+ }
+
+ return @permissions;
+}
+
+=head2 can_access_profile
+
+ my $access = $current_user->can_access_profile($obj, $right, %attrs)
+
+This method returns true if the profile permissions associated with the current user object permit the access requested.
+
+=cut
+
+sub can_access_profile {
+ my ($self, $obj, $right, %attrs) = @_;
+
+ for my $permission ($self->profile_permissions) {
+ if ($permission->matches($obj, $right, %attrs)) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
=head1 AUTHOR
Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
Modified: apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/Profile.pm Fri May 11 08:31:20 2007
@@ -187,7 +187,7 @@
);
}
- return $ret;
+ return ($ret->return_value);
}
=head2 load_profile_instance
@@ -224,9 +224,7 @@
=head2 current_user_can
-This allows anyone to read, but only superuser to write.
-
-In the future, this should be more sophisticated and based upon the roles and permissions granted to the current user.
+This allows anyone to read. Users with a role granting the permission to manage profiles and superuser may perform any other operation.
=cut
@@ -238,6 +236,12 @@
return 1;
}
+ else {
+ for my $role ($self->current_user->roles) {
+ return 1 if $role->may_manage_profiles;
+ }
+ }
+
return $self->SUPER::current_user_can($right, %args);
}
Added: apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermission.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermission.pm Fri May 11 08:31:20 2007
@@ -0,0 +1,310 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProfilePermission;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => 'AA4D7A6C-FF08-11DB-8E71-163CF1458521';
+
+use List::MoreUtils qw/ any /;
+
+=head1 NAME
+
+CASPlus::Model::ProfilePermission - Applies limits to profile object access
+
+=head1 DESCRIPTION
+
+Each profile permission associated with a role grants access to create, read, write, or delete profile objects described by the profile permission.
+
+The profile permission specifies a specific L<CASPlus::Model::Profile> that it grants permission to. It also specifies four basic properties that determine what is being granted by the permissions: create, read, write, and delete.
+
+A collection of limits is associated with the permission, which are used to determine which profile objects the limits are being applied to. A collection of properties are associated with the permission to determine which properties of the matched objects have these permissions applied.
+
+=head1 SCHEMA
+
+=head2 the_role
+
+The role that the permission is associated with.
+
+=head2 profile
+
+This is the profile table that the permission applies to. Only objects within this profile type are matched by this permission.
+
+=head2 may_create
+
+If true, this grants create access with write allowed to the listed properties of any record of the named profile that matches the limits.
+
+=head2 may_create_my_own
+
+If true, this grants the user access to create profiles that will "belong" to the current member.
+
+=head2 may_read
+
+If true, this grants read access to the listed properties of any record of the named profile that matches the limits.
+
+=head2 may_read_my_own
+
+If true, this grants the user access to read an object that "belongs" to the current user.
+
+=head2 may_write
+
+if true, this grants write access to the listed properties of any record of the named profile that currently matches the limits and whose changes will continue to match the limits.
+
+=head2 may_write_my_own
+
+If true, this grants the user access to write an object that currently "belongs" to the current user.
+
+=head2 may_delete
+
+If true, this grants delete access of any record of the named profile that matches the limits.
+
+=head2 may_delete_my_own
+
+If true, this grants the user access to delete an object that currently "belongs" to the current user.
+
+=head2 limits
+
+A collection of limits that restrict the scope of this permission. See L<CASPlus::Model::ProfilePermissionLimit>.
+
+=head2 properties
+
+A collection of properties that limit which fields this permission is applied to. See L<CASPlus::Model::ProfilePermissionProperty>.
+
+=cut
+
+use CASPlus::Record schema {
+ column the_role =>
+ refers_to CASPlus::Model::Role,
+ label is 'Role',
+ is mandatory;
+
+ column profile =>
+ refers_to CASPlus::Model::Profile,
+ label is 'Profile',
+ is mandatory;
+
+ column may_create =>
+ type is 'boolean',
+ label is 'Create?',
+ is mandatory,
+ default is 0;
+
+ column may_create_my_own =>
+ type is 'boolean',
+ label is 'Create my own?',
+ is mandatory,
+ default is 0;
+
+ column may_read =>
+ type is 'boolean',
+ label is 'Read?',
+ is mandatory,
+ default is 0;
+
+ column may_read_my_own =>
+ type is 'boolean',
+ label is 'Read my own?',
+ is mandatory,
+ default is 0;
+
+ column may_write =>
+ type is 'boolean',
+ label is 'Write?',
+ is mandatory,
+ default is 0;
+
+ column may_write_my_own =>
+ type is 'boolean',
+ label is 'Write my own?',
+ is mandatory,
+ default is 0;
+
+ column may_delete =>
+ type is 'boolean',
+ label is 'Delete?',
+ is mandatory,
+ default is 0;
+
+ column may_delete_my_own =>
+ type is 'boolean',
+ label is 'Delete my own?',
+ is mandatory,
+ default is 0;
+
+ column limits =>
+ refers_to CASPlus::Model::ProfilePermissionLimitCollection
+ by 'profile_permission';
+
+ column properties =>
+ refers_to CASPlus::Model::ProfilePermissionPropertyCollection
+ by 'profile_permission';
+};
+
+=head1 METHODS
+
+=head2 name
+
+ my $name = $permission->name;
+
+This returns a short description of the permission. The description will be something like:
+
+ Grants read, write on Company
+
+=cut
+
+sub name {
+ my $self = shift;
+
+ my @grants;
+ push @grants, 'create' if $self->may_create;
+ push @grants, 'read' if $self->may_read;
+ push @grants, 'write' if $self->may_write;
+ push @grants, 'delete' if $self->may_delete;
+
+ push @grants, 'create own' if $self->may_create_my_own;
+ push @grants, 'read own' if $self->may_read_my_own;
+ push @grants, 'write own' if $self->may_write_my_own;
+ push @grants, 'delete own' if $self->may_delete_my_own;
+
+ return 'Grants '.join(', ', @grants).' on '.$self->profile->name;
+}
+
+=head2 description
+
+ my $description = $permission->description;
+
+This is an extended description of the permission. It describes the permission being granted in English. Here's an example:
+
+ Grants read, write on Company including the fields Name, Address, Phone
+ for any record where Status is "active"
+
+=cut
+
+sub description {
+ my $self = shift;
+
+ my $description = $self->name;
+
+ my @properties = map { $_->name } @{ $self->properties->items_array_ref };
+
+ if (@properties) {
+ $description .= ' including the fields ';
+ $description .= join(', ', @properties);
+ }
+
+ my @limits = map { $_->name } @{ $self->limits->items_array_ref };
+
+ if (@limits) {
+ $description .= ' for any record where ';
+ $description .= join(' and ', @limits);
+ }
+
+ return $description;
+}
+
+=head2 matches
+
+ my $access = $permission->matches($obj, $right, %attrs);
+
+Performs a check to see if permission to access the profile object, C<$obj>, would be granted for the operation, C<$right>, given the attributes C<%attrs> by this permission.
+
+=cut
+
+sub matches {
+ my ($self, $obj, $right, %attrs) = @_;
+ # Make sure the object matches the profile this is applied to
+ return 0 unless $obj->isa($self->profile->model_class->qualified_class);
+
+ # Check the may flags
+ my $may_create = $self->may_create;
+ my $may_read = $self->may_read;
+ my $may_write = $self->may_write;
+ my $may_delete = $self->may_delete;
+
+ # if the object belongs to the current user, check the may my own flags
+ if ($obj->is_mine) {
+ $may_create ||= $self->may_create_my_own;
+ $may_read ||= $self->may_read_my_own;
+ $may_write ||= $self->may_write_my_own;
+ $may_delete ||= $self->may_delete_my_own;
+ }
+
+ # Make sure this permission will permit the request right
+ return 0 if $right eq 'create' and !$may_create;
+ return 0 if $right eq 'read' and !$may_read;
+ return 0 if $right eq 'write' and !$may_write;
+ return 0 if $right eq 'delete' and !$may_delete;
+
+ # Check that the object matches the limits
+ for my $limit (@{ $self->limits->items_array_ref }) {
+
+ # Do not check the new object on create, properties aren't set yet
+ if ($right ne 'create') {
+ return 0 unless $limit->matches_object($obj);
+ }
+
+ # Check to make sure the new values will match on create or update
+ if ($right eq 'create' or $right eq 'write') {
+ return 0 unless $limit->matches_args(\%attrs);
+ }
+ }
+
+ # Except for delete, make sure the properties being created, read, or
+ # written to are in the effected fields
+ if ($right ne 'delete' and $self->properties->count > 0) {
+ my %properties
+ = map { $_->name => 1 } @{ $self->properties->items_array_ref };
+
+ for my $arg (keys %attrs) {
+ return 0 unless $properties{ $arg };
+ }
+ }
+
+ # All checks pass, return true
+ return 1;
+}
+
+=head2 current_user_can
+
+ my $access = $permission->current_user_can($right, %args);
+
+Permits all users to read their own permissions and allows superuser and users with a role granting role management permission to modify the permissions.
+
+=cut
+
+sub current_user_can {
+ my ($self, $right, %args) = @_;
+
+ # Short circuit this before the heavier tests
+ if ($self->current_user->is_superuser) {
+ return 1;
+ }
+
+ # Grant read if the current user has this permission
+ if ($right eq 'read'
+ and any { $_->id == $self->id }
+ $self->current_user->profile_permissions(1)) {
+ return 1;
+ }
+
+ # Grant anything if the user has may_manage_roles
+ if (any { $_->may_manage_roles } $self->current_user->roles(1)) {
+ return 1;
+ }
+
+ # Fallback on the default implementation
+ return $self->SUPER::current_user_can($right, %args);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<< <hanenkamp at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+
Added: apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionLimit.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionLimit.pm Fri May 11 08:31:20 2007
@@ -0,0 +1,178 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProfilePermissionLimit;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => 'AC72CAFE-FF08-11DB-B2A4-173CF1458521';
+
+=head1 NAME
+
+CASPlus::Model::ProfilePermissionLimit - Limits associated with profile permissions
+
+=head1 DESCRIPTION
+
+Each limit reduces the scope that a permission is applied to. Each limit performs a specific matching operation against a property for a certain value.
+
+=head1 SCHEMA
+
+=head2 profile_permission
+
+The L<CASPlus::Model::ProfilePermission> this limit is applied to.
+
+=head2 property
+
+The L<CASPlus::Model::ProfileProperty> that is the recipient of the limit.
+
+=head2 operation
+
+The operation to use in matching. This must be one of: eq, ne, gt, lt, ge, lt, ==, !=, E<gt>, E<lt>, E<gt>=, E<lt>=, =~, or !~.
+
+=head2 value
+
+This is the scalar or regular expression value used to perform the limit. This is treated as a literal scalar value for most operations. It is interpreted as a regular expression when the operation is either =~ or !~.
+
+=cut
+
+use CASPlus::Record schema {
+ column profile_permission =>
+ refers_to CASPlus::Model::ProfilePermission,
+ label is 'Permission',
+ is mandatory;
+
+ column property =>
+ refers_to CASPlus::Model::ProfileProperty,
+ label is 'Property',
+ is mandatory;
+
+ column operation =>
+ type is 'text',
+ label is 'Operation',
+ is mandatory,
+ default is 'eq',
+ valid_values are qw/
+ eq ne lt gt le ge
+ == != < > <= >=
+ =~ !~
+ /;
+
+ column value =>
+ type is 'text',
+ label is 'Value';
+};
+
+use Jifty::RightsFrom column => 'profile_permission';
+
+=head1 METHODS
+
+=head2 name
+
+ my $name = $limit->name;
+
+This provides an English name for the limit. This will be something like:
+
+ Name is after "Bob"
+
+=cut
+
+my %operation_description = (
+ 'eq' => 'is',
+ 'ne' => 'is not',
+ 'lt' => 'is before',
+ 'gt' => 'is after',
+ 'le' => 'is or comes before',
+ 'ge' => 'is or comes after',
+ '==' => 'is equal to',
+ '!=' => 'is not equal to',
+ '<' => 'is less than',
+ '>' => 'is greater than',
+ '<=' => 'is less than or equal to',
+ '>=' => 'is greater than or equal to',
+ '=~' => 'matches',
+ '!~' => 'does not match',
+);
+
+sub name {
+ my $self = shift;
+
+ my $field = $self->property->name;
+ my $operation = $self->operation;
+ my $value = $self->value;
+ $value
+ = ($operation eq '=~' || $operation eq '!~') ? "/$value/"
+ : ($operation eq 'eq' || $operation eq 'ne') ? qq("$value")
+ : ($operation eq 'lt' || $operation eq 'gt') ? qq("$value")
+ : ($operation eq 'le' || $operation eq 'ge') ? qq("$value")
+ : $value;
+ $operation = $operation_description{ $operation },
+
+ return "$field $operation $value";
+}
+
+=head2 matches_object
+
+ my $access = $limit->matches_object($obj);
+
+Returns true if the object passes this limit. Returns false otherwise.
+
+=cut
+
+my %operations = (
+ 'eq' => sub { $_[0] eq $_[1] },
+ 'ne' => sub { $_[0] ne $_[1] },
+ 'gt' => sub { $_[0] gt $_[1] },
+ 'lt' => sub { $_[0] lt $_[1] },
+ 'ge' => sub { $_[0] ge $_[1] },
+ 'le' => sub { $_[0] le $_[1] },
+
+ '==' => sub { $_[0] == $_[1] },
+ '!=' => sub { $_[0] != $_[1] },
+ '>' => sub { $_[0] > $_[1] },
+ '<' => sub { $_[0] < $_[1] },
+ '>=' => sub { $_[0] >= $_[1] },
+ '<=' => sub { $_[0] <= $_[1] },
+
+ '=~' => sub { $_[0] =~ /$_[1]/ },
+ '!~' => sub { $_[0] !~ /$_[1]/ },
+);
+
+sub matches_object {
+ my ($self, $obj) = @_;
+
+ my $property = $self->property->model_class_column->name;
+ my $operation = $operations{ $self->operation };
+ my $value = $self->value;
+
+ return $operation->($obj->$property, $value);
+}
+
+=head2 matches_args
+
+ my $access = $limit->matches_args(\%args)
+
+Performs the same operation as C<matches_obj> except upon the new arguments that are about to be set. If the property specified by this limit is not being set, it returns true. Otherwise, it returns true only if the new value will match this limit.
+
+=cut
+
+sub matches_args {
+ my ($self, $args) = @_;
+
+ my $property = $self->property->model_class_column->name;
+ my $operation = $operations{ $self->operation };
+ my $value = $self->value;
+
+ return $operation->($args->{ $property }, $value);
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<< <hanenkamp at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+
Added: apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionProperty.pm
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/ProfilePermissionProperty.pm Fri May 11 08:31:20 2007
@@ -0,0 +1,72 @@
+use strict;
+use warnings;
+
+package CASPlus::Model::ProfilePermissionProperty;
+use Jifty::DBI::Schema;
+
+use constant CLASS_UUID => 'AF33C0C2-FF08-11DB-928F-183CF1458521';
+
+=head1 NAME
+
+CASPlus::Model::ProfilePermissionProperty - Associates properties with a profile permission
+
+=head1 DESCRIPTION
+
+Each profile permission property record associates a specific proeprty that is affected by the permission.
+
+=head1 SCHEMA
+
+=head2 profile_permission
+
+The L<CASPlus::Model::ProfilePermission> object to which this property is being associated with.
+
+=head2 property
+
+The L<CASPlus::Model::ProfileProperty> that the permission will have affect upon.
+
+=cut
+
+use CASPlus::Record schema {
+ column profile_permission =>
+ refers_to CASPlus::Model::ProfilePermission,
+ label is 'Permission',
+ is mandatory;
+
+ column property =>
+ refers_to CASPlus::Model::ProfileProperty,
+ label is 'Property',
+ is mandatory;
+};
+
+use Jifty::RightsFrom column => 'profile_permission';
+
+=head1 METHODS
+
+=head2 name
+
+ my $name = $permission_property->name;
+
+Gives the name of the property. It is a synonym for:
+
+ my $name = $permission_property->property->name;
+
+=cut
+
+sub name {
+ my $self = shift;
+
+ return $self->property->name;
+}
+
+=head1 AUTHOR
+
+Andrew Sterling Hanenkamp, C<< <hanenkamp at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2007 Boomer Consulting, Inc. This program is free software and may be modified or distributed under the same terms as Perl itself.
+
+=cut
+
+1;
+
Modified: apps/CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/ProfileProperty.pm Fri May 11 08:31:20 2007
@@ -62,6 +62,8 @@
is immutable;
};
+use Jifty::RightsFrom column => 'profile';
+
=head1 METHODS
=head2 before_create
Modified: apps/CASPlus/trunk/lib/CASPlus/Model/Role.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/Model/Role.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/Role.pm Fri May 11 08:31:20 2007
@@ -6,11 +6,11 @@
use constant CLASS_UUID => '0E3ADC30-C0DA-11DB-A6B8-66B01988A606';
-use CASPlus::Model::RoleMemberCollection;
+use List::MoreUtils qw/ any /;
=head1 NAME
-CASPlus::Model::Role - Storage for role membership
+CASPlus::Model::Role - Storage for roles
=head1 DESCRIPTION
@@ -35,8 +35,35 @@
is mandatory,
is distinct;
+ column may_manage_profiles =>
+ type is 'boolean',
+ label is 'Manage profiles?',
+ is mandatory,
+ default is 0;
+
+ column may_manage_profile_objects =>
+ type is 'boolean',
+ label is 'Manage profile objects?',
+ is mandatory,
+ default is 0;
+
+ column may_manage_roles =>
+ type is 'boolean',
+ label is 'Manage roles?',
+ is mandatory,
+ default is 0;
+
+ column may_manage_users =>
+ type is 'boolean',
+ label is 'Manage users?',
+ is mandatory,
+ default is 0;
+
column role_members =>
refers_to CASPlus::Model::RoleMemberCollection by 'the_role';
+
+ column profile_permissions =>
+ refers_to CASPlus::Model::ProfilePermissionCollection by 'the_role';
};
=head1 METHODS
@@ -57,6 +84,31 @@
return CASPlus::Model::Profile->load_profile_instance( role => $self->id );
}
+=head2 current_user_can
+
+ my $access = $role->current_user_can($right, %args);
+
+The current user can access this role if the user belongs to it. The current user may perform any operation if superuser or if he has a role assigned role management permission.
+
+=cut
+
+sub current_user_can {
+ my ($self, $right, %args) = @_;
+
+ # Short circuit this before the heavier tests
+ if ($self->current_user->is_superuser) {
+ return 1;
+ }
+
+ # Check to see if the current user is this role or has manage roles
+ if (any { $_->id eq $self->id || $_->may_manage_roles }
+ $self->current_user->roles(1)) {
+ return 1;
+ }
+
+ return $self->SUPER::current_user_can($right, %args);
+}
+
=head1 AUTHOR
Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
Modified: apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/RoleMember.pm Fri May 11 08:31:20 2007
@@ -6,8 +6,7 @@
use constant CLASS_UUID => '112B4286-C0DA-11DB-8E01-67B01988A606';
-use CASPlus::Model::User;
-use CASPlus::Model::Role;
+use List::MoreUtils qw/ any /;
=head1 NAME
@@ -39,6 +38,37 @@
is mandatory;
};
+=head1 METHODS
+
+=head1 current_user_can
+
+ my $access = $membership->current_user_can($right, %args);
+
+Returns true if the current user has the manage roles permission, is superuser, or if the related user object is the current user.
+
+=cut
+
+sub current_user_can {
+ my ($self, $right, %args) = @_;
+
+ # Is this the current user?
+ if ($right eq 'read' && $self->current_user->id == $self->the_user->id) {
+ return 1;
+ }
+
+ # Short circuit prior to the heavier search next
+ if ($self->current_user->is_superuser) {
+ return 1;
+ }
+
+ # Check to see if any role has manage roles set
+ if (any { $_->may_manage_roles } $self->current_user->roles(1)) {
+ return 1;
+ }
+
+ return $self->SUPER::current_user_can($right, %args);
+}
+
=head1 AUTHOR
Andrew Sterling Hanenkamp, C<<hanenkamp at cpan.org>>>
Modified: apps/CASPlus/trunk/lib/CASPlus/Model/User.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/Model/User.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/Model/User.pm Fri May 11 08:31:20 2007
@@ -6,10 +6,8 @@
use constant CLASS_UUID => '3D47B972-B779-11DB-B763-9DBD470BAD47';
-use CASPlus::Model::RoleMemberCollection;
-use CASPlus::Model::SSOSessionCollection;
-
use IO::String;
+use List::MoreUtils qw/ any /;
use XML::Writer;
=head1 NAME
@@ -149,7 +147,7 @@
=head2 current_user_can
-This enables the individual to read, write, and modify the user record belonging to him. Only superuser can read, write, and modify other user records.
+This enables the individual to read, write, and modify the user record belonging to him. Superuser and any user with a role granting user management permission may read, write, and modify other user records.
=cut
@@ -162,6 +160,10 @@
}
}
+ if (any { $_->may_manage_users } $self->current_user->roles) {
+ return 1;
+ }
+
return $self->SUPER::current_user_can($right, %args);
}
Modified: apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm
==============================================================================
--- /apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm (original)
+++ apps/CASPlus/trunk/lib/CASPlus/ProfileBase.pm Fri May 11 08:31:20 2007
@@ -4,6 +4,8 @@
package CASPlus::ProfileBase;
use base qw/ CASPlus::Record /;
+use List::MoreUtils qw/ any /;
+
=head1 NAME
CASPlus::ProfileBase - base class of all profile objects
@@ -14,16 +16,61 @@
=head1 METHODS
+=head2 is_mine
+
+ my $mine = $object->is_mine;
+
+Returns true if the object is related to the current user. As of this writing, this only includes objects directly attached to users.
+
+=cut
+
+sub is_mine {
+ my $self = shift;
+ my $current_user = $self->current_user;
+
+ # Do we have a real user?
+ if ($current_user->id) {
+
+ # Find out what kind of object I am
+ my $profile = CASPlus::Model::Profile->new;
+ $profile->load_by_profile_object($self);
+
+ # Am I an object related to a user?
+ if ($profile->profile_type eq 'user') {
+
+ # I belong to the current user if I am directly related
+ return $self->user_object->id
+ && $self->user_object->id == $current_user->id;
+ }
+
+ # Otherwise, I can't determine the relationship at this time
+ else {
+ return 0;
+ }
+ }
+
+ # If I'm not a real user, it can't be mine
+ else {
+ return 0;
+ }
+}
+
=head2 current_user_can
-As of this writing, all users can read all profile objects, but only superuser is able to create profile objects.
+Any user with superuser user or the manage profile objects permission assigned to at least one role may access this object.
+
+Otherwise, a user will only be able to create, read, write, or delete an object if it is granted by a profile permission associated with the user's roles.
=cut
sub current_user_can {
my ($self, $right, %args) = @_;
- if ($right eq 'read') {
+ if (any { $_->may_manage_profile_objects } $self->current_user->roles) {
+ return 1;
+ }
+
+ if ($self->current_user->can_access_profile($self, $right, %args)) {
return 1;
}
Modified: apps/CASPlus/trunk/t/00-dependencies.t
==============================================================================
--- /apps/CASPlus/trunk/t/00-dependencies.t (original)
+++ apps/CASPlus/trunk/t/00-dependencies.t Fri May 11 08:31:20 2007
@@ -2,11 +2,14 @@
use strict;
use warnings;
-use Test::More skip_all => 'Test::Dependencies does not work with Jifty.';
+use Test::More;
SKIP: {
eval 'use Test::Dependencies plan => 1';
skip 'Test::Dependencies is not available.', 1 if $@;
- ok_dependencies();
+ TODO: {
+ local $TODO = 'Test::Dependencies does not work with Jifty.';
+ ok_dependencies();
+ };
};
Added: apps/CASPlus/trunk/t/10-model-ProfilePermission.t
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/t/10-model-ProfilePermission.t Fri May 11 08:31:20 2007
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProfilePermission model.
+
+=cut
+
+use Jifty::Test tests => 17;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProfilePermission');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a role to attach to
+my $role = CASPlus::Model::Role->new(current_user => $system_user);
+$role->create( name => 'test-role' );
+ok($role->id, 'created a test role');
+
+# Create a profile to attach to
+my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$profile->create( name => 'Some Profile', profile_type => 'other' );
+ok($profile->id, 'created a test profile');
+
+# Try testing a create
+my $o = CASPlus::Model::ProfilePermission->new(current_user => $system_user);
+my ($id) = $o->create( the_role => $role, profile => $profile, may_read => 1 );
+ok($id, "ProfilePermission create returned success");
+ok($o->id, "New ProfilePermission has valid id set");
+is($o->id, $id, "Create returned the right id");
+is($o->name, 'Grants read on Some Profile', 'pretty name');
+is($o->description, 'Grants read on Some Profile', 'pretty description');
+
+# And another
+$o->create( the_role => $role, profile => $profile, may_write => 1 );
+ok($o->id, "ProfilePermission create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+is($o->name, 'Grants write on Some Profile', 'pretty name');
+is($o->description, 'Grants write on Some Profile', 'pretty description');
+
+# Searches in general
+my $collection = CASPlus::Model::ProfilePermissionCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+
Added: apps/CASPlus/trunk/t/10-model-ProfilePermissionLimit.t
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/t/10-model-ProfilePermissionLimit.t Fri May 11 08:31:20 2007
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProfilePermissionLimit model.
+
+=cut
+
+use Jifty::Test tests => 17;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProfilePermissionLimit');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a role to attach to
+my $role = CASPlus::Model::Role->new(current_user => $system_user);
+$role->create( name => 'test-role' );
+ok($role->id, 'created a test role');
+
+# Create a profile to attach to
+my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$profile->create( name => 'Some Profile', profile_type => 'other' );
+ok($profile->id, 'created a test profile');
+
+# Create a property to attach to
+my $property = CASPlus::Model::ProfileProperty->new(current_user => $system_user);
+$property->create( profile => $profile, name => 'Name' );
+ok($property->id, 'created a test property');
+
+# Create a permission to attach to
+my $permission = CASPlus::Model::ProfilePermission->new(current_user => $system_user);
+$permission->create( the_role => $role, profile => $profile );
+ok($permission->id, 'created a test permission');
+
+# Try testing a create
+my $o = CASPlus::Model::ProfilePermissionLimit->new(current_user => $system_user);
+my ($id) = $o->create( profile_permission => $profile, property => $property, operation => 'eq', value => 'Bob' );
+ok($id, "ProfilePermissionLimit create returned success");
+ok($o->id, "New ProfilePermissionLimit has valid id set");
+is($o->id, $id, "Create returned the right id");
+is($o->name, 'Name is "Bob"', 'name generates pretty text');
+
+# And another
+$o->create( profile_permission => $profile, property => $property, operation => '=~', value => qr/^Joe/);
+ok($o->id, "ProfilePermissionLimit create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+is($o->name, 'Name matches /(?-xism:^Joe)/', 'name generates pretty text');
+
+# Searches in general
+my $collection = CASPlus::Model::ProfilePermissionLimitCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+
Added: apps/CASPlus/trunk/t/10-model-ProfilePermissionProperty.t
==============================================================================
--- (empty file)
+++ apps/CASPlus/trunk/t/10-model-ProfilePermissionProperty.t Fri May 11 08:31:20 2007
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+A basic test harness for the ProfilePermissionProperty model.
+
+=cut
+
+use Jifty::Test tests => 18;
+
+# Make sure we can load the model
+use_ok('CASPlus::Model::ProfilePermissionProperty');
+
+# Grab a system user
+my $system_user = CASPlus::CurrentUser->superuser;
+ok($system_user, "Found a system user");
+
+# Create a role to attach to
+my $role = CASPlus::Model::Role->new(current_user => $system_user);
+$role->create( name => 'test-role' );
+ok($role->id, 'created a test role');
+
+# Create a profile to attach to
+my $profile = CASPlus::Model::Profile->new(current_user => $system_user);
+$profile->create( name => 'Some Profile', profile_type => 'other' );
+ok($profile->id, 'created a test profile');
+
+# Create a property to attach to
+my $property = CASPlus::Model::ProfileProperty->new(current_user => $system_user);
+$property->create( profile => $profile, name => 'Name' );
+ok($property->id, 'created a test property');
+
+# Create another property to attach to
+my $property2 = CASPlus::Model::ProfileProperty->new(current_user => $system_user);
+$property2->create( profile => $profile, name => 'Address' );
+ok($property2->id, 'created another test property');
+
+# Create a permission to attach to
+my $permission = CASPlus::Model::ProfilePermission->new(current_user => $system_user);
+$permission->create( the_role => $role, profile => $profile );
+ok($permission->id, 'created a test permission');
+
+# Try testing a create
+my $o = CASPlus::Model::ProfilePermissionProperty->new(current_user => $system_user);
+my ($id) = $o->create( profile_permission => $profile, property => $property );
+ok($id, "ProfilePermissionProperty create returned success");
+ok($o->id, "New ProfilePermissionProperty has valid id set");
+is($o->id, $id, "Create returned the right id");
+is($o->name, 'Name', 'name matches property');
+
+# And another
+$o->create( profile_permission => $profile, property => $property2 );
+ok($o->id, "ProfilePermissionProperty create returned another value");
+isnt($o->id, $id, "And it is different from the previous one");
+is($o->name, 'Address', 'name matches property');
+
+# Searches in general
+my $collection = CASPlus::Model::ProfilePermissionPropertyCollection->new(current_user => $system_user);
+$collection->unlimit;
+is($collection->count, 2, "Finds two records");
+
+# Searches in specific
+$collection->limit(column => 'id', value => $o->id);
+is($collection->count, 1, "Finds one record with specific id");
+
+# Delete one of them
+$o->delete;
+$collection->redo_search;
+is($collection->count, 0, "Deleted row is gone");
+
+# And the other one is still there
+$collection->unlimit;
+is($collection->count, 1, "Still one left");
+
Modified: apps/CASPlus/trunk/t/50-me.t
==============================================================================
--- /apps/CASPlus/trunk/t/50-me.t (original)
+++ apps/CASPlus/trunk/t/50-me.t Fri May 11 08:31:20 2007
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Jifty::Test tests => 24;
+use Jifty::Test tests => 27;
use Jifty::Test::WWW::Mechanize;
my $system_user = CASPlus::CurrentUser->superuser;
@@ -20,6 +20,18 @@
$user->create( username => 'test-me', password => 'test' );
ok($user->id, 'created a test user');
+my $role = CASPlus::Model::Role->new(current_user => $system_user);
+$role->create( name => 'test-us' );
+ok($role->id, 'created a test role');
+
+my $role_member = CASPlus::Model::RoleMember->new(current_user => $system_user);
+$role_member->create( the_user => $user, the_role => $role );
+ok($role_member->id, 'created a test role membership');
+
+my $permission = CASPlus::Model::ProfilePermission->new(current_user => $system_user);
+$permission->create( the_role => $role, profile => $profile, may_read_my_own => 1 );
+ok($permission->id, 'created a test profile permission');
+
my $user_profile = $profile->model_class->qualified_class->new(current_user => $system_user);
isa_ok($user_profile, 'CASPlus::ProfileBase');
can_ok($user_profile, 'user_object');
More information about the Jifty-commit
mailing list