CipUX-RBAC-Simple-3.4.0.0/0000755000175000017500000000000011165474541015004 5ustar ckuelkerckuelkerCipUX-RBAC-Simple-3.4.0.0/META.yml0000444000175000017500000000146311165474541016257 0ustar ckuelkerckuelker--- name: CipUX-RBAC-Simple version: 3.4.0.0 author: - 'Christian Kuelker ' abstract: RBAC class for CipUX license: gpl resources: homepage: http://www.cipux.org license: ~ requires: Carp: 0 CipUX: 3.4.0.0 CipUX::Task: 3.4.0.0 Class::Std: 0.0.9 Data::Dumper: 0 English: 0 Graph: 0 Graph::Directed: 0 Log::Log4perl: 0 Readonly: 0 version: 0 build_requires: Module::Build::CipUX: 0.3.0 Test::LeakTrace: 0 Test::More: 0 Test::Pod: 1.14 Test::Refcount: 0 recommends: File::Spec: 0 Test::Perl::Critic: 0 Test::Pod::Coverage: 1.04 provides: CipUX::RBAC::Simple: file: lib/CipUX/RBAC/Simple.pm version: 3.4.0.0 generated_by: Module::Build version 0.32 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 CipUX-RBAC-Simple-3.4.0.0/t/0000755000175000017500000000000011165474541015247 5ustar ckuelkerckuelkerCipUX-RBAC-Simple-3.4.0.0/t/perlcriticrc0000444000175000017500000000101711165474541017654 0ustar ckuelkerckuelker# CipUX Perl::Critic Configuration # # SEVERITY NAME ...is equivalent to... SEVERITY NUMBER # ---------------------------------------------------- # gentle 5 # stern 4 # harsh 3 # cruel 2 # brutal 1 severity = brutal verbose = 11 CipUX-RBAC-Simple-3.4.0.0/t/pod-coverage.t0000444000175000017500000000104711165474541020007 0ustar ckuelkerckuelkeruse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); CipUX-RBAC-Simple-3.4.0.0/t/00-load.t0000444000175000017500000000024711165474541016571 0ustar ckuelkerckuelker#!perl -T use Test::More tests => 1; BEGIN { use_ok('CipUX::RBAC::Simple'); } diag("Testing CipUX::RBAC::Simple $CipUX::RBAC::Simple::VERSION, Perl $], $^X" ); CipUX-RBAC-Simple-3.4.0.0/t/pod.t0000444000175000017500000000035011165474541016212 0ustar ckuelkerckuelker#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); CipUX-RBAC-Simple-3.4.0.0/t/leaktrace.t0000444000175000017500000000023711165474541017367 0ustar ckuelkerckuelkeruse Test::More tests => 1; use Test::LeakTrace; no_leaks_ok { use CipUX::RBAC::Simple; my $object = CipUX::RBAC::Simple->new(); } 'no memory leaks'; CipUX-RBAC-Simple-3.4.0.0/t/refcount.t0000444000175000017500000000037711165474541017266 0ustar ckuelkerckuelkeruse Test::More tests => 2; use Test::Refcount; use CipUX::RBAC::Simple; my $object = CipUX::RBAC::Simple->new(); is_oneref( $object, '$object has a refcount of 1' ); my $otherref = $object; is_refcount( $object, 2, '$object now has 2 references' ); CipUX-RBAC-Simple-3.4.0.0/t/perlcritic.t0000444000175000017500000000100711165474541017570 0ustar ckuelkerckuelker#!perl use strict; use warnings; use File::Spec; use Test::More; use English qw(-no_match_vars); if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; if ($EVAL_ERROR) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok(); CipUX-RBAC-Simple-3.4.0.0/Changes0000444000175000017500000000037211165474541016277 0ustar ckuelkerckuelkerRevision history for CipUX-RBAC-Simple 3.4.0.0 2009-04-03T22:17:23 - Initial release by Christian Kuelker . - version created by: Christian Kuelker CipUX-RBAC-Simple-3.4.0.0/lib/0000755000175000017500000000000011165474541015552 5ustar ckuelkerckuelkerCipUX-RBAC-Simple-3.4.0.0/lib/CipUX/0000755000175000017500000000000011165474541016542 5ustar ckuelkerckuelkerCipUX-RBAC-Simple-3.4.0.0/lib/CipUX/RBAC/0000755000175000017500000000000011165474541017251 5ustar ckuelkerckuelkerCipUX-RBAC-Simple-3.4.0.0/lib/CipUX/RBAC/Simple.pm0000444000175000017500000004700111165474541021040 0ustar ckuelkerckuelker# +==========================================================================+ # || CipUX::RBAC::Simple || # || || # || Somple CipUX RBAC Role Based Access Control || # || || # || Copyright (C) 2009 by Christian Kuelker. All rights reserved! || # || || # || License: GNU General Public License - GNU GPL version 2 || # || or (at your opinion) any later version || # || || # +==========================================================================+ # ID: $Id$ # Revision: $Revision$ # Head URL: $HeadURL$ # Date: $Date$ # Source: $Source$ package CipUX::RBAC::Simple; use 5.008001; use strict; use warnings; use Carp; use CipUX::Task; use Class::Std; use Data::Dumper; use English qw( -no_match_vars); use Graph; use Graph::Directed; use Log::Log4perl qw(get_logger :levels); use Readonly; use base qw(CipUX); { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.0'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe # +======================================================================+ # || CONST || # +======================================================================+ Readonly::Scalar my $EMPTY_STRING => q{}; Readonly::Scalar my $SCRIPT => 'CipUX::RBAC::Simple'; # +======================================================================+ # || OBJECT || # +======================================================================+ # +======================================================================+ # || GLOBAL || # +======================================================================+ my $cipux = undef; my %cat_module = (); my %rpc_intern = (); my %task = (); # +======================================================================+ # || DESTRUCTOR || # +======================================================================+ sub DEMOLISH { # +------------------------------------------------------------------+ # | API my ( $self, $ident ) = @_; # +------------------------------------------------------------------+ # | main undef $cipux; undef %cat_module; undef %rpc_intern; undef %task; # +------------------------------------------------------------------+ # | API return; } # +======================================================================+ # || open module features || # +======================================================================+ # +======================================================================+ # || access_to_rpc_intern || # +======================================================================+ sub access_to_rpc_intern { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $user = exists $arg_r->{user} ? $self->l( $arg_r->{user} ) : $self->perr('user'); my $role = exists $arg_r->{role} ? $self->l( $arg_r->{role} ) : $self->perr('role'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $key = "$user $role"; $logger->debug(" key [$key]"); # +------------------------------------------------------------------+ # | API return $rpc_intern{$key} if exists $rpc_intern{$key}; $logger->debug(" key [$key] do not exist"); my $g = Graph::Directed->new; my $t3 = 'cipux_task_list_members_of_role_account'; my $a3 = 'memberUid'; $g->add_vertex($role); #my @user = $self->query( { #task => $t3, attr => $a3, object => $group #} ); my @user = query( $t3, $a3, $role ); foreach my $uid (@user) { $logger->debug("RBAC: user [$user]"); $g->add_vertex($uid); $g->add_edge( $role, $uid ); } my $tcg = $g->TransitiveClosure_Floyd_Warshall; # destination, source if ( $tcg->is_reachable( $role, $user ) ) { $logger->debug('1 rpc_intern access TRUE (1)'); $logger->debug('END'); $rpc_intern{$key} = 1; return 1; } else { $logger->debug('rpc_intern access FALSE (0)'); $logger->debug('END'); } $rpc_intern{$key} = 0; # +------------------------------------------------------------------+ # | API return 0; } # +======================================================================+ # || access_to_task || # +======================================================================+ sub access_to_task { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $task = exists $arg_r->{task} ? $self->l( $arg_r->{task} ) : $self->perr('task'); my $user = exists $arg_r->{user} ? $self->l( $arg_r->{user} ) : $self->perr('user'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $key = "$user $task"; $logger->debug(" key [$key]"); # +------------------------------------------------------------------+ # | API return $task{$key} if exists $task{$key}; $logger->debug(" key [$key] do not exist"); my $g = Graph::Directed->new; my $t1 = 'cipux_task_list_members_of_task'; my $t2 = 'cipux_task_list_members_of_cat_module'; my $t3 = 'cipux_task_list_members_of_role_account'; my $a1 = 'cipuxMemberPid'; my $a2 = 'cipuxMemberRid'; my $a3 = 'memberUid'; # my @cat = $self->query( { # task => $t1, attr => $a1, object => $task # } ); my @cat = query( $t1, $a1, $task ); my @group = (); $g->add_vertex($task); foreach my $module (@cat) { $logger->debug("RBAC: module [$module]"); $g->add_vertex($module); $g->add_edge( $task, $module ); #my @role = $self->query( { # task => $t2, attr => $a2, object => $module #} ); my @role = query( $t2, $a2, $module ); foreach my $group (@role) { $logger->debug("RBAC: group [$group]"); $g->add_vertex($group); $g->add_edge( $module, $group ); $g->add_vertex($group); #my @user = $self->query( { #task => $t3, attr => $a3, object => $group #} ); my @user = query( $t3, $a3, $group ); foreach my $uid (@user) { $logger->debug("RBAC: user [$user]"); $g->add_vertex($uid); $g->add_edge( $group, $uid ); } } } my $tcg = $g->TransitiveClosure_Floyd_Warshall; # destination, source if ( $tcg->is_reachable( $task, $user ) ) { $logger->debug('1 access TRUE (1)'); $logger->debug('END'); $task{$key} = 1; return 1; } else { $logger->debug('access FALSE (0)'); $logger->debug('END'); } $task{$key} = 0; # +------------------------------------------------------------------+ # | API return 0; } # +======================================================================+ # || access_to_cat_module || # +======================================================================+ sub access_to_cat_module { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $cat_module = exists $arg_r->{cat_module} ? $self->l( $arg_r->{cat_module} ) : $self->perr('cat_module'); my $user = exists $arg_r->{user} ? $self->l( $arg_r->{user} ) : $self->perr('user'); # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); my $key = "$user $cat_module"; $logger->debug(" key [$key]"); # +------------------------------------------------------------------+ # | API return $cat_module{$key} if exists $cat_module{$key}; $logger->debug(" key [$key] do not exist"); my $g = Graph::Directed->new; my $t2 = 'cipux_task_list_members_of_cat_module'; my $t3 = 'cipux_task_list_members_of_role_account'; my $a2 = 'cipuxMemberRid'; my $a3 = 'memberUid'; $logger->debug("RBAC: module [$cat_module]"); $g->add_vertex($cat_module); my @role = query( $t2, $a2, $cat_module ); foreach my $group (@role) { $logger->debug("RBAC: group [$group]"); $g->add_vertex($group); $g->add_edge( $cat_module, $group ); $g->add_vertex($group); my @user = query( $t3, $a3, $group ); foreach my $uid (@user) { $logger->debug("RBAC: user [$user]"); $g->add_vertex($uid); $g->add_edge( $group, $uid ); } } my $tcg = $g->TransitiveClosure_Floyd_Warshall; # destination, source if ( $tcg->is_reachable( $cat_module, $user ) ) { $logger->debug('1 access cat_module TRUE (1)'); $logger->debug('END'); $cat_module{$key} = 1; return 1; } else { $logger->debug('access cat_module FALSE (0)'); $logger->debug('END'); } $cat_module{$key} = 0; # +------------------------------------------------------------------+ # | API return 0; } # +======================================================================+ # || query || # +======================================================================+ sub query { # +------------------------------------------------------------------+ # | API my $task = shift; my $attr = shift; my $object = shift; # +------------------------------------------------------------------+ # | main my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); $logger->debug('using task command'); # everything is packed we will start the journey my %mattrvalue = (); if ( defined $object ) { $logger->debug("exec task: $task -o $object"); } else { $logger->debug("exec task: $task"); } $cipux = CipUX::Task->new(); $logger->debug("cipux [$cipux]"); my $return_hr = $cipux->task( { script => $SCRIPT, task => $task, mode => 'cmd', object => $object, attr_hr => \%mattrvalue, } ); $logger->debug( 'TASK return_hr:', { filter => \&Dumper, value => $return_hr } ); my @answer = keys %{ $return_hr->{taskres_r} }; my @list = (); foreach my $a (@answer) { if ( exists $return_hr->{taskres_r} and defined $a and exists $return_hr->{taskres_r}->{$a} and defined $return_hr->{taskres_r}->{$a} and defined $attr and exists $return_hr->{taskres_r}->{$a}->{$attr} and defined $return_hr->{taskres_r}->{$a}->{$attr} and ref $return_hr->{taskres_r}->{$a}->{$attr} eq 'ARRAY' ) { push @list, @{ $return_hr->{taskres_r}->{$a}->{$attr} }; } } # +------------------------------------------------------------------+ # | API return @list; } # +======================================================================+ # || flush || # +======================================================================+ sub flush { my $logger = get_logger(__PACKAGE__); $logger->debug('BEGIN'); %cat_module = (); %rpc_intern = (); %task = (); $logger->debug('cache flushed'); $logger->debug('END'); my @cat_module_size = (); @cat_module_size = keys %cat_module; return 0 if scalar @cat_module_size > 0; undef @cat_module_size; my @rpc_intern_size = (); @rpc_intern_size = keys %rpc_intern; return 0 if scalar @rpc_intern_size > 0; undef @rpc_intern_size; my @task_size = (); @task_size = keys %task; return 0 if scalar @task_size > 0; undef @task_size; # +------------------------------------------------------------------+ # | API return 1; } # +======================================================================+ # || cat_module_cache_size || # +======================================================================+ sub cat_module_cache_size { my @size = keys %cat_module; my $size = scalar @size; undef @size; # +------------------------------------------------------------------+ # | API return $size; } # +======================================================================+ # || rpc_intern_cache_size || # +======================================================================+ sub rpc_intern_cache_size { my @size = keys %rpc_intern; my $size = scalar @size; undef @size; # +------------------------------------------------------------------+ # | API return $size; } # +======================================================================+ # || task_cache_size || # +======================================================================+ sub task_cache_size { my @size = keys %task; my $size = scalar @size; undef @size; # +------------------------------------------------------------------+ # | API return $size; } } # END INSIDE-OUT CLASS 1; __END__ =pod =for stopwords CipUX::RBAC::Simple RBAC CipUX RPC XML-RPC CipUX::RPC Kuelker destructor =head1 NAME CipUX::RBAC::Simple - RBAC class for CipUX =head1 VERSION version 3.4.0.0 =head1 SYNOPSIS use CipUX::RBAC::Simple; =head1 DESCRIPTION Provides functions for Role Based Access Control. =head1 ABSTRACT The CipUX RBAC Simple class provides services to CipUX XML-RPC (CipUX::RPC) server. =head1 CONFIGURATION AND ENVIRONMENT Not needed. =head1 DEPENDENCIES Carp CipUX CipUX::Task Class::Std Data::Dumper English Graph Graph::Directed Log::Log4perl Readonly version =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::RBAC::Simple. =head2 DEMOLISH destructor =head2 access_to_rpc_intern( { user=>$user, role=>$role } ) Return 1 on access 0 otherwise. =head2 access_to_task( { user=>$user, task=>$task } ) Return 1 on access 0 otherwise. =head2 access_to_cat_module( { user=>$user, cat_module=>$cat_module } ) Return 1 on access 0 otherwise. =head2 query( $task, $attr, $object ) Queries the storage layer and returns a Perl list as the answer from the task command. =head2 flush Flush the cat_module, rpc_intern, task cache. Returns 1 on success 0 if flushing of one cache fails. =head2 cat_module_cache_size Returns number of cache entries. =head2 rpc_intern_cache_size Returns number of cache entries. =head2 task_cache_size Returns number of cache entries. =head1 DIAGNOSTICS Do not have specific messages. It uses perr() from CipUX. See Perl Module CipUX for more information about perr(). =head2 perr(): I: user, role I: user, task I: user, cat_module =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS No bugs have been reported. =head1 SEE ALSO See the CipUX web page and the manual at L See the mailing list L =head1 AUTHOR Christian Kuelker Echristian.kuelker@cipworx.orgE =head1 LICENSE AND COPYRIGHT Copyright (C) 2009 by Christian Kuelker This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut CipUX-RBAC-Simple-3.4.0.0/MANIFEST0000444000175000017500000000032011165474541016126 0ustar ckuelkerckuelkerBuild.PL Changes lib/CipUX/RBAC/Simple.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/00-load.t t/leaktrace.t t/perlcritic.t t/perlcriticrc t/pod-coverage.t t/pod.t t/refcount.t META.yml CipUX-RBAC-Simple-3.4.0.0/MANIFEST.SKIP0000444000175000017500000000021711165474541016700 0ustar ckuelkerckuelker-stamp$ \.orig$ \.bak$ \.swp$ \.svn _build blib Build$ \.ptkdb$ .deb$ .build$ .changes$ .upload$ .asc$ .dsc$ .tar.gz$ .cvsignore debian/files$ CipUX-RBAC-Simple-3.4.0.0/Build.PL0000444000175000017500000000267011165474541016303 0ustar ckuelkerckuelkeruse strict; use warnings; use Module::Build::CipUX; my $builder = Module::Build::CipUX->new( module_name => 'CipUX::RBAC::Simple', license => 'gpl', dist_author => 'Christian Kuelker ', dist_version_from => 'lib/CipUX/RBAC/Simple.pm', # create_makefile_pl => 'traditional', # create_readme => 1, # verbose => 1, installdirs => 'vendor', meta_merge => { resources => { homepage => q(http://www.cipux.org), }, }, recommends => { 'File::Spec' => 0, 'Test::Perl::Critic' => 0, 'Test::Pod::Coverage' => '1.04', }, build_requires => { 'Test::LeakTrace' => 0, 'Module::Build::CipUX' => '0.3.0', 'Test::More' => 0, 'Test::Pod' => '1.14', 'Test::Refcount' => 0, }, requires => { 'Carp' => 0, 'CipUX' => '3.4.0.0', 'CipUX::Task' => '3.4.0.0', 'Class::Std' => '0.0.9', 'Data::Dumper' => 0, 'English' => 0, 'Graph' => 0, 'Graph::Directed' => 0, 'Log::Log4perl' => 0, 'Readonly' => 0, 'version' => 0, }, add_to_cleanup => ['CipUX-RBAC-Simple-*'], ); # BUILD target #$builder->do_create_readme(); #$builder->do_create_makefile_pl(); $builder->create_build_script(); CipUX-RBAC-Simple-3.4.0.0/Makefile.PL0000444000175000017500000000017111165474541016753 0ustar ckuelkerckuelkeruse Module::Build::Compat; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); CipUX-RBAC-Simple-3.4.0.0/README0000444000175000017500000000152411165474541015664 0ustar ckuelkerckuelkerCipUX-RBAC-Simple version 3.4.0.0 Simple form of Role Based Access Control - RBAC. CipUX-RBAC-Simple is used by the CipUX XML RPC server for authorization. INSTALLATION To install this module, preferably run the following commands: perl Build.PL ./Build ./Build test ./Build install Alternatively, to install with ExtUtils::MakeMaker, you can use the following commands: perl Makefile.PL make make test make install DEPENDENCIES Carp CipUX CipUX::Task Class::Std Data::Dumper English Graph Graph::Directed Log::Log4perl Readonly version COPYRIGHT AND LICENSE Copyright (C) 2009 by Christian Kuelker This library is licensed under the GNU GPL - GNU General Public License version 2 or (at your opinion) any later version.