CipUX-3.4.0.13000755001750001750 011506524062 13526 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/MANIFEST000444001750001750 176411506524062 15024 0ustar00ckuelkerckuelker000000000000bin/cipux_configuration Build.PL Changes doc/config/dit/dit_custom.mkd doc/config/dit/dit_debian_edu.mkd doc/config/dit/dit_default.mkd doc/config/dit/dit_overview.mkd doc/example/cipux_trait_list doc/example/readme.mkd doc/install/debian/catweb_deb_pkg_installation.mkd doc/install/debian/catweb_release_installation.mkd doc/install/debian/cipux_deb_pkg_installation.mkd doc/install/debian/cipux_debedu_pkg_installation.mkd doc/install/debian/cipux_release_installation.mkd doc/install/debian/openldap_deb_pkg_installation.mkd doc/install/installation_overview.mkd doc/install/readme.mkd doc/readme.mkd doc/testing/cipux_installation_testing.mkd etc/cipux/log4perl.conf lib/CipUX.pm lib/CipUX/Cfg/Client.pm lib/CipUX/Compat.pm lib/CipUX/Trait.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00.load.t t/10.init_tests.t t/20_trait.t t/50_date_epoch.t t/leaktrace.t t/perlcritic.t t/perlcritic_cpan.t t/perlcriticrc t/pod-coverage.t t/pod.t t/refcount.t usr/share/cipux/etc/cipux.ini CipUX-3.4.0.13/Build.PL000444001750001750 331011506524062 15154 0ustar00ckuelkerckuelker000000000000use strict; use warnings; use Module::Build::CipUX; use version; our $VERSION = qv('3.4.0.13'); my $builder = Module::Build::CipUX->new( module_name => 'CipUX', license => 'gpl2', dist_author => 'Christian Kuelker ', dist_version => $VERSION, dist_abstract => 'CipUX Utility library', # create_makefile_pl => 'traditional', # create_readme => 1, installdirs => 'vendor', meta_merge => { resources => { homepage => q(http://www.cipux.org), }, }, recommends => { 'Test::Perl::Critic' => 0, 'Pod::Spell' => 0, 'Readonly::XS' => 0, }, build_requires => { 'Test::LeakTrace' => 0, 'Test::More' => 0, 'Test::Pod' => '1.14', 'Test::Pod::Coverage' => '1.04', 'Test::Refcount' => 0, 'Module::Build::CipUX' => '0.3.0', }, requires => { 'Array::Unique' => 0, 'Carp' => 0, 'Class::Std' => '0.0.9', 'Config::Any' => '0.18', 'Config::Tiny' => 0, 'Data::Dumper' => 0, 'Date::Manip' => 0, 'Digest::MD5' => 0, 'English' => 0, 'File::Basename' => 0, 'File::Glob' => 0, 'File::Path' => 2.06, 'Hash::Merge' => '0.11', 'Log::Log4perl' => '0.42', 'Pod::Usage' => 0, 'Readonly' => 0, 'Storable' => 0, 'Term::ReadKey' => 0, 'Unicode::String' => 0, 'version' => 0, 'YAML::Any' => 0, }, add_to_cleanup => ['CipUX-*'], ); $builder->create_build_script(); CipUX-3.4.0.13/README000444001750001750 125211506524062 14543 0ustar00ckuelkerckuelker000000000000CipUX version 3.4.0.13 Common CipUX functions INSTALLATION To install this module, preferably run the following commands: perl Build.PL ./Build ./Build test ./Build install DEPENDENCIES Array::Unique Carp Class::Std Config::Any Config::Tiny Data::Dumper Date::Manip Digest::MD5 English File::Basename File::Glob File::Path Hash::Merge Log::Log4perl Pod::Usage Readonly Storable Term::ReadKey Unicode::String version YAML::Any COPYRIGHT AND LICENCE 2007 - 2010, Christian Kuelker 2010, Kurt Gramlich 2010, Erik Auerswald This library is licensed under the GNU GPL (General Public License) version 2 or later. CipUX-3.4.0.13/META.yml000444001750001750 241711506524062 15140 0ustar00ckuelkerckuelker000000000000--- abstract: 'CipUX Utility library' author: - 'Christian Kuelker ' build_requires: Module::Build::CipUX: v0.3.0 Test::LeakTrace: 0 Test::More: 0 Test::Pod: 1.14 Test::Pod::Coverage: 1.04 Test::Refcount: 0 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: gpl2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: CipUX provides: CipUX: file: lib/CipUX.pm version: v3.4.0.13 CipUX::Cfg::Client: file: lib/CipUX/Cfg/Client.pm version: v3.4.0.13 CipUX::Compat: file: lib/CipUX/Compat.pm version: v3.4.0.13 CipUX::Trait: file: lib/CipUX/Trait.pm version: v3.4.0.13 recommends: Pod::Spell: 0 Readonly::XS: 0 Test::Perl::Critic: 0 requires: Array::Unique: 0 Carp: 0 Class::Std: v0.0.9 Config::Any: 0.18 Config::Tiny: 0 Data::Dumper: 0 Date::Manip: 0 Digest::MD5: 0 English: 0 File::Basename: 0 File::Glob: 0 File::Path: 2.06 Hash::Merge: 0.11 Log::Log4perl: 0.42 Pod::Usage: 0 Readonly: 0 Storable: 0 Term::ReadKey: 0 Unicode::String: 0 YAML::Any: 0 version: 0 resources: homepage: http://www.cipux.org license: http://opensource.org/licenses/gpl-2.0.php version: v3.4.0.13 CipUX-3.4.0.13/Makefile.PL000444001750001750 17011506524062 15613 0ustar00ckuelkerckuelker000000000000use Module::Build::CipUX; Module::Build::Compat->run_build_pl(args => \@ARGV); Module::Build::Compat->write_makefile(); CipUX-3.4.0.13/Changes000444001750001750 1435011506524062 15201 0ustar00ckuelkerckuelker000000000000Revision history for CipUX 3.4.0.13 2010-12-29T12:05:31 - changes: * use Fiile::Path again in CipUX::Compat * minor bugfixes in CipUX::Compat - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.12 2010-12-29T10:43:21 - changes: * add CipUX::Compat for a transition to CipUX-3.6.0.x for usage through CipUX::RPC - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.11 2010-07-05T10:42:41 - changes: * new sub date_epoch to support sambaPwdLastSet in CipUX::Object::Action::Create * fix contribute list of last release * remove copyright from documentation (Jonas' hint) * new documentation about installing upstream release - contributors: Kurt Gramlich (doc, testing) Jonas Smedegaard (hints on copyright) Christian Kuelker - version created by: Christian Kuelker 3.4.0.10 2010-07-04T10:18:42 - changes: * add CipUX install and testing documentation - contributors: Kurt Gramlich Christian Kuelker Erik Auerswald - version created by: Christian Kuelker 3.4.0.9 2010-03-06T22:45:52 - changes: * Fixes Perl::Critic "return" statement followed by "sort" in Trait.pm * postpone 2 tests until 3rd party plugin registration works - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.8 2010-01-23T22:35:37 - changes: * faster evaluate_config_space * cipux_configuration code moved to CipUX::Cfg::Client and cipux_configuration can now display Perl hash format * new sub get_trait for CipUX::Trait new sub get_trait for CipUX::Trait - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.7 2010-01-12T08:12:53 - changes: * reduce config file formats to .ini and .perl. Disabled .cnf .json .jsn .xml .yml .yaml .pl can be re-enabled if needed. (performance gain) * tighten dependency on Config::Any and Hash::Merge * tighten version of GPL to make META.yml happy * support for MD5 passwords * new CipUX::Trait feature * new CipUX::Trait example script - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.6 2010-01-02T09:17:41 - changes: * add colorized output for screen output * add dist_abstract to Build.PL * new dependency to Digest::MD5 * clean up debug msg of CipUX.pm * refactorize some code into 'iterate_config_space' and 'evaluate_config_space' for better maintenance and Perl::Critic improvements and to track changes of config space * fix typo in dependencies, POD::Spell -> Pod::Spell - contributors: Christian Kuelker - version created by: Christian Kuelker 3.4.0.5 2009-08-09T21:59:44 - changes: * add overwrite of cache dir location to sub 'cfg' and others * improve border case handling of $cache_dir - version created by: Christian Kuelker 3.4.0.4 2009-07-04T22:32:12 - changes: * remove indirect build dependency Module::Build * add new sub create_cache_dir_if_not_present * move location for cache from /tmp to /var/cache * drop chown root:root /tmp/cipux * drop chmod 0750 /tmp/cipux * add dependency to File::Path >2.05, >=2.06 * make cache dir a global costant - version created by: Christian Kuelker 3.4.0.3 2009-03-30T23:14:12 - changes: * use Storable to enhance performance significantly and to circumvent memory leakage of Hash::Merge and Config::Any - version created by: Christian Kuelker 3.4.0.2 2009-03-25T18:00:22 - changes: bin/cipux_configuration: * add configuration streaming of - supported extensions - storage configuration (if available) - object configuration (if available) - task configuration (if available) to cipux_configuration * add simple debug output for cipux_configuration lib/CipUX: * add 2 subroutines to handle the merge of the configuration space better (performance). The first one '_hash_merge_setup' will configure Hash::Merge and the second one '_merge_array' will use Array::Unique (new dependency) to merge also the arrays. * factorize sub l* and other heavy used sub to perform better tests: * add refcount test for returned object * add objectleak test to test if constructor leaks - version created by: Christian Kuelker 3.4.0.1 2009-02-19T17:15:15 - changes: Remove .conf extension support for configuration files. Extension conflicts with old format. Users can use .cnf format instead. - version created by: Christian Kuelker 3.4.0.0 2009-02-15T14:36:12 - version created by: Christian Kuelker 3.002016 2007-09-11T13:44:22 - version created by: Christian Kuelker 3.002015 Fri Jun 08 22:24:25 2007 - original version; created by h2xs 1.23 with options -v 3.002015 -XA -n LDAP CipUX-3.4.0.13/MANIFEST.SKIP000444001750001750 23411506524062 15540 0ustar00ckuelkerckuelker000000000000-stamp$ \.orig$ \.bak$ \.swp$ \.svn _build blib Build$ \.ptkdb$ .deb$ .build$ .changes$ .upload$ .asc$ .dsc$ .tar.gz$ .cvsignore debian/files$ ^MYMETA.yml$ CipUX-3.4.0.13/lib000755001750001750 011506524062 14274 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/lib/CipUX.pm000444001750001750 14777011506524062 16037 0ustar00ckuelkerckuelker000000000000# +==========================================================================+ # || CipUX || # || || # || Common CipUX functions || # || || # || Copyright (C) 2007 - 2009 by Christian Kuelker || # || || # || License: GNU GPL version 2 or any later version. || # || || # +==========================================================================+ # ID: $Id$ # Revision: $Revision$ # Head URL: $HeadURL$ # Date: $Date$ # Source: $Source$ package CipUX; use strict; use warnings; use utf8; use 5.008001; use Array::Unique; use Carp; use Class::Std; use Config::Any; use Data::Dumper; use Date::Manip; use Digest::MD5; use English qw( -no_match_vars); use File::Basename; use File::Glob; use File::Path qw(make_path); use Hash::Merge qw/merge/; use Log::Log4perl qw(:easy); use Pod::Usage; use Readonly; use Storable qw(store retrieve freeze thaw dclone); use Term::ReadKey; use Unicode::String; { # BEGIN CLASS use version; our $VERSION = qv('3.4.0.13'); 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 $DT => UnixDate( 'today', '%Y-%m-%dT%H:%M:%S' ); my $L = q{=================================================}; $L .= "$L\n"; Readonly::Scalar my $CFGBASE => 'cipux'; Readonly::Scalar my $PASSWD_LENGTH_START => 1; Readonly::Scalar my $PASSWD_LENGTH_END => 9; Readonly::Array my @PASSWD_CHARS => ( 'A' .. 'Z', 'a' .. 'z', 0 .. 9, qw(! @ $ % &) ); Readonly::Array my @MODSALT_CHARS => ( q{.}, q{/}, 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); Readonly::Scalar my $MODSALT_BASE => 64; Readonly::Scalar my $LINEWIDTH => 78; Readonly::Scalar my $STRICT_UMASK => oct 77; Readonly::Scalar my $CACHE_DIR => '/var/cache/cipux'; # +======================================================================+ # || GLOBAL || # +======================================================================+ ## no critic (ProhibitPackageVars) use vars qw($config_hr0 $config_hr1 $config_hr2); ## use critic my %mattrvalue = (); my %opt = (); my $str = "%s -> %s: %s\n"; my $exc_hr = { 'UNKNOWN' => 'Unknown exception! Please fix CipUX!', '1010' => sprintf( $str, 'a', 'b', 'c' ), '1015' => 'value of "scope" in methode should be "all" or "one"!', }; # +======================================================================+ # || open module features || # +======================================================================+ # +======================================================================+ # || linewidth || # +======================================================================+ sub get_linewidth { # +------------------------------------------------------------------+ # | API return $LINEWIDTH; } ## end sub get_linewidth # +======================================================================+ # || perr || # +======================================================================+ sub perr { # +------------------------------------------------------------------+ # | API my ( $self, $param, $oline ) = @_; if ( not defined $param ) { $param = 'UNKNOWN PARAMETER'; } my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 1; my $msg = "perr called by [$subroutine] with undef parameter! \n"; if ( not defined $param ) { $self->exc( { msg => $msg } ); } $msg = "perr called by [$subroutine] with unknown parameter! \n"; if ( $param eq 'UNKNOWN PARAMETER' ) { $self->exc( { msg => $msg } ); } chomp $param; $msg = "Missing parameter [$param] in function [$subroutine]! \n"; if ( defined $oline ) { $msg .= "You should look at line [$oline].\n"; } # TODO think about: (AdcMon!) # $self->exc( { msg => $msg } ) if $param <> 0; $self->exc( { msg => $msg } ); # +------------------------------------------------------------------+ # | API exit 1; } ## end sub perr # +======================================================================+ # || exc || # +======================================================================+ sub exc { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $nr = $arg_r->{nr} || 'UNKNOWN'; my $value = $arg_r->{value} || $EMPTY_STRING; my $msg = $arg_r->{msg} || $EMPTY_STRING; # +------------------------------------------------------------------+ # | main chomp $nr; chomp $value; my $txt = $nr ne 'UNKNOWN' ? $exc_hr->{$nr} : $msg ne $EMPTY_STRING ? $msg : 'UNKNOWN'; if ( $value ne $EMPTY_STRING ) { croak sprintf "%s (EXCEPTION) %s [%s]\n", $DT, $txt, $value; } else { croak sprintf "%s (EXCEPTION) %s\n", $DT, $txt; } # +------------------------------------------------------------------+ # | API return 1; } ## end sub exc # +======================================================================+ # || config || # +======================================================================+ # OLD config space, will be dropped in 3.4.2.x sub config { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $config_ar = exists $arg_r->{config_ar} ? $self->a( $arg_r->{config_ar} ) : $self->perr('config_ar'); # +------------------------------------------------------------------+ # | prepare my $logger = get_logger('CipUX'); my $config; # +------------------------------------------------------------------+ # | main foreach my $cfg ( @{$config_ar} ) { $config = $cfg; last if -e $cfg; } my ( $cfg0_hr, $cfg1_hr, $cfg2_hr ); # source conf file if ( $config and -e $config ) { ( $cfg0_hr, $cfg1_hr, $cfg2_hr ) = $self->source( { cfg => $config } ); } else { my $msg = 'Did not find any configuration file. '; $msg .= 'Last attempt was:'; $self->exc( { msg => $msg, value => $config } ); } my $msg = 'Variable not defined in configuration file. '; $msg .= 'Please provide a valid configuration file.'; if ( not defined $cfg0_hr ) { $self->exc( { msg => $msg, value => 'config_hr0' } ); } if ( not defined $cfg1_hr ) { $self->exc( { msg => $msg, value => 'config_hr1' } ); } if ( not defined $cfg1_hr ) { $self->exc( { msg => $msg, value => 'config_hr1' } ); } # +------------------------------------------------------------------+ # | API return ( $cfg0_hr, $cfg1_hr, $cfg2_hr ); } ## end sub config # +======================================================================+ # || source || # +======================================================================+ # OLD config space, will be dropped in 3.4.2.x sub source { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $cfg = $self->l( $arg_r->{cfg} ); # +------------------------------------------------------------------+ # | main my $logger = get_logger('CipUX'); $logger->debug( 'use configuration file: ', $cfg ); #$cfg = './' . $cfg if not $cfg =~ m%^/%; my ( $file, $dir ) = fileparse($cfg); $logger->debug( 'file: ', $file ); $logger->debug( 'dir: ', $dir ); # test if file is readable if ( not -r $cfg ) { $logger->debug( '-> file not readable!: ', $cfg ); $self->exc( { msg => '-> file not readable!', value => $cfg } ); } my $msg = "While processing conf. [$cfg], the file can not be"; if ( -e $cfg ) { if ( not my $r = do $cfg ) { # $r = return if ($EVAL_ERROR) { pod2usage( -msg => "$msg parsed! $@" ); } if ( not defined $r ) { pod2usage( -msg => "$msg sourced! $!" ); } if ( not $r ) { pod2usage( -msg => "$msg executed! $cfg" ); } } ## end if ( not my $r = do $cfg) } ## end if ( -e $cfg ) # +------------------------------------------------------------------+ # | API return $config_hr0, $config_hr1, $config_hr2; } ## end sub source # +======================================================================+ # ||store_mattrvalue || # +======================================================================+ sub store_mattrvalue { ## no critic (ProhibitManyArgs) # +------------------------------------------------------------------+ # | API my ( $self, $attr_hr, $opt_hr, $option, $key, $value ) = @_; return if not defined $option; my $logger = get_logger('CipUX'); $logger->debug( '> attr_hr: ', { filter => \&Dumper, value => $attr_hr } ); $logger->debug( '> opt_hr : ', { filter => \&Dumper, value => $opt_hr } ); $logger->debug( '> option : ', $option ); $logger->debug( '> key : ', $key ); $logger->debug( '> value : ', $value ); my $opt = $self->l($option); if ( ( $opt eq 'x' or $opt eq 'mattrvalue' ) and ( defined $key and defined $value ) ) { my $attr = $self->l($key); my $obj = $self->l($value); $logger->debug( 'attr: ', $attr ); $logger->debug( 'obj: ', $obj ); # store in $attr_hr push @{ $attr_hr->{$attr} }, $obj; $opt_hr->{x} = 1; $opt_hr->{mattrvalue} = 1; $logger->debug('end 1'); return $attr_hr; } ## end if ( ( $opt eq 'x' or ... $logger->debug('end 2'); return; } ## end sub store_mattrvalue # +======================================================================+ # ||store_attrvalue || # +======================================================================+ sub store_attrvalue { ## no critic (ProhibitManyArgs) # +------------------------------------------------------------------+ # | API my ( $self, $attr_hr, $opt_hr, $option, $key, $value ) = @_; return if not defined $option; my $logger = get_logger('CipUX'); $logger->debug( '> attr_hr: ', { filter => \&Dumper, value => $attr_hr } ); $logger->debug( '> opt_hr : ', { filter => \&Dumper, value => $opt_hr } ); $logger->debug( '> option : ', $option ); $logger->debug( '> key : ', $key ); $logger->debug( '> value : ', $value ); my $opt = $self->l($option); if ( ( $opt eq 'y' or $opt eq 'attrvalue' ) and defined $key ) { my $attr = $self->l($key); my $obj = defined $value ? $self->l($value) : undef; $logger->debug( 'attr: ', $attr ); if ( defined $obj ) { $logger->debug( 'obj: ', $obj ); } # store in $attr_hr push @{ $attr_hr->{$attr} }, $obj; $opt_hr->{y} = 1; $opt_hr->{attrvalue} = 1; $logger->debug('end 1'); return $attr_hr; } ## end if ( ( $opt eq 'y' or ... $logger->debug('end 2'); return; } ## end sub store_attrvalue # +======================================================================+ # || homedir || # +======================================================================+ sub homedir { # +------------------------------------------------------------------+ # | API my $self = shift; my $filename = shift; $filename =~ s{ ^ ~ ( [^/]* ) } { $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7] ) }exms; # +------------------------------------------------------------------+ # | API return $filename; } ## end sub homedir # +======================================================================+ # || lf || # +======================================================================+ # laundering LDAP filter sub lf { # +------------------------------------------------------------------+ # | API # example: &(cn=?)(objectClass=cipuxCatModule) my ( $self, $o ) = @_; return if not defined $o; my $x = undef; { # untaint data captured by parens tainted no re 'taint'; if ( $o =~ m{^([=-\?\(\)&\w.]+)$}smx ) { $x = $1; # data OK } elsif ( $o eq $EMPTY_STRING ) { $x = $EMPTY_STRING; } else { my $caller = caller; croak "Bad LDAP filter data [$o] at '$caller'\n"; } } undef $o; # +------------------------------------------------------------------+ # | API return $x; } ## end sub lf # laundering passwords sub lp { # +------------------------------------------------------------------+ # | API # example: &(cn=?)(objectClass=cipuxCatModule) my ( $self, $o ) = @_; return if not defined $o; my $x = undef; { # untaint data captured by parens tainted no re 'taint'; # if you change that, please also change # CipUX::CAT::Web sub cw_password #if ( $l =~ m{^([a-z0-9A-Z!#$%&=-_\@+*]+)$}smx ) { if ( $o =~ m{^([[:alnum:]!#$%&=-_\@+*]+)$}smx ) { $x = $1; # data OK } elsif ( $o eq $EMPTY_STRING ) { $x = $EMPTY_STRING; } else { my $caller = caller; croak "Bad password data [$o] at '$caller'\n"; } } undef $o; # +------------------------------------------------------------------+ # | API return $x; } ## end sub lp # laundering integer sub li { # +------------------------------------------------------------------+ # | API # example: &(cn=?)(objectClass=cipuxCatModule) my ( $self, $o ) = @_; return if not defined $o; my $x = undef; { # untaint data captured by parens tainted no re 'taint'; # if you change that, please also change # CipUX::CAT::Web sub cw_password if ( $o =~ m{^(\d+)$}smx ) { $x = $1; # data OK } elsif ( $o eq $EMPTY_STRING ) { $x = $EMPTY_STRING; } else { my $caller = caller; croak "Bad integer data [$o] at '$caller'\n"; } } undef $o; # +------------------------------------------------------------------+ # | API return $x; } ## end sub li # normal data sub l { # +------------------------------------------------------------------+ # | API #my ( $self, $arg_r ) = @_; my ( $self, $o ) = @_; return if not defined $o; my $x = undef; { # untaint data captured by parens tainted no re 'taint'; # if you change that, please also change # CipUX::CAT::Web sub cw_password # Allows: [ at the beginning (sambaAcctFlags) # ] at the end (sambaAcctFlags) # -:,_=/@.! and \w\s inbetween # * inbetween for CipUX::Storage <212> p{*} LDAP filter # % inbetween for message (%s) # ' inbetween for quoting # " inbetween for quoting # () inbetween for function name quoting # $ inbetween for Windows Machine Accounts # & inbetween for passwords if ( $o =~ m{^(\[*[*-:,=_/\@\s\w.\$"!'\&\(%\)]+\]*)$}smx ) { $x = $1; # data OK } elsif ( $o eq $EMPTY_STRING ) { $x = $EMPTY_STRING; } else { my $caller = caller; my $msg = 'A bad letter/character was found inside'; $msg .= " this input data [$o]. If you want to have"; $msg .= ' support for this input data, please contact'; $msg .= ' the mailing list cipux-devel' . q{@} . 'cipux.org'; $msg .= " The Problem was found at: $caller\n"; croak $msg; } } undef $o; # +------------------------------------------------------------------+ # | API return $x; } ## end sub l # +======================================================================+ # || h || # +======================================================================+ sub h { # +------------------------------------------------------------------+ # | API my ( $self, $h, $oline ) = @_; if ( not ref($h) eq 'HASH' ) { my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 1; my $type = ref $h; my $l = defined $h ? $self->l($h) : 'UNKNOWN HASH'; my $msg = 'The argument is not a HASH or a reference to one. '; $msg .= "h() called by [$subroutine] with wrong argument! "; if ( defined $oline ) { $msg .= "You should have a look at line [$oline] ..."; } $self->exc( { msg => $msg, value => $l } ); exit 1; } ## end else [ if ( ref($h) eq 'HASH') # +------------------------------------------------------------------+ # | API return $h; } ## end sub h # +======================================================================+ # || a || # +======================================================================+ sub a { # +------------------------------------------------------------------+ # | API my ( $self, $o, $oline ) = @_; if ( not ref($o) eq 'ARRAY' ) { my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 1; my $type = ref $o; my $l = defined $o ? $self->l($o) : 'UNKNOWN ARRAY'; my $msg = 'The argument is not an ARRAY or reference to one. '; $msg .= "a() called by [$subroutine] with wrong argument! "; if ( defined $oline ) { $msg .= "You should have a look at line [$oline] ..."; } $self->exc( { msg => $msg, value => $l } ); exit 1; } ## end else [ if ( ref($o) eq 'ARRAY') # +------------------------------------------------------------------+ # | API return $o; } ## end sub a # +======================================================================+ # || test_cli_option || # +======================================================================+ # common function for checking CLI logic # used by cipux_task_client # used by cipux_object_client # used by cipux_ldap_client sub test_cli_option { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $script = exists $arg_r->{script} ? $self->l( $arg_r->{script} ) : 'UNKONW SCRIPT'; my $opt_hr = exists $arg_r->{opt_hr} ? $self->h( $arg_r->{opt_hr} ) : $self->perr('opt_hr'); my $logic_hr = exists $arg_r->{logic_hr} ? $self->h( $arg_r->{logic_hr} ) : $self->perr('logic_hr'); # +------------------------------------------------------------------+ # | main my $logger = get_logger('CipUX'); $logger->debug( '> script: ', $script ); if ( defined $opt_hr ) { $logger->debug( '> opt_hr: ', { filter => \&Dumper, value => $opt_hr } ); } if ( defined $logic_hr ) { $logger->debug( '> logic_hr: ', { filter => \&Dumper, value => $logic_hr } ); } # test the given CLI options foreach my $s ( sort keys %{$logic_hr} ) { # we test only the actual running script next if $script ne $s; $logger->debug( 'will test: ', $s ); foreach my $line ( @{ $logic_hr->{$s}->{must} } ) { $logger->debug( 'line: ', $line ); my @s = split /=/smx, $line; my $croak_msg = '[' . join( '] or [', @s ) . ']'; my $must_have = 0; foreach my $m (@s) { $logger->debug( 'must have option: ', $m ); if ( exists $opt_hr->{$m} ) { $logger->debug(' OK (exists), '); } if ( defined $opt_hr->{$m} ) { $logger->debug(' (defined),'); } if ( exists $opt_hr->{$m} ) { $logger->debug( ' value: ', $opt_hr->{$m} ); } $logger->debug("\n"); if ( exists $opt_hr->{$m} ) { $must_have = 1; } } ## end foreach my $m (@s) if ( not $must_have ) { my $msg = "$L EXCEPTION: mandatory"; $msg .= " parameter $croak_msg missing!\n$L"; pod2usage( -verbose => 0, -msg => $msg ); croak $msg; } ## end if ( not $must_have ) } ## end foreach my $line ( @{ $logic_hr... foreach my $n ( @{ $logic_hr->{$s}->{not} } ) { $logger->debug( 'must not have option: ', $n ); if ( exists $opt_hr->{$n} ) { my $msg = "\n$L EXCEPTION: you should not provide option [$n]!\n$L"; pod2usage( -verbose => 0, -msg => $msg ); croak $msg; } else { my $msg = 'OK (we do not have option): '; if ( defined $n ) { $logger->debug( $msg, $n ); } else { $logger->debug( $msg, 'empty array ref' ); } } ## end else [ if ( exists $opt_hr->{... } ## end foreach my $n ( @{ $logic_hr... } ## end foreach my $s ( sort keys %... # +------------------------------------------------------------------+ # | API return; } ## end sub test_cli_option # +======================================================================+ # || date_time || # +======================================================================+ sub date_time { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $today = $arg_r->{today} || 0; my $return = $EMPTY_STRING; if ($today) { $return = UnixDate( 'today', '%Y-%m-%dT%H:%M:%S' ); } # +------------------------------------------------------------------+ # | API return $return; } ## end sub date_time # +======================================================================+ # || date_epoch || # +======================================================================+ sub date_epoch { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $today = $arg_r->{today} || 0; my $return = $EMPTY_STRING; if ($today eq '1') { $return = UnixDate( 'today', '%s' ); }elsif($today){ $return = UnixDate( ParseDate($today), '%s' ); } # +------------------------------------------------------------------+ # | API return $return; } ## end sub date_epoch # +======================================================================+ # || latin1_to_utf8 || # +======================================================================+ sub latin1_to_utf8 { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $latin1 = $arg_r->{latin1} || $EMPTY_STRING; # utf8 already is the default Unicode::String->stringify_as('utf8'); my $utf8 = Unicode::String::latin1($latin1); # +------------------------------------------------------------------+ # | API return $utf8; } ## end sub latin1_to_utf8 # +======================================================================+ # || login_prompt || # +======================================================================+ sub login_prompt { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $prompt = $self->l( $arg_r->{prompt} ) || 'Login: '; ReadMode('normal'); print $prompt or croak "Can not print prompt to STDOUT\n"; my $login = ReadLine 0; chomp $login; ReadMode('normal'); # +------------------------------------------------------------------+ # | API return $login; } ## end sub login_prompt # +======================================================================+ # || password_prompt || # +======================================================================+ sub password_prompt { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $prompt = $self->l( $arg_r->{prompt} ) || 'Password: '; ReadMode('noecho'); print $prompt or croak "Can not print promt to STDOUT\n"; my $password = ReadLine 0; chomp $password; print "\n" or croak "Can not print CR to STDOUT\n"; ReadMode('normal'); # +------------------------------------------------------------------+ # | API return $password; } ## end sub password_prompt # +======================================================================+ # || random_password || # +======================================================================+ sub random_password { # +------------------------------------------------------------------+ # | API # see cookbook, de <55> my @chars = @PASSWD_CHARS; my $password = join $EMPTY_STRING, @chars[ map { rand @chars } ( $PASSWD_LENGTH_START .. $PASSWD_LENGTH_END ) ]; # +------------------------------------------------------------------+ # | API return $password; } ## end sub random_password # +======================================================================+ # || hash_password || # +======================================================================+ sub hash_password { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $password = $self->l( $arg_r->{password} ) || $self->perr('password'); my $mode = $self->l( $arg_r->{mode} ) || $self->perr('mode'); my $l = get_logger(__PACKAGE__); if ( $mode eq 'crypt' ) { $l->debug("crypt|md5 mode eq [$mode]"); my $modsalt = join $EMPTY_STRING, @MODSALT_CHARS[ rand $MODSALT_BASE, rand $MODSALT_BASE ]; $l->debug("modsalt [$modsalt]"); $password = crypt $password, $modsalt; $l->debug("password [$password]"); } elsif ( $mode eq 'md5' ) { use Digest::MD5 qw(md5); my $ctx = Digest::MD5->new; $ctx->add($password); $password = encode_base64( '{MD5}' . $ctx->b64digest ); $l->debug("password [$password]"); #$self->exc( { msg => 'not supported', value => $mode } ); } else { $self->exc( { msg => 'unknown password hash mode', value => $mode } ); } # +------------------------------------------------------------------+ # | API return $password; # without prefix like {crypt} } ## end sub hash_password # +======================================================================+ # || min || # +======================================================================+ sub min { # +------------------------------------------------------------------+ # | API my ( $self, $x, $y ) = @_; if ( defined $x and defined $y ) { return $x < $y ? $x : $y; } else { return $x if defined $x; return $y if defined $y; } ## end else [ if ( defined $x and defined... # +------------------------------------------------------------------+ # | API return; } ## end sub min # +======================================================================+ # || max || # +======================================================================+ sub max { # +------------------------------------------------------------------+ # | API my ( $self, $x, $y ) = @_; if ( defined $x and defined $y ) { return $x > $y ? $x : $y; } else { return $x if defined $x; return $y if defined $y; } # +------------------------------------------------------------------+ # | API return; } ## end sub max sub out { # +------------------------------------------------------------------+ # | API my $self = shift; my $msg = shift; print $msg or croak 'Can not print to STDOUT!'; # +------------------------------------------------------------------+ # | API return; } sub _merge_array : PRIVATE { # +------------------------------------------------------------------+ # | API my $a_ar = shift; my $b_ar = shift; # +------------------------------------------------------------------+ # | main tie my @u, 'Array::Unique'; ## no critic (Miscellanea::ProhibitTies) @u = ( @{$b_ar}, @{$a_ar} ); undef $b_ar; undef $a_ar; # +------------------------------------------------------------------+ # | API return \@u; } # +======================================================================+ # || _hash_merge_setup || # +======================================================================+ sub _hash_merge_setup { # +------------------------------------------------------------------+ # | main # derived from: #Hash::Merge::set_behavior('RIGHT_PRECEDENT'); Hash::Merge::specify_behavior( { 'SCALAR' => { 'SCALAR' => sub { $_[1] }, 'ARRAY' => sub { [ $_[0], @{ $_[1] } ] }, 'HASH' => sub { $_[1] }, }, 'ARRAY' => { 'SCALAR' => sub { $_[1] }, # default: # 'ARRAY' => sub { [ @{ $_[0] }, @{ $_[1] } ] }, 'ARRAY' => sub { _merge_array( $_[0], $_[1] ) }, 'HASH' => sub { $_[1] }, }, 'HASH' => { 'SCALAR' => sub { $_[1] }, 'ARRAY' => sub { [ values %{ $_[0] }, @{ $_[1] } ] }, ## no critic (Subroutines::ProtectPrivateSubs) 'HASH' => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) }, }, }, 'ARRAY_SPLICE', ); # +------------------------------------------------------------------+ # | API return; } # +======================================================================+ # || cfg_ext || # +======================================================================+ sub cfg_ext { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; # OK: .cnf .json .jsn .xml .yml .yaml .ini .pl .perl ... # BAD: .conf #my @extension = grep { !m/conf/smx } @{ Config::Any->extensions }; my @extension = qw(ini perl); # reduced to used .ini and .perl # +------------------------------------------------------------------+ # | API return @extension; } # +======================================================================+ # || cfg || # +======================================================================+ # NEW config space, will be used after 3.4.0.0 sub cfg { # +------------------------------------------------------------------+ # | API my ( $self, $arg_r ) = @_; my $pkg = exists $arg_r->{pkg} ? $arg_r->{pkg} : 'cipux'; my $sub = exists $arg_r->{sub} ? $arg_r->{sub} : $EMPTY_STRING; my $cfg = exists $arg_r->{cfg} ? $arg_r->{cfg} : undef; # only one cfg my $cache_dir = ( exists $arg_r->{cache_dir} and defined $arg_r->{cache_dir} and $arg_r->{cache_dir} ne $EMPTY_STRING ) ? $self->l( $arg_r->{cache_dir} ) : $CACHE_DIR; # +------------------------------------------------------------------+ # | prepare my $logger = get_logger(__PACKAGE__); $logger->debug("pkg [$pkg]"); $logger->debug("sub [$sub]"); my $cfgbase = ( defined $pkg and $pkg and defined $sub and $sub and $sub ne $EMPTY_STRING ) ? "$pkg-$sub" : $pkg; $self->create_cache_dir_if_not_present( { cache_dir => $cache_dir } ); # determine cfg space quantity my $loadcfg_ar = $self->iterate_config_space( { cfg => $cfg, cfgbase => $cfgbase, } ); $logger->debug( 'loadcfg_ar: ', { filter => \&Dumper, value => $loadcfg_ar } ); # determine cfg space quality my $clean = $self->evaluate_config_space( { loadcfg_ar => $loadcfg_ar, cache_dir => $cache_dir, cfgbase => $cfgbase, } ); if ( -e "$cache_dir/$cfgbase.cache" and $clean and not defined $cfg ) { $logger->debug("use disk: $cache_dir/$cfgbase.cache"); my $cfg_hr = retrieve("$cache_dir/$cfgbase.cache") or croak "Can not load $cfgbase.cache in $cache_dir/$cfgbase.cache"; return $cfg_hr; } $logger->debug("use Config::Any $cfgbase"); # +------------------------------------------------------------------+ # | main my @loadcfg = @{$loadcfg_ar}; my $cfg_hr = Config::Any->load_files( { files => \@loadcfg, use_ext => 1, override => 1, flatten_to_hash => 1 } ); #$logger->debug( 'cfg_hr: ', # { filter => \&Dumper, value => $cfg_hr } ); $self->_hash_merge_setup(); #Hash::Merge::set_behavior( 'ARRAY_SPLICE' ); my $merged_hr = {}; foreach my $filename (@loadcfg) { $merged_hr = merge( $merged_hr, $cfg_hr->{$filename} ); } store( $merged_hr, "$cache_dir/$cfgbase.cache" ) or croak "Can not save $cfgbase in $cache_dir/$cfgbase"; # +------------------------------------------------------------------+ # | API return $merged_hr; } sub create_cache_dir_if_not_present { my ( $self, $arg_r ) = @_; my $cache_dir = ( exists $arg_r->{cache_dir} and defined $arg_r->{cache_dir} and $arg_r->{cache_dir} ne $EMPTY_STRING ) ? $self->l( $arg_r->{cache_dir} ) : $CACHE_DIR; if ( not -d $cache_dir ) { # mkdir $cache_dir # or croak "Can not crate $cache_dir $!"; my $umask = umask; umask $STRICT_UMASK; make_path( $cache_dir, { error => \my $err } ); umask $umask; if ( scalar @{$err} ) { for my $diag ( @{$err} ) { my ( $file, $message ) = %{$diag}; if ( $file eq $EMPTY_STRING ) { warn "general error: $message\n"; } else { warn "problem createing $file: $message\n"; } } } # chown 0, 0, $cache_dir # or croak 'Can not chown 0,0,$cache_dir'; # chmod 0700, $cache_dir # or croak 'Can not chmod 0700,$cache_dir'; } return; } sub iterate_config_space { my ( $self, $arg_r ) = @_; my $cfg = ( exists $arg_r->{cfg} ) ? $self->l( $arg_r->{cfg} ) : $self->perr('cfg'); my $cfgbase = ( exists $arg_r->{cfgbase} ) ? $self->l( $arg_r->{cfgbase} ) : $self->perr('cfgbase'); my $l = get_logger(__PACKAGE__); my @extension = $self->cfg_ext(); my @suffix = (); my @cfg_space = (); if ( defined $cfg ) { @cfg_space = ($cfg); $l->debug("add to config space [$cfg]"); } else { @suffix = ( "/usr/share/cipux/etc/$cfgbase.", "/usr/share/cipux/etc/$cfgbase.d/*.", "/etc/cipux/$cfgbase.", "/etc/cipux/$cfgbase.d/*.", "~/.cipux/$cfgbase.", ); foreach my $s (@suffix) { foreach my $e (@extension) { $l->debug("add to config space [$s$e]"); push @cfg_space, $s . $e; } } } my @filename = (); foreach my $g (@cfg_space) { $l->debug("glob [$g]"); my @f = sort glob $g; push @filename, @f; } my @loadcfg = (); foreach my $f (@filename) { $f = $self->l($f); if ( -e $f ) { $l->debug("add file [$f] to cfg space"); push @loadcfg, $f; } } return \@loadcfg; } sub evaluate_config_space { my ( $self, $arg_r ) = @_; my $loadcfg_ar = ( exists $arg_r->{loadcfg_ar} ) ? $self->a( $arg_r->{loadcfg_ar} ) : $self->perr('loadcfg_ar'); my $cache_dir = ( exists $arg_r->{cache_dir} ) ? $self->l( $arg_r->{cache_dir} ) : $self->perr('cache_dir'); my $cfgbase = ( exists $arg_r->{cfgbase} ) ? $self->l( $arg_r->{cfgbase} ) : $self->perr('cfgbase'); my $l = get_logger(__PACKAGE__); my $eval_dir = "$cache_dir/$cfgbase"; $self->create_cache_dir_if_not_present( { cache_dir => $eval_dir } ); my $dirty = 0; my %ndigest = (); my %odigest = (); foreach my $f ( @{$loadcfg_ar} ) { # /etc/cipux/cipux-cat-web.ini $l->debug("evaluate cfg file [$f]"); # calc md5 of cfg file open my $RF1, q{<}, $f or croak "Can not open $f for reading!"; binmode $RF1; $ndigest{$f} = Digest::MD5->new->addfile($RF1)->hexdigest; close $RF1 or croak "Unable to close $!"; #| cache_dir |cfgbase|name #/var/cache/cipux/cipux/3c9f65e4f1c5d05638f63da289e78eb3 my $fn = "$eval_dir/$ndigest{$f}"; $l->debug("evaluate md5 file [$fn]"); if ( -e $fn ) { # clean $l->debug("[$f] found to be clean"); } else { $l->debug("[$f] found to be dirty"); $dirty = 1; # overwrite with clean version open my $WF, q{>}, $fn or croak "Can not open $fn for writing!"; print {$WF} $ndigest{$f} or croak "print to [$fn] failed $1"; close $WF or croak "Unable to close $!"; } } return not $dirty; } } # END INSIDE-OUT CLASS 1; __END__ =pod =for stopwords CipUX Kuelker perr VARNAME API exc STDERR config getopt homedir lf LDAP lp li latin UTF UTF-8 login STDOUT TODO cfg =head1 NAME CipUX - Common CipUX functions =head1 VERSION version 3.4.0.13 =head1 SYNOPSIS use CipUX; my $cipux = $CipUX->new(); my $max = $cipux->max(5,6); Or use as base class: use base(CipUX); my $max = $self->max(5,6); =head1 DESCRIPTION Provides functions common to all CipUX classes and scripts. =head1 CONSTRUCTOR =head2 new Constructor my $cipux = CipUX->new(); =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX. =head2 get_linewidth Returns the CipUX line width. =head2 perr Prints an exception that variable name VARNAME was not used in subroutine API. This is used to discover internal programming errors. $cipux->perr(''); $cipux->perr('',''); Example: $cipux->perr('parameter_x'); $cipux->perr('parameter_x', 98); =head2 exc Prints a CipUX default exception on STDERR and exits. $self->exc({nr=>$nr, value=>$value, msg=>$msg }); =head2 config Central function to retrieve config space. my ($x_hr, $y_hr, $z_hr) = $self->config({config_ar=>$config_ar}); Local _config subroutine should be use to fill $config_ar Example: sub task_config { my $config_ar = []; push @{$config_ar}, '/home/dummmy/cipux-task.conf'; my ($x_hr, $y_hr, $z_hr) = $self->config({config_ar=>$config_ar}); return ($x_hr, $y_hr, $z_hr); } =head2 source Incorporates a config file. =head2 store_mattrvalue Helper function for multiple getopt parameter with values. =head2 store_attrvalue Helper function for single getopt parameter with value. =head2 homedir This is an auxiliary method replacing ~ with $ENV{HGOME}. B my $file1 = $common->homedir($file2); B if $file1 = ~/.cipux/cipux-object.conf and $ENV{HOME} = /root then file2 = /root/.cipux/cipux-object.conf =head2 lf Laundering LDAP filter. =head2 lp Laundering passwords. =head2 li Laundering integer values. =head2 l Laundering of a scalar my $scalar = $self->l($input); =head2 h Check if type is hash or hash reference. my $hash_hr = $self->a($input_hr); =head2 a Check if type is array or array reference. my $array_ar = $self->a($input_ar); =head2 test_cli_option Executes some basic test on command line option regarding a hash. =head2 date_time returns date time format of today =head2 latin1_to_utf8 Converts latin to UTF-8 encoding. =head2 login_prompt Prints a login prompt on STDOUT. =head2 password_prompt Prints a password prompt on STDOUT. =head2 random_password Calculates and returns a relatively random password. =head2 hash_password Calculates and returns a hashed password. =head2 min Calculate the minimum of two integer values. =head2 max Calculate the maximum of two integer values. =head2 out Prints content to STDOUT. =head2 _merge_array Helper subroutine for _hash_merge_setup. It uses Array::Unique to return a merged unique array reference. =head2 _hash_merge_setup Perform setup for Hash::Merge. The main change is that Arrays are also merged with uniq values. =head2 cfg_ext Gets all supported extensions from Config::Any and remove non supported extensions. =head2 cfg Query the CipUX config space to load configuration in various formats. 0. Set cfgbase to "cipux" (+ "-$submodule" if not core module) 1. Set cfgpaths to...: 1. /usr/share/cipux/etc/$cfgbase.$ext 2. /usr/share/cipux/etc/$cfgbase.d/*.$ext 3. /etc/cipux/$cfgbase.$ext 4. /etc/cipux/$cfgbase.d/*.$ext 5. ~/.cipux/$cfgbase.$ext 2. Possible $ext are: cnf .conf .json .jsn .xml .yml .yaml .ini .pl .perl #3. Optionally parse and validate uppercase "$cfgbase_cfg" environment variable [fail if validation fails] #4. Optionally parse and validate "cfg" commandline option [fail if validation fails] 5. Resolve configfile list as cfgpaths, with "$cfgbase_cfg" and "cfg" appended if there 6. Resolve bootstrap file through parsing and validating "bootstrap" option from all available files in cfgpaths, later declaration overriding earlier ones 7. Resolve all options through executing bootstrap file #8. Optionally override subset of options through parsing and validating environment variables starting with uppercase "$cfgbase_" [fail if any validation fails] 9. Optionally override subset of options through parsing and validating all options from all available files in cfgpaths [fail if any validation fails] Notes about the above: * Number with leading "#" are not implemented. * config files are "layered", allowing overrides. Personal configfile is included last, not first, and more locations are supported. #* (subset of) options can be provided through ENV #* commandline and environment options are validated as part of parsing Recommendation: Even if several formats are supported, that does not mean they are all suited for this task. * Some configuration formats for example are too simple to express the complex cipux-task.perl configuration. * The CPAN Perl modules used for this configuration space are rather young Config::Any 2006 - 2009, Hash::Merge 2001 - 2009 and not every configuration file type mixture was tested. As a recommendation, you should not mix to many files and formats. =head2 create_cache_dir_if_not_present Creates a directory 'cipux' under /var/cache if not present. This is used to store serialized objects. =head2 iterate_config_space Takes a single config file $cfg (can be undef, but must be present) and a string representing the configuration base $cfgbase. It will then just use $cfg or it will find out regarding to $cfgbase what files should be considered. my $loadcfg_ar = $self->iterate_config_space( { cfg => $cfg, cfgbase => $cfgbase, } ); returns a list of all configuration files which should be evaluated. =head2 evaluate_config_space Takes a araay ref to a list of configuration files $loadcfg_ar, preferably cunstructed by iterate_config_space. It also taks a string $cache_dir to the temporary location of a cache_dir. This value can be empty but not undef and has to be provided. It also require the $cfgbase string, the "domain" of the configuration. It will calculate for every config file the MD5sum for later comparison. my $clean = $self->evaluate_config_space( { loadcfg_ar => $loadcfg_ar, cache_dir => $cache_dir, cfgbase => $cfgbase, } ); It will return 0 if changed files are found and 1 if no changed files are found. =head1 DIAGNOSTICS This module generates the following exceptions: TODO =head1 CONFIGURATION AND ENVIRONMENT Not applicable. =head1 DEPENDENCIES Array::Unique Carp Class::Std Config::Any Data::Dumper Date::Manip English File::Basename File::Glob File::Path Hash::Merge Log::Log4perl Pod::Usage Readonly Storable Term::ReadKey Unicode::String version =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =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) 2007 - 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 =cut CipUX-3.4.0.13/lib/CipUX000755001750001750 011506524062 15264 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/lib/CipUX/Compat.pm000444001750001750 4147411506524062 17234 0ustar00ckuelkerckuelker000000000000package CipUX::Compat; use strict; use warnings; #use Array::Unique; use Carp; #use Class::Std; use Config::Any; use Data::Dumper; use Date::Manip; #use Digest::MD5; #use English qw( -no_match_vars); #use File::Basename; #use File::Glob; use File::Path qw(make_path); use Hash::Merge qw/merge/; use Log::Log4perl qw(:easy); #use Pod::Usage; use Readonly; use Storable qw(store retrieve freeze thaw dclone); use Term::ReadKey; #use Unicode::String; use version; our $VERSION = qv('3.4.0.13'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe Readonly::Scalar my $EMPTY_STRING => q{}; Readonly::Scalar my $DT => UnixDate( 'today', '%Y-%m-%dT%H:%M:%S' ); my $L = q{=================================================}; $L .= "$L\n"; Readonly::Scalar my $PASSWD_LENGTH_START => 1; Readonly::Scalar my $PASSWD_LENGTH_END => 9; Readonly::Array my @PASSWD_CHARS => ( 'A' .. 'Z', 'a' .. 'z', 0 .. 9, qw(! @ $ % &) ); Readonly::Array my @MODSALT_CHARS => ( q{.}, q{/}, 0 .. 9, 'A' .. 'Z', 'a' .. 'z' ); Readonly::Scalar my $MODSALT_BASE => 64; Readonly::Scalar my $STRICT_UMASK => oct 77; Readonly::Scalar my $CACHE_DIR => '/var/cache/cipux'; my %opt = (); my $str = "%s -> %s: %s\n"; my $exc_hr = { 'UNKNOWN' => 'Unknown exception! Please fix CipUX!', '1010' => sprintf( $str, 'a', 'b', 'c' ), '1015' => 'value of "scope" in methode should be "all" or "one"!', }; sub perr { my ( $s, $param, $oline ) = @_; if ( not defined $param ) { $param = 'UNKNOWN PARAMETER'; } my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 1; my $msg = "perr called by [$subroutine] with undef parameter! \n"; if ( not defined $param ) { $s->exc( { msg => $msg } ); } $msg = "perr called by [$subroutine] with unknown parameter! \n"; if ( $param eq 'UNKNOWN PARAMETER' ) { $s->exc( { msg => $msg } ); } chomp $param; $msg = "Missing parameter [$param] in function [$subroutine]! \n"; if ( defined $oline ) { $msg .= "You should look at line [$oline].\n"; } $s->exc( { msg => $msg } ); exit 1; } sub exc { my ( $s, $arg_r ) = @_; my $nr = $arg_r->{nr} || 'UNKNOWN'; my $value = $arg_r->{value} || $EMPTY_STRING; my $msg = $arg_r->{msg} || $EMPTY_STRING; chomp $nr; chomp $value; my $txt = $nr ne 'UNKNOWN' ? $exc_hr->{$nr} : $msg ne $EMPTY_STRING ? $msg : 'UNKNOWN'; if ( $value ne $EMPTY_STRING ) { croak sprintf "%s (EXCEPTION) %s [%s]\n", $DT, $txt, $value; } else { croak sprintf "%s (EXCEPTION) %s\n", $DT, $txt; } return 1; } sub l { my ( $s, $o ) = @_; return if not defined $o; my $x = undef; { # untaint data captured by parens tainted no re 'taint'; # if you change that, please also change # CipUX::CAT::Web sub cw_password # Allows: [ at the beginning (sambaAcctFlags) # ] at the end (sambaAcctFlags) # -:,_=/@.! and \w\s inbetween # * inbetween for CipUX::Storage <212> p{*} LDAP filter # % inbetween for message (%s) # ' inbetween for quoting # " inbetween for quoting # () inbetween for function name quoting # $ inbetween for Windows Machine Accounts # & inbetween for passwords if ( $o =~ m{^(\[*[*-:,=_/\@\s\w.\$"!'\&\(%\)]+\]*)$}smx ) { $x = $1; # data OK } elsif ( $o eq $EMPTY_STRING ) { $x = $EMPTY_STRING; } else { my $caller = caller; my $msg = 'A bad letter/character was found inside'; $msg .= " this input data [$o]. If you want to have"; $msg .= ' support for this input data, please contact'; $msg .= ' the mailing list cipux-devel' . q{@} . 'cipux.org'; $msg .= " The Problem was found at: $caller\n"; croak $msg; } } undef $o; return $x; } sub h { my ( $s, $h, $oline ) = @_; if ( not ref($h) eq 'HASH' ) { my ( $package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask ) = caller 1; my $type = ref $h; my $l = defined $h ? $s->l($h) : 'UNKNOWN HASH'; my $msg = 'The argument is not a HASH or a reference to one. '; $msg .= "h() called by [$subroutine] with wrong argument! "; if ( defined $oline ) { $msg .= "You should have a look at line [$oline] ..."; } $s->exc( { msg => $msg, value => $l } ); exit 1; } ## end else [ if ( ref($h) eq 'HASH') return $h; } # common function for checking CLI logic # used by cipux_task_client # used by cipux_object_client # used by cipux_ldap_client sub test_cli_option { my ( $s, $arg_r ) = @_; my $script = exists $arg_r->{script} ? $s->l( $arg_r->{script} ) : 'UNKONW SCRIPT'; my $opt_hr = exists $arg_r->{opt_hr} ? $s->h( $arg_r->{opt_hr} ) : $s->perr('opt_hr'); my $logic_hr = exists $arg_r->{logic_hr} ? $s->h( $arg_r->{logic_hr} ) : $s->perr('logic_hr'); my $logger = get_logger('CipUX'); $logger->debug( '> script: ', $script ); if ( defined $opt_hr ) { $logger->debug( '> opt_hr: ', { filter => \&Dumper, value => $opt_hr } ); } if ( defined $logic_hr ) { $logger->debug( '> logic_hr: ', { filter => \&Dumper, value => $logic_hr } ); } # test the given CLI options foreach my $s ( sort keys %{$logic_hr} ) { # we test only the actual running script next if $script ne $s; $logger->debug( 'will test: ', $s ); foreach my $line ( @{ $logic_hr->{$s}->{must} } ) { $logger->debug( 'line: ', $line ); my @s = split /=/smx, $line; my $croak_msg = '[' . join( '] or [', @s ) . ']'; my $must_have = 0; foreach my $m (@s) { $logger->debug( 'must have option: ', $m ); if ( exists $opt_hr->{$m} ) { $logger->debug(' OK (exists), '); } if ( defined $opt_hr->{$m} ) { $logger->debug(' (defined),'); } if ( exists $opt_hr->{$m} ) { $logger->debug( ' value: ', $opt_hr->{$m} ); } $logger->debug("\n"); if ( exists $opt_hr->{$m} ) { $must_have = 1; } } ## end foreach my $m (@s) if ( not $must_have ) { my $msg = "$L EXCEPTION: mandatory"; $msg .= " parameter $croak_msg missing!\n$L"; pod2usage( -verbose => 0, -msg => $msg ); croak $msg; } ## end if ( not $must_have ) } ## end foreach my $line ( @{ $logic_hr... foreach my $n ( @{ $logic_hr->{$s}->{not} } ) { $logger->debug( 'must not have option: ', $n ); if ( exists $opt_hr->{$n} ) { my $msg = "\n$L EXCEPTION: you should not provide option [$n]!\n$L"; pod2usage( -verbose => 0, -msg => $msg ); croak $msg; } else { my $msg = 'OK (we do not have option): '; if ( defined $n ) { $logger->debug( $msg, $n ); } else { $logger->debug( $msg, 'empty array ref' ); } } ## end else [ if ( exists $opt_hr->{... } ## end foreach my $n ( @{ $logic_hr... } ## end foreach my $s ( sort keys %... return; } sub login_prompt { my ( $s, $arg_r ) = @_; my $prompt = $s->l( $arg_r->{prompt} ) || 'Login: '; ReadMode('normal'); print $prompt or croak "Can not print prompt to STDOUT\n"; my $login = ReadLine 0; chomp $login; ReadMode('normal'); return $login; } sub password_prompt { my ( $s, $arg_r ) = @_; my $prompt = $s->l( $arg_r->{prompt} ) || 'Password: '; ReadMode('noecho'); print $prompt or croak "Can not print promt to STDOUT\n"; my $password = ReadLine 0; chomp $password; print "\n" or croak "Can not print CR to STDOUT\n"; ReadMode('normal'); return $password; } sub random_password { my @chars = @PASSWD_CHARS; my $password = join $EMPTY_STRING, @chars[ map { rand @chars } ( $PASSWD_LENGTH_START .. $PASSWD_LENGTH_END ) ]; return $password; } sub out { my $s = shift; my $msg = shift; print $msg or croak 'Can not print to STDOUT!'; return; } sub _merge_array { my $a_ar = shift; my $b_ar = shift; tie my @u, 'Array::Unique'; ## no critic (Miscellanea::ProhibitTies) @u = ( @{$b_ar}, @{$a_ar} ); undef $b_ar; undef $a_ar; return \@u; } sub _hash_merge_setup { Hash::Merge::specify_behavior( { 'SCALAR' => { 'SCALAR' => sub { $_[1] }, 'ARRAY' => sub { [ $_[0], @{ $_[1] } ] }, 'HASH' => sub { $_[1] }, }, 'ARRAY' => { 'SCALAR' => sub { $_[1] }, # default: # 'ARRAY' => sub { [ @{ $_[0] }, @{ $_[1] } ] }, 'ARRAY' => sub { _merge_array( $_[0], $_[1] ) }, 'HASH' => sub { $_[1] }, }, 'HASH' => { 'SCALAR' => sub { $_[1] }, 'ARRAY' => sub { [ values %{ $_[0] }, @{ $_[1] } ] }, ## no critic (Subroutines::ProtectPrivateSubs) 'HASH' => sub { Hash::Merge::_merge_hashes( $_[0], $_[1] ) }, }, }, 'ARRAY_SPLICE', ); return; } sub cng_ext { my ( $s, $arg_r ) = @_; # OK: .cnf .json .jsn .xml .yml .yaml .ini .pl .perl ... # BAD: .conf #my @extension = grep { !m/conf/smx } @{ Config::Any->extensions }; my @extension = qw(ini perl); # reduced to used .ini and .perl return @extension; } sub cfg { my ( $s, $arg_r ) = @_; my $pkg = exists $arg_r->{pkg} ? $arg_r->{pkg} : 'cipux'; my $sub = exists $arg_r->{sub} ? $arg_r->{sub} : $EMPTY_STRING; my $cfg = exists $arg_r->{cfg} ? $arg_r->{cfg} : undef; # only one cfg my $cache_dir = ( exists $arg_r->{cache_dir} and defined $arg_r->{cache_dir} and $arg_r->{cache_dir} ne $EMPTY_STRING ) ? $s->l( $arg_r->{cache_dir} ) : $CACHE_DIR; my $logger = get_logger(__PACKAGE__); $logger->debug("pkg [$pkg]"); $logger->debug("sub [$sub]"); my $cfgbase = ( defined $pkg and $pkg and defined $sub and $sub and $sub ne $EMPTY_STRING ) ? "$pkg-$sub" : $pkg; $s->create_cache_dir_if_not_present( { cache_dir => $cache_dir } ); # determine cfg space quantity my $loadcfg_ar = $s->iterate_config_space( { cfg => $cfg, cfgbase => $cfgbase, } ); $logger->debug( 'loadcfg_ar: ', { filter => \&Dumper, value => $loadcfg_ar } ); # determine cfg space quality my $clean = $s->evaluate_config_space( { loadcfg_ar => $loadcfg_ar, cache_dir => $cache_dir, cfgbase => $cfgbase, } ); if ( -e "$cache_dir/$cfgbase.cache" and $clean and not defined $cfg ) { $logger->debug("use disk: $cache_dir/$cfgbase.cache"); my $cfg_hr = retrieve("$cache_dir/$cfgbase.cache") or croak "Can not load $cfgbase.cache in $cache_dir/$cfgbase.cache"; return $cfg_hr; } $logger->debug("use Config::Any $cfgbase"); my @loadcfg = @{$loadcfg_ar}; my $cfg_hr = Config::Any->load_files( { files => \@loadcfg, use_ext => 1, override => 1, flatten_to_hash => 1 } ); #$logger->debug( 'cfg_hr: ', # { filter => \&Dumper, value => $cfg_hr } ); $s->_hash_merge_setup(); #Hash::Merge::set_behavior( 'ARRAY_SPLICE' ); my $merged_hr = {}; foreach my $filename (@loadcfg) { $merged_hr = merge( $merged_hr, $cfg_hr->{$filename} ); } store( $merged_hr, "$cache_dir/$cfgbase.cache" ) or croak "Can not save $cfgbase in $cache_dir/$cfgbase"; return $merged_hr; } sub create_cache_dir_if_not_present { my ( $s, $arg_r ) = @_; my $cache_dir = ( exists $arg_r->{cache_dir} and defined $arg_r->{cache_dir} and $arg_r->{cache_dir} ne $EMPTY_STRING ) ? $s->l( $arg_r->{cache_dir} ) : $CACHE_DIR; if ( not -d $cache_dir ) { # mkdir $cache_dir # or croak "Can not crate $cache_dir $!"; my $umask = umask; umask $STRICT_UMASK; make_path( $cache_dir, { error => \my $err } ); umask $umask; if ( scalar @{$err} ) { for my $diag ( @{$err} ) { my ( $file, $message ) = %{$diag}; if ( $file eq $EMPTY_STRING ) { warn "general error: $message\n"; } else { warn "problem createing $file: $message\n"; } } } # chown 0, 0, $cache_dir # or croak 'Can not chown 0,0,$cache_dir'; # chmod 0700, $cache_dir # or croak 'Can not chmod 0700,$cache_dir'; } return; } sub iterate_config_space { my ( $s, $arg_r ) = @_; my $cfg = ( exists $arg_r->{cfg} ) ? $s->l( $arg_r->{cfg} ) : $s->perr('cfg'); my $cfgbase = ( exists $arg_r->{cfgbase} ) ? $s->l( $arg_r->{cfgbase} ) : $s->perr('cfgbase'); my $l = get_logger(__PACKAGE__); my @extension = qw(ini perl); my @suffix = (); my @cfg_space = (); if ( defined $cfg ) { @cfg_space = ($cfg); $l->debug("add to config space [$cfg]"); } else { @suffix = ( "/usr/share/cipux/etc/$cfgbase.", "/usr/share/cipux/etc/$cfgbase.d/*.", "/etc/cipux/$cfgbase.", "/etc/cipux/$cfgbase.d/*.", "~/.cipux/$cfgbase.", ); foreach my $s (@suffix) { foreach my $e (@extension) { $l->debug("add to config space [$s$e]"); push @cfg_space, $s . $e; } } } my @filename = (); foreach my $g (@cfg_space) { $l->debug("glob [$g]"); my @f = sort glob $g; push @filename, @f; } my @loadcfg = (); foreach my $f (@filename) { $f = $s->l($f); if ( -e $f ) { $l->debug("add file [$f] to cfg space"); push @loadcfg, $f; } } return \@loadcfg; } sub evaluate_config_space { my ( $s, $arg_r ) = @_; my $loadcfg_ar = ( exists $arg_r->{loadcfg_ar} ) ? $arg_r->{loadcfg_ar} : $s->perr('loadcfg_ar'); my $cache_dir = ( exists $arg_r->{cache_dir} ) ? $s->l( $arg_r->{cache_dir} ) : $s->perr('cache_dir'); my $cfgbase = ( exists $arg_r->{cfgbase} ) ? $s->l( $arg_r->{cfgbase} ) : $s->perr('cfgbase'); my $l = get_logger(__PACKAGE__); my $eval_dir = "$cache_dir/$cfgbase"; $s->create_cache_dir_if_not_present( { cache_dir => $eval_dir } ); my $dirty = 0; my %ndigest = (); my %odigest = (); foreach my $f ( @{$loadcfg_ar} ) { # /etc/cipux/cipux-cat-web.ini $l->debug("evaluate cfg file [$f]"); # calc md5 of cfg file open my $RF1, q{<}, $f or croak "Can not open $f for reading!"; binmode $RF1; $ndigest{$f} = Digest::MD5->new->addfile($RF1)->hexdigest; close $RF1 or croak "Unable to close $!"; #| cache_dir |cfgbase|name #/var/cache/cipux/cipux/3c9f65e4f1c5d05638f63da289e78eb3 my $fn = "$eval_dir/$ndigest{$f}"; $l->debug("evaluate md5 file [$fn]"); if ( -e $fn ) { # clean $l->debug("[$f] found to be clean"); } else { $l->debug("[$f] found to be dirty"); $dirty = 1; # overwrite with clean version open my $WF, q{>}, $fn or croak "Can not open $fn for writing!"; print {$WF} $ndigest{$f} or croak "print to [$fn] failed $1"; close $WF or croak "Unable to close $!"; } } return not $dirty; } 1; CipUX-3.4.0.13/lib/CipUX/Trait.pm000444001750001750 652011506524062 17045 0ustar00ckuelkerckuelker000000000000package CipUX::Trait; use warnings; use strict; use Class::Std; use English qw( -no_match_vars); use Module::Pluggable search_path => ['CipUX::Trait'], instantiate => 'new', sub_name => 'register'; use Readonly; use base qw(CipUX); { use version; our $VERSION = qv('3.4.0.13'); use re 'taint'; # Keep data captured by parens tainted delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer # CONST Readonly::Scalar my $EMPTY_STRING => q{}; # GLOBAL my $trait_name_register_hr = {}; # METHOD sub init { my $self = shift; foreach my $trait ( $self->register ) { next until $trait->can('register'); $trait->register(); } return 1; } # set a feature name and class sub set_trait_name_register { my ( $self, $arg_r ) = @_; my $class = exists $arg_r->{class} ? $self->l( $arg_r->{class} ) : $self->perr('class'); my $name = exists $arg_r->{name} ? $self->l( $arg_r->{name} ) : $self->perr('name'); $trait_name_register_hr->{$name} = $class; return 1; } # returns Perl module name for registered names sub get_trait_name_register { if (wantarray) { return keys %{$trait_name_register_hr}; } return $trait_name_register_hr; } sub get_trait { my @t = sort keys %{$trait_name_register_hr}; return @t; } } 1; __END__ =pod =for stopwords CipUX Kuelker perr VARNAME API exc STDERR config getopt homedir lf LDAP lp li latin UTF UTF-8 login STDOUT TODO cfg =head1 NAME CipUX::Trait - Common CipUX functions =head1 VERSION version 3.4.0.13 =head1 SYNOPSIS use CipUX::Trait; my $ trait = $CipUX::Trait->new; =head1 DESCRIPTION Provides feature plugins. =head1 CONSTRUCTOR =head2 new Constructor my $trait = CipUX::Trait->new; =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Trait. =head2 init =head2 set_trait_name_register =head2 get_trait_name_register =head2 get_trait =head1 DIAGNOSTICS This module generates no exception by itself. =head1 CONFIGURATION AND ENVIRONMENT Not applicable. =head1 DEPENDENCIES CipUX Class::Std English Module::PLuggable; Readonly version =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =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) 2010 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 =cut CipUX-3.4.0.13/lib/CipUX/Cfg000755001750001750 011506524062 15763 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/lib/CipUX/Cfg/Client.pm000444001750001750 2043211506524062 17715 0ustar00ckuelkerckuelker000000000000package CipUX::Cfg::Client; use strict; use warnings; use Carp; use Class::Std; use Data::Dumper; use English qw( -no_match_vars ); use Getopt::Long; use Log::Log4perl qw(get_logger :levels); use Pod::Usage; use YAML::Any; use base qw(CipUX); { use version; our $VERSION = qv('3.4.0.13'); delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # CONST Readonly::Scalar my $EMPTY_STRING => q{}; # GLOBAL my %opt = (); my $cfg_space_dispatch_hr = { all => \&all_cfg, cipux => \&cipux_cfg, storage_structure => \&storage_structure_cfg, storage_access => \&storage_access_cfg, storage => \&storage_cfg, object_coupling => \&object_coupling_cfg, object_object => \&object_object_cfg, object_basis => \&object_basis_cfg, object => \&object_cfg, task_api => \&task_api_cfg, task => \&task_cfg, }; my $cfg_format_dispatch_hr = { hash => \&as_hash, yaml => \&as_yaml, }; # ENVIRONMENT Getopt::Long::Configure("bundling"); GetOptions( \%opt, "debug|D", "hash", "yaml" ) or pod2usage( -exitstatus => 2, -msg => "Problems parsing command line options!\n" ); sub run { my $self = shift; my $arg = 'all'; if ( not scalar @ARGV ) { push @ARGV, 'all'; } my $format = ( exists $opt{hash} and defined $opt{hash} ) ? 'hash' : 'yaml'; foreach my $scope (@ARGV) { my $get = $cfg_space_dispatch_hr->{$scope}; my $cfg_ar = $self->$get; my $as = $cfg_format_dispatch_hr->{$format}; foreach my $cfg_hr ( @{$cfg_ar} ) { $self->out("# === CipUX scope $scope, format $format ===\n"); my $n = $cfg_hr->{name}; my $v = $cfg_hr->{value_hr}; $self->out( $self->$as( { name => $n, value_hr => $v } ) ); } } return; } sub cipux_cfg { my $self = shift; my $cfg_hr = $self->cfg; return [ { name => 'cipux', value_hr => $cfg_hr } ]; } sub storage_structure_cfg { eval { require CipUX::Storage }; if ( not $EVAL_ERROR ) { my $storage = CipUX::Storage->new(); my $storage_cfg_hr = $storage->get_storage_cfg(); my $out_cfg_hr = {}; $out_cfg_hr->{structure} = $storage_cfg_hr; return [ { name => 'storage_structure', value_hr => $out_cfg_hr } ]; } return []; } sub storage_access_cfg { eval { require CipUX::Storage }; if ( not $EVAL_ERROR ) { my $storage = CipUX::Storage->new(); my $access_cfg_hr = $storage->get_access_cfg(); return [ { name => 'storage_access', value_hr => $access_cfg_hr } ]; } return []; } sub storage_cfg { my ( $self, $arg_r ) = @_; # will not show access per default #$self->storage_access_cfg; return $self->storage_structure_cfg; } sub object_coupling_cfg { eval { require CipUX::Object::Action }; if ( not $EVAL_ERROR ) { my $object = CipUX::Object::Action->new(); my $coupling_cfg_hr = $object->get_coupling_cfg(); return [ { name => 'object_coupling', value_hr => $coupling_cfg_hr } ]; } return []; } sub object_object_cfg { eval { require CipUX::Object::Action }; if ( not $EVAL_ERROR ) { my $object = CipUX::Object::Action->new(); my $object_cfg_hr = $object->get_object_cfg(); return [ { name => 'object_object', value_hr => $object_cfg_hr } ]; } return []; } sub object_basis_cfg { eval { require CipUX::Object::Action }; if ( not $EVAL_ERROR ) { my $object = CipUX::Object::Action->new(); my $basis_cfg_hr = $object->get_basis_cfg(); return [ { name => 'object_basis', value_hr => $basis_cfg_hr } ]; } return []; } sub object_cfg { my ( $self, $arg_r ) = @_; my @array = (); push @array, @{ $self->object_coupling_cfg }; push @array, @{ $self->object_object_cfg }; push @array, @{ $self->object_basis_cfg }; return \@array; } sub task_api_cfg { eval { require CipUX::Task }; if ( not $EVAL_ERROR ) { my $task = CipUX::Task->new(); my $task_api_cfg_hr = $task->get_task_api_cfg(); my $out_cfg_hr = {}; $out_cfg_hr->{task_api} = $task_api_cfg_hr; return [ { name => 'task_api', value_hr => $out_cfg_hr } ]; } return []; } sub task_cfg { my ( $self, $arg_r ) = @_; return $self->task_api_cfg; } sub all_cfg { my ( $self, $arg_r ) = @_; my @array = (); push @array, @{ $self->cipux_cfg }; push @array, @{ $self->storage_cfg }; push @array, @{ $self->object_cfg }; push @array, @{ $self->task_cfg }; return \@array; } sub as_yaml { my ( $self, $arg_r ) = @_; my $hr = ( exists $arg_r->{value_hr} and $self->h( $arg_r->{value_hr} ) ) ? $arg_r->{value_hr} : $self->perr('value_hr'); my $name = ( exists $arg_r->{name} and defined $arg_r->{name} ) ? $self->l( $arg_r->{name} ) : $self->perr('name'); return YAML::Any::Dump($hr); } sub as_hash { my ( $self, $arg_r ) = @_; my $hr = ( exists $arg_r->{value_hr} and $self->h( $arg_r->{value_hr} ) ) ? $arg_r->{value_hr} : $self->perr('value_hr'); my $name = ( exists $arg_r->{name} and defined $arg_r->{name} ) ? $self->l( $arg_r->{name} ) : $self->perr('name'); $Data::Dumper::Varname = $name; return Dumper($hr); } } 1; __END__ =pod =for stopwords CipUX Kuelker perr VARNAME API exc STDERR config getopt homedir lf LDAP lp li latin UTF UTF-8 login STDOUT TODO cfg =head1 NAME CipUX::Cfg::Client - Common CipUX configuration client =head1 VERSION version 3.4.0.13 =head1 SYNOPSIS use CipUX::Cfg::Client; my $ ccfg = $CipUX::Cfg::Client->new; =head1 DESCRIPTION Provides CLI for displaying CipUX configuarations of differents scopes. =head1 CONSTRUCTOR =head2 new Constructor my $trait = CipUX::Cfg::Client->new; =head1 SUBROUTINES/METHODS The following functions will be exported by CipUX::Cfg::Client. =head2 run =head2 cipux_cfg =head2 storage_structure_cfg =head2 storage_access_cfg =head2 storage_cfg =head2 object_coupling_cfg =head2 object_object_cfg =head2 object_basis_cfg =head2 object_cfg =head2 task_api_cfg =head2 task_cfg =head2 all_cfg =head2 as_yaml =head2 as_hash =head1 DIAGNOSTICS =head2 Problems parsing command line options! =head1 CONFIGURATION AND ENVIRONMENT Not applicable. =head1 DEPENDENCIES CipUX Class::Std Data::Dumper English Getopt::Long Log::Log4perl Pod::Usage Readonly YAML::Any version =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =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) 2010 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 =cut CipUX-3.4.0.13/bin000755001750001750 011506524062 14276 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/bin/cipux_configuration000444001750001750 346611506524062 20446 0ustar00ckuelkerckuelker000000000000#!/usr/bin/perl -w -T # ID: $Id$ # Revision: $Revision$ # Head URL: $HeadURL$ # Date: $Date$ # Source: $Source$ use warnings; use strict; use CipUX::Cfg::Client; use version; our $VERSION = qv('3.4.0.10'); my $cfgc = CipUX::Cfg::Client->new; $cfgc->run; exit 0; __END__ =pod =for stopwords CipUX STDOUT TODO Kuelker =head1 NAME cipux_configuration - prints CipUX configuration values =head1 VERSION version 3.4.0.10 =head1 SYNOPSIS cipux_configuration =head1 OPTIONS None =head1 REQUIRED ARGUMENTS None =head1 ARGUMENTS None =head1 USAGE cipux_configuration =head1 DESCRIPTION Prints CipUX configuration values to STDOUT. =head1 DIAGNOSTICS TODO =head1 EXIT STATUS TODO =head1 CONFIGURATION None =head1 DEPENDENCIES Carp CipUX YAML::Any version =head1 INCOMPATIBILITIES Not known. =head1 BUGS AND LIMITATIONS Not known. =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 - 2010 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 =cut CipUX-3.4.0.13/doc000755001750001750 011506524062 14273 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/readme.mkd000444001750001750 104511506524062 16362 0ustar00ckuelkerckuelker000000000000# CipUX Readme 2010-06-28 by Christian Kuelker - v0.1 2010-07-17 by Christian Kuelker - v0.2 ## Documentation This directory contains some basic documentation regarding the hole CipUX framework. Documentation with specific target can be found in the specific package. ## Documenation in this package example - examples for CipUX usage and scripts install - installation guide for CipUX setup - setup specific system parts (LDAP, PAM) testing - hints on testing CipUX config - configuration overview and guides CipUX-3.4.0.13/doc/install000755001750001750 011506524062 15741 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/install/readme.mkd000444001750001750 205011506524062 20025 0ustar00ckuelkerckuelker000000000000 # CipUX Installation Readme This folder contains guides for generic CipUX installations. For specific installation guides see other folders. The Debian and Debian Edu installation instructions can be found in the "debian" sub-directory. However if you prefer not to use a Debian specific installation (Debian Packages) you may also use the information in this folder. install - generic installations install/debian - Debian specifc installation install/testing - guides for testing the installation Other documentation that might be of interest for generic installations setup/ldap - guides for LDAP setup and configuration steup/pam - guides for PAM configuration ## Generic Installation Guides cipux_tar_release_installation.mkd - Installation from tar release cipux_svn_repository_installation.mkd - Installation from SVN repository ## Specific Installation guides cipux_deb_pkg_installation.mkd - Installation for Debian and Debian Edu ## Testing Installation cipux_installation_testing.mkd CipUX-3.4.0.13/doc/install/installation_overview.mkd000444001750001750 200611506524062 23220 0ustar00ckuelkerckuelker000000000000# CipUX Installation Overview 2010-06-28 by Christian Kuelker - v0.1 The CipUX installation can be divided into several distinct steps. middleware xml-rpc server other Other software like CAT-Web can use CipUX. However this documentation might not cover all other software. Please refere to the specific package documentation. ## CipUX Middleware The CipUX middleware has to be installed on one server. Most likely the database server. CipUX CipUX-Storage CipUX-Storage-Ldap CipUX-Object CipUX-Task ## CipUX XML-RPC Server The CipUX XML-RPC Server has to be installed at the same location as the CipUX middleware. But its installation is not mandatory if you just want to use the low level commands of CipUX. CipUX-XML-RPC ## CipUX Administration Tool - CAT The CipUX administration tools (like CipUX-CAT-Web, CipUX-CAT-Weasel) have to be installed on a web server. This do not need to be the same server as the CipUX middleware but it can be. CipUX-CAT-Web ... CipUX-3.4.0.13/doc/install/debian000755001750001750 011506524062 17163 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/install/debian/openldap_deb_pkg_installation.mkd000444001750001750 7111506524062 26011 0ustar00ckuelkerckuelker000000000000 # Installation aptitude install slapd openldap-utils CipUX-3.4.0.13/doc/install/debian/catweb_deb_pkg_installation.mkd000444001750001750 415311506524062 25521 0ustar00ckuelkerckuelker000000000000 # CAT-Web installation on Debian and Debian Edu ## Versions 2010-06-29 by Christian Kuelker, Kurt Gramlich - v0.1 2010-07-03 by Christian Kuelker, Kurt Gramlich - v0.2 2010-07-03 by Christian Kuelker, Kurt Gramlich - v0.3 2010-07-03 by Kurt Gramlich - v0.4 2010-07-15 by Kurt Gramlich - v0.5 2010-07-16 by Kurt Gramlich - v0.6 2010-07-16 by Kurt Gramlich - v0.7 2010-07-17 by Christian Kuelker - v0.8 2010-07-30 by Kurt Gramlich - v0.9 2010-07-30 by Kurt Gramlich - v1.0 2010-07-30 by Christian Kuelker - v1.1 2010-07-30 by Kurt Gramlich - v1.2 ## Prerequisites You need a working installation of CipUX with CipUX-RPC server up and running. # Installing CAT-Web aptitude update aptitude install cipux-cat-web ln -s /etc/cipux-cat-web/apache.conf /etc/apache/conf.d/cipux invoke-rc.d apache2 restart You have to adjust some directory settings for i in log cache; do mkdir -p /var/$i/cipux-cat-web; chmod 750 /var/$i/cipux-cat-web; chown -R www-data:www-data /var/$i/cipux-cat-web; done Only for Debian Edu you have also to create a link: ln -s /usr/share/cipux-cat-web/web /etc/debian-edu/www/cipux # Configuring access to CAT-Web List all unregistered CAT modules to see what is available. Use cipadmin as login and the password you have used for cipadmin while installing CipUX. su -l www-data -c 'cipux_cat_web_module --list-deregistered' The next step is to _register_ and _enable_ the modules you want to use. In any case you should register index.cgi to see the first page of CAT. As an example we also register language.cgi as the second module. su -l www-data -c 'cipux_cat_web_module --register --enable --add-member admins --verbose --object index.cgi' su -l www-data -c 'cipux_cat_web_module --register --enable --add-member admins --verbose --object language.cgi' # First steps To access the web front end of CAT use this URL: links http://localhost/cipux-cat-web/cat.cgi CipUX-3.4.0.13/doc/install/debian/cipux_deb_pkg_installation.mkd000444001750001750 1152711506524062 25427 0ustar00ckuelkerckuelker000000000000 # CipUX installation on Debian This guide describes the installation of the CipUX middleware and the XML-RPC server. ## Versions 2010-07-02 by Chrstian Kuelker - v0.1 2010-07-18 by Chrstian Kuelker - v0.2 ## Install medium Debian: Debian-Squeeze, Debian-Lenny ## Prerequisites This version of CipUX needs an LDAP server. Set the environment variable BASEDN to your base DN and add the organizational unit of CipUX. It can be for example: export BASEDN=ou=CipUX,dc=nodomain Then find out your admin account DN and do likewise. It can be something else, for example: export ADMINDN=cn=admin,dc=nodomain # Installation of CipUX Middleware Edit source list echo "deb http://debian.jones.dk/ lenny cipux" >> /etc/apt/sources.list Update package database aptitude update Start the installation aptitude install cipux-task-tools aptitude install ldap-utils After package installation, there is the need to fix some issues. mkdir /etc/cipux/ldap Add three schemata to the LDAP. Two of them (lis.schema and courier.schema) are not part of the package. You have to download them from SVN any way. One (cipux.schema) is included in the package. You can find it under /usr/share/doc/libcipux-storage-perl/examples/cipux.schema.gz However you can get all three schemata with this command at once: cd /etc/cipux/ldap svn co svn://svn.debian.org/cipux/trunk/cipux-core/storage-ldap/src/etc/cipux/ldap/schema The following files are needed to kick start the CipUX objects in the LDAP server. As of now they are not included in the Debian package. mkdir /usr/share/doc/libcipux-storage-perl/examples/debian/ cd /usr/share/doc/libcipux-storage-perl/examples svn co svn://svn.debian.org/cipux/trunk/cipux-core/storage/src/doc/debian Now add this object to the database. export cipuxrootpw="$(perl -e 'print map{("a".."z","A".."Z",0..9)[int(rand(62))]}(1..16)')" perl -pe 's/\@PW\@/$ENV{"cipuxrootpw"}/;s/\@BASEDN\@/$ENV{"BASEDN"}/' /usr/share/doc/libcipux-storage-perl/examples/debian/cipux.ldif|ldapadd -xWZD $ADMINDN cat /usr/share/doc/libcipux-storage-perl/examples/debian/cipuxroot.ldif|sed "s/@PW@/$cipuxrootpw/"|sed "s/@BASEDN@/$BASEDN/"|ldapadd -xWZD $ADMINDN Stop OpenLDAP: invoke-rc.d slapd stop Include CipUX schema perl -i -p0e '$t="CipUX schema";$s="include\t\t/etc/cipux/ldap/schema/cipux.schema\ninclude\t\t/etc/cipux/ldap/schema/courier.schema\ninclude\t\t/etc/cipux/ldap/schema/lis.schema";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!^((.*\n)?[ \t]*include[ \t]*\S*\.schema[ \t]*\n)!$1\n# BEGIN $t\n$s\n# END $t\n!s or exit 1' $(readlink -f /etc/ldap/slapd.conf) Copy ACL Rules: cat /usr/share/doc/libcipux-storage-perl/examples/debian/slapd_acl_cipuxroot.conf|sed "s/@BASEDN@/$BASEDN/" > /etc/cipux/ldap/slapd_acl_cipuxroot.conf Include ACL Rules: perl -i -p0e '$t="CipUX ACL";$s="include /etc/cipux/ldap/slapd_acl_cipuxroot.conf";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!((\n[ \t]*#.*)*\naccess[ \t])!\n# BEGIN $t\n$s\n# END $t\n$1! or exit 1' $(readlink -f /etc/ldap/slapd.conf) Create a CipUX trust account on OpenLDAP: cat /usr/share/cipux/etc/cipux-access.ini|sed "s/ou=CipUX,dc=example,dc=org/$BASEDN/" > /etc/cipux/cipux-access.ini chown root:root /etc/cipux/cipux-access.ini chmod u=rw,go= /etc/cipux/cipux-access.ini perl -i -pe "s/[ \t]*#([ \t]*password[ \t]*=).*/\$1\$ENV{'cipuxrootpw'}/" /etc/cipux/cipux-access.ini unset cipuxrootpw Start OpenLDAP: invoke-rc.d slapd start Create organisational units: if [ -e t.ldif ];then rm t.ldif;fi;touch t.ldif;for i in user group cat task room; do cat /usr/share/doc/libcipux-storage-perl/examples/debian/$i.ldif|sed "s/@BASEDN@/$BASEDN/" >> t.ldif;echo "" >> t.ldif; done; cat t.ldif|ldapadd -xWZD $ADMINDN; rm t.ldif Create cipadmin object. In this example we use "pw" as password. Please use another one. export cipadminpw=pw cat /usr/share/doc/libcipux-storage-perl/examples/debian/cipadmin-group.ldif|sed "s/@BASEDN@/$BASEDN/"|ldapadd -xWZD $ADMINDN perl -pe 's/\@PW\@/$ENV{"cipadminpw"}/;s/\@BASEDN\@/$ENV{"BASEDN"}/' /usr/share/doc/libcipux-storage-perl/examples/debian/cipadmin-user.ldif|ldapadd -xWZD $ADMINDN unset cipadminpw ## Installing CipUX task tools Create role accounts for i in admin teacher student professor assistant pupil tutor lecturer; do cipux_task_client -t cipux_task_create_role_account -o $i; done Add cipadmin to group admins cipux_task_client -t cipux_task_add_member_to_role_account -o admin -x value=cipadmin # Installing CipUX-RPC Server on top of the Middleware aptitude update aptitude install cipux-rpcd Start CipUX rpcd server invoke-rc.d cipux-rpcd start # Configuring PAM ## Debian Lenny vim /etc/nss-ldap.conf change: base dc=cipux to base ou=CipUX,dc=nodomain CipUX-3.4.0.13/doc/install/debian/catweb_release_installation.mkd000444001750001750 353411506524062 25550 0ustar00ckuelkerckuelker000000000000# CAT-Web upstream release installation ## Versions 2010-07-17 by Christian Kuelker - v0.1 ## Prerequisites You need a working installation of CipUX with CipUX-RPC server up and running and a running webserver. This guide uses apache2 as an example. ## Installing CAT-Web from upstream release perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$s=$b->selfupdate_object;$o0=$s->selfupdate(update=>"core",latest=>1);$i=$b->add_custom_source(uri=>"http://release.cipux.org",verbose=>1);$o1=$b->reload_indices;$b->install(modules=>[qw(CipUX::CAT::Web)]);' ## Setup ### Apache2 invoke-rc.d apache2 restart You have to adjust some directory settings for i in log cache; do mkdir -p /var/$i/cipux-cat-web; chmod 750 /var/$i/cipux-cat-web; chown -R www-data:www-data /var/$i/cipux-cat-web; done Only for Debian Edu you have also to create a link: ln -s /usr/share/cipux-cat-web/ /etc/debian-edu/www/cipux ## Configuring access to CAT-Web List all unregistered CAT modules to see what is available. Use cipadmin as login and the password you have used for cipadmin while installing CipUX. su -l www-data -c 'cipux_cat_web_module --list-deregistered' The next step is to _register_ and _enable_ the modules you want to use. In any case you should register index.cgi to see the first page of CAT. As an example we also register language.cgi as the second module. su -l www-data -c 'cipux_cat_web_module --register --enable --add-member admins --verbose --object index.cgi' su -l www-data -c 'cipux_cat_web_module --register --enable --add-member admins --verbose --object language.cgi' ## First steps To access the web front end of CAT use this URL: links http://localhost/cipux-cat-web/cat.cgi CipUX-3.4.0.13/doc/install/debian/cipux_debedu_pkg_installation.mkd000444001750001750 1141511506524062 26121 0ustar00ckuelkerckuelker000000000000 # CipUX installation on Debian Edu Lenny This guide describes the installation of the CipUX middleware and the XML-RPC server. ## Versions 2010-06-27 by Kurt Gramlich - v0.1 2010-06-28 by Kurt Gramlich - v0.2 2010-06-29 by Chrstian Kuelker, Kurt Gramlich - v0.3 2010-07-01 by Kurt Gramlich - v0.4 2010-07-03 by Kurt Gramlich - v0.5 2010-07-15 by Erik Auerswald, Kurt Gramlich - v0.6 2010-07-15 by Erik Auerswald, Kurt Gramlich - v0.7 2010-08-02 by Kurt Gramlich - v0.8 2010-08-10 by Erik Auerswald, Kurt Gramlich - v0.9 2010-08-10 by Kurt Gramlich - v1.0 2010-08-14 by Harald Meyer, Kurt Gramlich - v1.1 2010-08-15 by Peter Mueller, Kurt Gramlich - v1.2 ## Install medium Debian Edu: Lenny-Tjener # Installation of CipUX Middleware Edit source list echo "deb http://debian.jones.dk/ lenny cipux" >> /etc/apt/sources.list Update package database aptitude update aptitude install cipux-task-tools Only for Debian-Edu you have to do as root: cd mkdir CipUX-Install cd CipUX-Install unset http_proxy wget http://release.cipux.org/CipUX-Trait-DebianEdu-3.4.0.3.tar.gz tar xvzf CipUX-Trait-DebianEdu-3.4.0.3.tar.gz cp -a CipUX-Trait-DebianEdu-3.4.0.3/usr/share/cipux /usr/share cp -a CipUX-Trait-DebianEdu-3.4.0.3/lib/CipUX /usr/share/perl5/ Start installation mkdir /etc/cipux/ldap cp /usr/share/doc/libcipux-storage-perl/examples/cipux.schema.gz /etc/ldap/schema/ gunzip /etc/ldap/schema/cipux.schema.gz export cipuxrootpw="$(perl -e 'print map{("a".."z","A".."Z",0..9)[int(rand(62))]}(1..16)')" perl -pe 's/\@PW\@/$ENV{"cipuxrootpw"}/' /usr/share/doc/libcipux-storage-perl/examples/debian-edu/cipuxroot.ldif | ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no After entering the root password you should get as output: adding new entry "cn=cipuxroot,dc=skole,dc=skolelinux,dc=no" Stop OpenLDAP: invoke-rc.d slapd stop Include CipUX schema: perl -i -p0e '$t="CipUX schema";$s="include\t\t/etc/ldap/schema/cipux.schema";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!^((.*\n)?[ \t]*include[ \t]*\S*\.schema[ \t]*\n)!$1\n# BEGIN $t\n$s\n# END $t\n!s or exit 1' $(readlink -f /etc/ldap/slapd.conf) Copy ACL Rules: cp -f /usr/share/doc/libcipux-storage-perl/examples/debian-edu/slapd_acl_cipuxroot.conf /etc/cipux/ldap/ Include ACL Rules: perl -i -p0e '$t="CipUX ACL";$s="include /etc/cipux/ldap/slapd_acl_cipuxroot.conf";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!((\n[ \t]*#.*)*\naccess[ \t])!\n# BEGIN $t\n$s\n# END $t\n$1! or exit 1' $(readlink -f /etc/ldap/slapd.conf) Create a CipUX trust account on OpenLDAP: cp /usr/share/cipux/etc/cipux-access.d/50-cipux-access-debian-edu.ini /etc/cipux/cipux-access.ini chown root:root /etc/cipux/cipux-access.ini chmod u=rw,go= /etc/cipux/cipux-access.ini perl -i -pe "s/[ \t]*#([ \t]*password[ \t]*=).*/\$1\$ENV{'cipuxrootpw'}/" /etc/cipux/cipux-access.ini unset cipuxrootpw Start OpenLDAP: invoke-rc.d slapd start Create organisational units: ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no < /usr/share/doc/libcipux-storage-perl/examples/debian-edu/cat.ldif ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no < /usr/share/doc/libcipux-storage-perl/examples/debian-edu/task.ldif ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no < /usr/share/doc/libcipux-storage-perl/examples/debian-edu/room.ldif Create cipadmin object: You will have to enter the password for the root account. This will create cipadmin-group in ldap. ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no < /usr/share/doc/libcipux-storage-perl/examples/debian-edu/cipadmin-group.ldif You will have to enter the password for the cipadmin account. Choose a secure password you can remember. cipadminpw="" export cipadminpw You will have to enter the password for the root account. This will create cipadmin-user in ldap. perl -pe 's/\@PW\@/$ENV{"cipadminpw"}/' /usr/share/doc/libcipux-storage-perl/examples/debian-edu/cipadmin-user.ldif | ldapadd -xWZD cn=admin,ou=People,dc=skole,dc=skolelinux,dc=no smbpasswd -a -U cipadmin -w $cipadminpw unset cipadminpw ## Installing CipUX task tools Add cipadmin to group admins cipux_task_client -t cipux_task_add_member_to_role_account -o admins -x value=cipadmin Create role accounts for i in professor assistant pupil tutor lecturer; do cipux_task_client -t cipux_task_create_role_account -o $i; done Remark: admins, jradmins, teachers, students in Debian-Edu are only group, no user. # Installing CipUX-RPC Server on top of the Middleware aptitude update aptitude install cipux-rpcd Start CipUX rpcd server invoke-rc.d cipux-rpcd start CipUX-3.4.0.13/doc/install/debian/cipux_release_installation.mkd000444001750001750 1540211506524062 25450 0ustar00ckuelkerckuelker000000000000 # CipUX upstream release installation on Debian This guide describes the installation of the CipUX middleware and the XML-RPC server from the released made available at http://release.cipux.org. ## Versions 2010-07-18 by Christian Kuelker - v0.1 2010-08-06 by Christian Kuelker - v0.2 2010-11-12 by Christian Kuelker - v0.3 ## Install medium Debian: Debian-Squeeze, Debian-Lenny ## Prerequisites ### Installing basic software aptitude update aptitude install make gcc gettext libpam0g-dev libssl-dev \ libexpat1-dev subversion libcpanplus-perl ldap-utils On some systems (for example Debian) you might have problems building some Perl modules from scratch. You can however install them via the package manager to avoid this problem. aptitude install libtest-harness-perl libmodule-build-perl \ libyaml-perl libdate-manip-perl To use CipUX on Debian (not Debian-Edu) you need an LDAP server and aptitude install libnss-ldapd libnss-ldap slapd # Installation of the CipUX Build environment ## Update of CPANPLUS perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$s=$b->selfupdate_object;$o0=$s->selfupdate(update=>"core",latest=>1);' ## Configuration of CPANPLUS perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$b->save_state;$i=$b->add_custom_source(uri=>"http://release.cipux.org",verbose=>1);$o1=$b->reload_indices;$b->install(modules=>[qw(Module::Build::CipUX)]);' # Installation of CipUX Middleware from upstream release perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$b->save_state;$b->install(modules=>[qw(CipUX CipUX::Storage CipUX::Storage::LDAP CipUX::Object CipUX::Task)]);' After installation, there is the need to fix some issues. The following files are needed to kick start the CipUX objects in the LDAP server. mkdir -p /usr/share/doc/libcipux-storage-perl/examples/debian/ cd /usr/share/doc/libcipux-storage-perl/examples svn co svn://svn.debian.org/cipux/trunk/cipux-core/storage/src/doc/debian Set the environment variable BASEDN to your base DN and add the organizational unit of CipUX. It can be for example: export BASEDN=ou=CipUX,dc=nodomain Then find out your admin account DN and do likewise. It can be something else, for example: export ADMINDN=cn=admin,dc=nodomain Now add this object to the database. export cipuxrootpw="$(perl -e 'print map{("a".."z","A".."Z",0..9)[int(rand(62))]}(1..16)')" perl -pe 's/\@PW\@/$ENV{"cipuxrootpw"}/;s/\@BASEDN\@/$ENV{"BASEDN"}/' /usr/share/doc/libcipux-storage-perl/examples/debian/cipux.ldif|ldapadd -xWZD $ADMINDN cat /usr/share/doc/libcipux-storage-perl/examples/debian/cipuxroot.ldif|sed "s/@PW@/$cipuxrootpw/"|sed "s/@BASEDN@/$BASEDN/"|ldapadd -xWZD $ADMINDN Stop OpenLDAP: invoke-rc.d slapd stop Include CipUX schema perl -i -p0e '$t="CipUX schema";$s="include\t\t/etc/cipux/ldap/schema/cipux.schema\ninclude\t\t/etc/cipux/ldap/schema/courier.schema\ninclude\t\t/etc/cipux/ldap/schema/lis.schema";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!^((.*\n)?[ \t]*include[ \t]*\S*\.schema[ \t]*\n)!$1\n# BEGIN $t\n$s\n# END $t\n!s or exit 1' $(readlink -f /etc/ldap/slapd.conf) Copy ACL Rules: cat /usr/share/doc/cipux-storage-ldap/example/slapd_acl_cipuxroot.conf|sed "s/@BASEDN@/$BASEDN/" > /etc/cipux/ldap/slapd_acl_cipuxroot.conf Include ACL Rules: perl -i -p0e '$t="CipUX ACL";$s="include /etc/cipux/ldap/slapd_acl_cipuxroot.conf";s!^[ \t#]*(BEGIN $t).*[ \t#]*(END $t)[ \t]*$!# $1\n$s\n# $2!ms or s!((\n[ \t]*#.*)*\naccess[ \t])!\n# BEGIN $t\n$s\n# END $t\n$1! or exit 1' $(readlink -f /etc/ldap/slapd.conf) Create a CipUX trust account on OpenLDAP: cat /usr/share/cipux/etc/cipux-access.ini|sed "s/ou=CipUX,dc=example,dc=org/$BASEDN/"|sed "s/dc=example,dc=org/$BASEDN/" > /etc/cipux/cipux-access.ini chown root:root /etc/cipux/cipux-access.ini chmod u=rw,go= /etc/cipux/cipux-access.ini perl -i -pe "s/[ \t]*#([ \t]*password[ \t]*=).*/\$1\$ENV{'cipuxrootpw'}/" /etc/cipux/cipux-access.ini unset cipuxrootpw Start OpenLDAP: invoke-rc.d slapd start Create organisational units: if [ -e t.ldif ];then rm t.ldif;fi;touch t.ldif;for i in user group cat task room; do cat /usr/share/doc/libcipux-storage-perl/examples/debian/$i.ldif|sed "s/@BASEDN@/$BASEDN/" >> t.ldif;echo "" >> t.ldif; done; cat t.ldif|ldapadd -xWZD $ADMINDN; rm t.ldif Create cipadmin object. In this example we use "pw" as password. Please use another one. export cipadminpw=pw cat /usr/share/doc/libcipux-storage-perl/examples/debian/cipadmin-group.ldif|sed "s/@BASEDN@/$BASEDN/"|ldapadd -xWZD $ADMINDN perl -pe 's/\@PW\@/$ENV{"cipadminpw"}/;s/\@BASEDN\@/$ENV{"BASEDN"}/' /usr/share/doc/libcipux-storage-perl/examples/debian/cipadmin-user.ldif|ldapadd -xWZD $ADMINDN unset cipadminpw ## Installing CipUX task tools Create role accounts for i in admin teacher student professor assistant pupil tutor lecturer; \ do cipux_task_client -t cipux_task_create_role_account -o $i; done Add cipadmin to group admins cipux_task_client -t cipux_task_add_member_to_role_account -o admin -x value=cipadmin # Installing CipUX-RPC Server on top of the Middleware perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$o1=$b->reload_indices;$b->install(modules=>[qw(CipUX::RPC)]);' Start CipUX rpcd server invoke-rc.d cipux-rpcd start # Configuring PAM ## Debian Lenny The following data should be considered correct for your installation if you choose BASEDN=ou=CipUX,dc=nodomain, otherwise you should adopt the changes to your BASEDN. uri ldap://127.0.0.1 base ou=CipUX,dc=nodomain rootbinddn cn=admin,dc=nodomain passwd: compat ldap group: compat ldap Please verify that if one of the following files exists it contains the correct values. /etc/libnss-ldap.conf /etc/pam-ldap.conf /etc/nsswitch.conf /etc/nss-ldapd.conf You have to have a working PAM for CipUX. CipUX will use PAM for authentication. Please test your PAM setup # CipUX-CAT-Web perl -e 'use CPANPLUS;use CPANPLUS::Backend;$b=CPANPLUS::Backend->new;$c=$b->configure_object;$c->set_conf(verbose=>1);$c->set_conf(prereqs=>1);$c->set_conf(prefer_makefile=>0);$o1=$b->reload_indices;$b->install(modules=>[qw(CipUX::CAT::Web CipUX::CAT::Web::Module::UserList CipUX::CAT::Web::Module::SelfPassword)]);' CipUX-3.4.0.13/doc/example000755001750001750 011506524062 15726 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/example/readme.mkd000444001750001750 20111506524062 17766 0ustar00ckuelkerckuelker000000000000# CipUX examples This directory contains basic CipUX examples. This examples can be used after this package has been installed. CipUX-3.4.0.13/doc/example/cipux_trait_list000444001750001750 44011506524062 21352 0ustar00ckuelkerckuelker000000000000#!/usr/bin/perl -w use warnings; use strict; use CipUX::Trait; use base qw(CipUX); my $trait = CipUX::Trait->new; $trait->init; my $trait_list_hr = $trait->get_trait_name_register; foreach my $trait ( sort keys %{$trait_list_hr} ) { print "$trait: $trait_list_hr->{$trait}\n"; } CipUX-3.4.0.13/doc/config000755001750001750 011506524062 15540 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/config/dit000755001750001750 011506524062 16320 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/config/dit/dit_debian_edu.mkd000444001750001750 544611506524062 22102 0ustar00ckuelkerckuelker000000000000 # CipUX Directory Information Tree Debian Edu - CipUX DIT Debian Edu 2010-07-10 by Christian Kuelker - v0.1 ## CipUX DIT Debian Edu/ Skolelinux Etch CipUX supports the majority of Debian Edu Etch DIT entries. The CipUX relevant parts can be optained by the following DIT. There might be additional Debian Edu parts which are ignored by CipUX. #== dc=no | +== dc=skolelinux | +== dc=skole | +-- cn=cipuxroot | +== ou=People | | | +== ou=Machines | +== ou=Group | +== ou=Netgroup | +-- ou=Task | +-- ou=Room | +-- ou=CAT : :-- ou=Image : :-- ou=ImageSlot : :-- ou=HardwareType : :-- ou=Configuration The "=" entries are default Debian Edu Etch entries. The ":" parts are CipUX parts and might be supported in the future. ## CipUX DIT Debian Edu/ Skolelinux Lenny The CipUX relevant parts can be optained by the following DIT. There might be additional Debian Edu parts which are ignored by CipUX. #== dc=no | +== dc=skolelinux | +== dc=skole | +-- cn=cipuxroot | +== ou=Attic (Not suppored) | +== ou=Pam (Not suppored in 3.4.0.x) | +== ou=Domains (Not suppored in 3.4.0.x) | +== ou=Variables (Not suppored in 3.4.0.x) | +== ou=Automount (Not suppored in 3.4.0.x) | | | +== ou=auto.master (Not suppored in 3.4.0.x) | | | +== ou=skole (Not suppored in 3.4.0.x) | | | +== ou=tjener (Not suppored in 3.4.0.x) | +== ou=hosts (Not suppored in 3.4.0.x) | +== ou=People | | | +== ou=Machines | +== ou=Group | +== ou=Netgroup | +-- ou=Task | +-- ou=Room | +-- ou=CAT : :-- ou=Image : :-- ou=ImageSlot : :-- ou=HardwareType : :-- ou=Configuration The "=" entries are default Debian Edu Etch entries. The ":" parts are CipUX parts and might be supported in the future. CipUX-3.4.0.13/doc/config/dit/dit_custom.mkd000444001750001750 121411506524062 21322 0ustar00ckuelkerckuelker000000000000 # CipUX Directory Information Tree Custom - CipUX DIT custom 2010-07-10 by Christian Kuelker - v0.1 ## How to configure a custom DIT layout in CipUX The configuration of the CipUX DIT is done in the file cipux-storage.perl The CipUX bootstrap configuration can be found in /usr/share/cipux/etc A additional or new configuration can be applied to CipUX by providing a file with the same name in /etc/cipux or by providing a file in /usr/share/cipux/etc/cipux-storage.d The configuration for Debian Edu/ Skolelinux is provided for example as: /usr/share/cipux/etc/cipux-storage.d/50-cipux-storage-debian-edu.perl CipUX-3.4.0.13/doc/config/dit/dit_overview.mkd000444001750001750 115011506524062 21655 0ustar00ckuelkerckuelker000000000000 # CipUX Directory Information Tree Overview - CipUX DIT overview 2010-07-10 by Christian Kuelker - v0.1 ## Overview CipUX can support several directory information trees (DIT). In fact it was designed to support many. In the state of writing two different trees are directly supported by upstream. Others might follow. The first is the default CipUX DIT which will be used when installed from upstream release or Debian packages on Debian. The second can be used when CipUX is installed via upstream release or via Debian package on Debian Edu/ Skolelinux. Both trees are discussed in separate documents. CipUX-3.4.0.13/doc/config/dit/dit_default.mkd000444001750001750 202411506524062 21434 0ustar00ckuelkerckuelker000000000000 # CipUX Directory Information Tree Default - CipUX DIT Default 2010-07-10 by Christian Kuelker - v0.1 ## CipUX DIT Default A typical CipUX DIT might look like, where dc=nodomain can be chosen. #-- dc=nodomain | +-- cn=cipuxroot,dc=nodomain | +-- ou=CipUX,dc=nodomain | +-- ou=CAT,ou=CipUX,dc=nodomain | +-- ou=Task,ou=CipUX,dc=nodomain | +-- ou=Machine,ou=CipUX,dc=nodomain | +-- ou=Room,ou=CipUX,dc=nodomain | +-- ou=User,ou=CipUX,dc=nodomain | +-- ou=Group,ou=CipUX,dc=nodomain | +-- ou=Netgroup,ou=CipUX,dc=nodomain : :-- ou=ImageSlot,ou=CipUX,dc=nodomain : :-- ou=HardwareType,ou=CipUX,dc=nodomain : :-- ou=Image,ou=CipUX,dc=nodomain : :-- ou=Configuration The entries marked with ":" are foreseen but not used at the moment. CipUX-3.4.0.13/doc/testing000755001750001750 011506524062 15750 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/doc/testing/cipux_installation_testing.mkd000444001750001750 251711506524062 24255 0ustar00ckuelkerckuelker000000000000 # CipUX Installation Testing Testing a CipUX installation can be done on different subjects and different steps. This document describes some basic tests. If you are not familiar with the CipUX installation process, please read install/overview.mkd ## Unit Regression Tests If CipUX is installed via the tar release very basic tests can be executed. This tests are mostly intended for packagers and developers. The mechanism is always the same: tar xvzf Some-Module.tar.gz cd Some-Module perl Build.PL ./Build ./Build test To run some tests some dependent modules have to be installed. If you follow the installation guide for tar release this test will performed automatically. ## Simple Configuration Space Test After the CipUX middleware is installed, the configuration space can be tested. cipux_configuration ## XML-RCP Sever testing The XML-Server can be tested. This test creates and deletes real object in the database. Therefor it is recommended to execute this only on non productive systems after a fresh installation. # start the CipUX XML-RPC server invoke-rc.d cipux-rpcd start # This can take some time! cipux_rpc_test_client Use the account "cipadmin" with the correct password. This test should produce 314 positive test results (at the time on this writing) and no negative result. CipUX-3.4.0.13/usr000755001750001750 011506524062 14337 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/usr/share000755001750001750 011506524062 15441 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/usr/share/cipux000755001750001750 011506524062 16571 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/usr/share/cipux/etc000755001750001750 011506524062 17344 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/usr/share/cipux/etc/cipux.ini000444001750001750 103611506524062 21332 0ustar00ckuelkerckuelker000000000000# This is /usr/share/cipux/etc/cipux.ini # # If you would like to change this values please copy this # file to /etc/cipux/cipux.ini or /etc/cipux/cipux.d/cipux.ini # and modify it there. [cipux] # This is the path under which new user home directories will be created. # Default: /home/cipux0 user_home_directory_prefix = /home/cipux0 # This are the values for newly created users and groups user_soft_quota = 100000 user_hard_quota = 200000 group_soft_quota = 300000 group_hard_quota = 400000 CipUX-3.4.0.13/etc000755001750001750 011506524062 14301 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/etc/cipux000755001750001750 011506524062 15431 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/etc/cipux/log4perl.conf000444001750001750 524511506524062 20173 0ustar00ckuelkerckuelker000000000000# +=========================================================================+ # || /etc/cipux/log4perl.conf || # || || # || Log::Log4perl configuration for CipUX || # || || # || (C) Copyright 2008 by Christian Kuelker. || # || || # || License: GPL version 2 or any later version. || # || || # +=========================================================================+ log4perl.logger = DEBUG,ScrApp #log4perl.logger.CipUX = DEBUG,ScrApp #log4perl.logger.CipUX.Storage = DEBUG,ScrApp #log4perl.logger.CipUX.Object = DEBUG,ScrApp #log4perl.logger.CipUX.Task = DEBUG,ScrApp #log4perl.logger.CipUX.RBAC = DEBUG,ScrApp #log4perl.logger.CipUX.RBAC.Client = DEBUG,ScrApp #log4perl.logger.CipUX.RPC = DEBUG,ScrApp log4perl.logger.CipUX.RPC.Test.Client = DEBUG,FileAppTest # ------------- Screen appender ------------------- log4perl.appender.ScrApp = Log::Log4perl::Appender::ScreenColoredLevels log4perl.appender.ScrApp.stderr = 0 log4perl.appender.ScrApp.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.ScrApp.layout.ConversionPattern = %d{yyyy-MM-dd+HH:mm:ss} %M <%L>: %m%n #log4perl.appender.ScrApp.layout.ConversionPattern = %M <%L>: %m%n # ------------- File appender ------------------- log4perl.appender.FileApp = Log::Log4perl::Appender::File log4perl.appender.FileApp.filename = cipux-logfile.log log4perl.appender.FileApp.mode = append log4perl.appender.FileApp.autoflush = 1 log4perl.appender.FileApp.utf8 = 1 log4perl.appender.FileApp.stderr = 0 log4perl.appender.FileApp.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.FileApp.layout.ConversionPattern = %d{yyyy-MM-dd+HH:mm:ss} %M <%L>: %m%n # ------------- File appender for tests ------------------- log4perl.appender.FileAppTest = Log::Log4perl::Appender::File log4perl.appender.FileAppTest.filename = cipux-test.log log4perl.appender.FileAppTest.mode = write log4perl.appender.FileAppTest.autoflush = 1 log4perl.appender.FileAppTest.utf8 = 1 log4perl.appender.FileAppTest.stderr = 0 log4perl.appender.FileAppTest.layout = Log::Log4perl::Layout::PatternLayout log4perl.appender.FileAppTest.layout.ConversionPattern = %-25M{1} %05L: %m%n CipUX-3.4.0.13/t000755001750001750 011506524062 13771 5ustar00ckuelkerckuelker000000000000CipUX-3.4.0.13/t/perlcriticrc000444001750001750 101711506524062 16535 0ustar00ckuelkerckuelker000000000000# 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-3.4.0.13/t/pod.t000444001750001750 21411506524062 15052 0ustar00ckuelkerckuelker000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); CipUX-3.4.0.13/t/perlcritic_cpan.t000444001750001750 101011506524062 17444 0ustar00ckuelkerckuelker000000000000#!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-3.4.0.13/t/10.init_tests.t000444001750001750 67511506524062 16707 0ustar00ckuelkerckuelker000000000000#!perl -w use warnings; use strict; use Test::More tests => 5; BEGIN { use_ok( 'CipUX' ); } # Test cipux creation for CipUX my $cipux = CipUX->new(); ok( $cipux, '->new returns true' ); ok( ref $cipux, '->new returns a reference' ); isa_ok( $cipux, 'SCALAR' , '->new returns a hash reference' ); isa_ok( $cipux, 'CipUX', '->new returns a CipUX object' ); #ok( scalar keys %$cipux == 3, '->new returns an object with 3 attributes' ); CipUX-3.4.0.13/t/50_date_epoch.t000444001750001750 103711506524062 16713 0ustar00ckuelkerckuelker000000000000use Test::More tests => 4; BEGIN { use_ok('CipUX'); } use Date::Manip; my $epoch = UnixDate( '2010-02-26T10:49:22', '%s' ); my $c = CipUX->new; my $cipux_epoch0 = $c->date_epoch; ok( $cipux_epoch0 eq q{}, 'date_epoch deliver empty string' ); my $cipux_epoch1 = $c->date_epoch({today => 1}); ok( $cipux_epoch1 > 0, 'date_epoch deliver > 0' ); # 1267174162 #diag($cipux_epoch2); my $cipux_epoch2 = $c->date_epoch( { today => '2010-02-26T10:49:22' } ); ok( $epoch == $cipux_epoch2, 'date_epoch delivers exact epoch' ); CipUX-3.4.0.13/t/leaktrace.t000444001750001750 20311506524062 16221 0ustar00ckuelkerckuelker000000000000use Test::More tests => 1; use Test::LeakTrace; no_leaks_ok { use CipUX; my $object = CipUX->new(); } 'no memory leaks'; CipUX-3.4.0.13/t/20_trait.t000444001750001750 315711506524062 15745 0ustar00ckuelkerckuelker000000000000use Test::More tests => 7; BEGIN { use_ok('CipUX::Trait'); } use base qw(CipUX); use Module::Pluggable except => ['CipUX::Trait::DebianEdu']; my $trait = CipUX::Trait->new; my @methods = qw(init set_trait_name_register get_trait_name_register); can_ok( $trait, @methods ); isa_ok( $trait, 'CipUX::Trait' ); # add module from the filesystem ok( $trait->init ); # comare hash my $class_hr = { 'some-feature' => 'CipUX::Trait::SomeThing', 'that-feature' => 'CipUX::Trait::ThatThing', 'this-feature' => 'CipUX::Trait::ThisThing', }; # add artificial traits foreach my $c ( keys %{$class_hr} ) { ok( $trait->set_trait_name_register( { class => $class_hr->{$c}, name => $c } ) ); } my $trait_list_hr = {}; $trait_list_hr = $trait->get_trait_name_register; # add offical traits here if ( exists $trait_list_hr->{'debian-edu-configuration'} ) { $class_hr->{'debian-edu-configuration'} = 'CipUX::Trait::DebianEdu'; } if ( exists $trait_list_hr->{'samba-support'} ) { $class_hr->{'samba-support'} = 'CipUX::Trait::Samba'; } #use Data::Dumper; #diag(Dumper($class_hr)); #diag(Dumper($trait_list_hr)); # postpone test untill clear how to add custom traits. #is_deeply( $trait_list_hr, $class_hr, 'trait_name_register' ); #foreach my $trait ( sort keys %{$trait_list_hr} ) { # diag(" $trait: $trait_list_hr->{$trait}\n"); #} # my @trait = $trait->get_trait; my $err = 0; foreach my $t (@trait) { if ( not( exists $class_hr->{$t} and defined $class_hr->{$t} ) ) { $err = 1; } } # postpone test untill clear how to add custom traits. #is( $err, 0, 'get trait sub' ); CipUX-3.4.0.13/t/00.load.t000444001750001750 23411506524062 15427 0ustar00ckuelkerckuelker000000000000use Test::More tests => 3; BEGIN { use_ok('CipUX'); use_ok('CipUX::Trait'); use_ok('CipUX::Compat'); } diag("Testing CipUX $CipUX::VERSION"); CipUX-3.4.0.13/t/pod-coverage.t000444001750001750 47111506524062 16650 0ustar00ckuelkerckuelker000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } all_pod_coverage_ok(); CipUX-3.4.0.13/t/refcount.t000444001750001750 34311506524062 16120 0ustar00ckuelkerckuelker000000000000use Test::More tests => 2; use Test::Refcount; use CipUX; my $object = CipUX->new(); is_oneref( $object, '$object has a refcount of 1' ); my $otherref = $object; is_refcount( $object, 2, '$object now has 2 references' ); CipUX-3.4.0.13/t/perlcritic.t000444001750001750 43611506524062 16436 0ustar00ckuelkerckuelker000000000000#!perl use strict; use warnings; use Test::More; use English qw(-no_match_vars); eval { require Test::Perl::Critic; }; if ($EVAL_ERROR) { my $msg = 'Test::Perl::Critic required to for testing PBP compliance'; plan( skip_all => $msg ); } Test::Perl::Critic::all_critic_ok();