—package
Authorization::RBAC;
$Authorization::RBAC::VERSION
=
'0.08'
;
use
utf8;
use
v5.10;
use
Moose;
use
Config::JFDI;
subtype
MyConf
=> as
'HashRef'
;
coerce
'MyConf'
=> from
'Str'
=> via {
my
$conf
=
shift
;
my
(
$jfdi_h
,
$jfdi
) = Config::JFDI->
open
(
$conf
)
or croak
"Error (conf: $conf) : $!\n"
;
return
$jfdi
->get;
};
has
conf
=> (
is
=>
'rw'
,
isa
=>
'MyConf'
,
coerce
=> 1,
trigger
=>
sub
{
my
$self
=
shift
;
my
$args
=
shift
;
croak
"Error: Can not find "
.
$self
->ns .
" in your conf !"
if
( !
$args
->{
$self
->ns});
$self
->config(
$args
->{
$self
->ns});
$self
->debug(
$self
->config->{
'debug'
})
if
(
defined
$self
->config->{
'debug'
} );
$self
->_load_backend
if
!
$self
->can(
'backend'
);
}
);
has
'debug'
=> (
is
=>
'rw'
,
);
has
_plugin_ns
=> (
is
=>
'rw'
,
required
=> 1,
isa
=>
'Str'
,
default
=>
sub
{
'Backend'
},
);
# namespace
has
'ns'
=> (
is
=>
'rw'
,
default
=>
sub
{ __PACKAGE__ },
);
has
config
=> (
isa
=>
"HashRef"
,
is
=>
"rw"
,
);
has
cache
=> (
is
=>
"rw"
,
required
=> 0,
);
sub
_load_backend {
my
$self
=
shift
;
my
$backend
=
$self
->config->{
'backend'
}->{name};
$self
->_log(
"Loading $backend backend ..."
);
$self
->load_plugin(
$backend
);
}
# can_access check if user or roles have permissions on all operations
# of a object or more.
sub
can_access {
my
(
$self
,
$roles
,
$objects
,
$additional_operations
) =
@_
;
# Check perm on all objects
foreach
my
$obj
(
@$objects
) {
# Not necessary to check if it's not an object
next
if
!
ref
(
$obj
);
# copy obj not to disturb objets
my
$obj2
=
$obj
;
# build parent objects
my
@allobjs
;
while
(
$obj2
) {
push
(
@allobjs
,
$obj2
);
my
$typeobj
=
ref
(
$obj2
);
$typeobj
=~ s/.*:://;
my
$parent_field
=
$self
->config->{typeobj}->{
$typeobj
}->{parent_field} ||
'parent'
;
if
(
$obj2
->can(
$parent_field
)) {
$obj2
=
$obj2
->
$parent_field
;
}
else
{
$obj2
= 0 }
}
# check permission on each object
my
$ops
;
foreach
my
$obj2
(
reverse
@allobjs
) {
my
$typeobj2
=
ref
(
$obj2
);
$typeobj2
=~ s/.*:://;
$self
->_log(
"> Search if we can access to ${typeobj2}_"
.
$obj2
->id);
if
(
$obj2
eq
$obj
) {
$ops
=
$additional_operations
;
}
else
{
$ops
=
''
;
}
if
( !
$self
->check_permission(
$roles
,
$obj2
,
$ops
)){
$self
->_log(
"return 0"
);
return
0;
}
}
}
$self
->_log(
"return 1"
);
return
1;
}
# Is roles can an operation on object
sub
check_permission {
my
(
$self
,
$roles
,
$obj
,
$additional_operations
) =
@_
;
my
$typeobj
=
ref
(
$obj
);
$typeobj
=~ s/.*:://;
my
@ops_to_access
=
$obj
->ops_to_access;
if
(
$additional_operations
) {
push
(
@ops_to_access
,
$self
->get_operations(
$additional_operations
));
my
@toto
=
$self
->get_operations(
$additional_operations
);
}
$self
->_log(
" [OK] Object is not protected"
)
if
( !
$ops_to_access
[0] );
# Looking operations protecting the object
my
%already_checked
;
foreach
my
$op
(
@ops_to_access
) {
next
if
!
$op
;
next
if
$already_checked
{
$op
->name};
$already_checked
{
$op
->name} = 1;
my
$ret
= 0;
ROLES:
foreach
my
$r
(
@$roles
) {
$self
->_log(
"- Search if role "
.
$r
->name .
" can '"
.
$op
->name .
"' '${typeobj}_"
.
$obj
->id.
"'"
);
# get permission from backend
my
(
$result
,
$apply_to_children
) =
$self
->get_permission(
$r
,
$op
,
$obj
);
if
( !
defined
$result
) {
next
;
}
elsif
( !
$result
) {
$self
->_log(
" [KO] "
.
$r
->name.
" cannot '"
.
$op
->name .
"' '${typeobj}_"
.
$obj
->id.
"'"
);
$ret
= 0;
}
elsif
(
$result
) {
$self
->_log(
" [OK] "
.
$r
->name.
" can '"
.
$op
->name .
"' '${typeobj}_"
.
$obj
->id.
"'"
);
$ret
= 1;
last
ROLES;
}
}
return
0
if
!
$ret
;
}
return
1;
}
sub
_log{
my
(
$self
,
$msg
) =
@_
;
return
if
!
$self
->debug;
say
STDERR
"[debug] $msg"
;
}
=encoding utf8
=head1 NAME
Authorization::RBAC - Role-Based Access Control system
=head1 VERSION
version 0.08
=head1 SYNOPSIS
use Authorization::RBAC;
my $conf = 't/conf/permsfromdbix.yml';
my $rbac = Authorization::RBAC->new( conf => $conf );
my $page = $rbac->schema->resultset('Page')->search( name => 'add' , parent => 7 );
my $roles = ... function that returns the roles ...
if ( $rbac->can_access($roles, $page, [ 'create_Page' ]) ){
# Role 'member' can access to Page /page/wiki/add
}
=head1 DESCRIPTION
Role-based access control (RBAC) is an approach to restricting system access to authorized users.
User -> Role(s)
Role -> Permission -> Object (Typeobj, unique)
-> Operation
So you can apply a permission to an instance of a Object and not only on all the class of the Object.
La suite en Français ...
Pourquoi ce module: J'étais à la recherche d'un module pouvant assurer la protection des accès à des objets. J'ai bien trouvé des modules sur le CPAN qui semblait répondre au besoin mais il y avait toujours un détail, une approche qui ne me convenait pas. La plupart de ces modules répondent à la question 'Est-ce que ce rôle peut faire cette opération ?'. Par exemple 'Est-ce que le rôle 'anonyme' peut créer un commentaire ?' mais jamais à la question 'Est-ce que ce rôle peut faire cette opération sur cet objet ?', exemple : 'Est que le role anonyme peut créer un commentaire sur cette page ?'. De plus je souhaitais que ce système de permissions soit récursif si l'objet à protéger comportait un champ 'parent'.
Comment ça marche :
Actuellement Authorization::RBAC comporte un seul backend : DBIx
Définition des acteurs du système :
- Un Type d'objet : Ce peut être une 'Page', un 'Commentaire', 'Une pièce jointe' ...
- Opération : Il s'agit d'un action sur un Type d'objet'. ( 'Add_Page', 'Del_Comment')
- Un Objet : c'est une instance du Type d'objet. 'Page login', 'Comment n°33', ...
- Une Permission : c'est une opération sur un Objet. Elle peut être récursive.
- Un Role : Il hérite de Permission(s)
Pour accéder à un Objet, le(s) role(s) doit posséder une Permission répondant à une Opération par défaut. Pour cela l'Objet doit avoir une méthode 'ops_to_access' qui retourne le ou les Operations qui le protège (en fait une référence à un tableau d'Opération). Par exemple la méthode ops_to_access de l'Objet 'Page /' retourne ['view_Page'], ce qui signifie "Pour accéder à la Page / le role doit avoir la Permission view_Page sur Page /".
La méthode 'can_access' permet d'interroger le système:
my $access = $rbac->can_access($roles, $objet, $additional_operations );
Un Objet peut avoir une méthode 'parent'. Si c'est le cas alors 2 mécanismes s'ajoute au système de permission :
- L'accès à un objet est obtenu si l'accès est permis à tous ses parents. Par exemple, pour accéder à la Page '/admin/user/add', le(s) devra successivement accéder à '/', 'admin', 'user' et enfin 'add'.
- En second lieu une Permission peut être rechercher récursivement sur les parents de l'Objet.
Par exemple si nous avons les relations suivantes :
Page:
/:
ops_to_access: view_Page
admin:
ops_to_access: view_Page
add:
ops_to_access: create_Page
Pour accéder à l'Objet 'Page /admin/user/add', le(s) role(s) devra posséder des Permissions répondant à 'view_Page sur Page /', 'view_Page sur Page admin' et 'create_Page sur Page add'.
Imaginons que le(s) role(s) ne peuvent accèder à l'Objet. Par exemple si le(s) role(s) ne peuvent accéder à 'create_Page sur Page add' alors la recherche de la Permission se fera aussi sur 'admin' puis sur '/'. Pour que cette règle s'applique il faut que la Permission ait une méthode 'apply_to_children' qui si elle retourne 1 rendra la Permission héritable par ses enfants. Si elle retourne cela a l'effet inverse, ça signifie que le role n'a pas ou plus cette Permission.
Imaginons maintenant que les roles aient les Permissions suivantes :
Roles:
administrateur:
view_Page:
Page_/: 1
apply_to_children: 1
Page_admin: 1
apply_to_children: 1
create_Page:
Page_/: 1
apply_to_children: 1
anonymous:
view_Page:
Page_/; 1
apply_to_children: 1
Page_admin: 0
apply_to_children: 1
Ainsi lorsque l'on recherche si le role 'administrateur' peut accéder à / admin / user / add, on ne trouvera pas de Permission 'create_Page sur Page add' mais on la retrouvera sur le parent racine et cette Permission est 'apply_to_children:' donc heritable.
=head1 CONFIGURATION
See t/conf/permfromdb.yml
And also L<Authorization::RBAC::Backend::DBIx>
=head1 PROVIDED METHODS
=head2 can_access($roles, $objects, $additional_operations )
=head2 check_permission($roles, $objects, $additional_operations )
=head1 AUTHOR
Daniel Brosseau, C<< <dab at catapulse.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-authorization-rbac at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Authorization-RBAC>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Authorization::RBAC
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker (report bugs here)
=item * AnnoCPAN: Annotated CPAN documentation
=item * CPAN Ratings
=item * Search CPAN
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2015 Daniel Brosseau.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;
# End of Authorization::RBAC