# +==========================================================================+
# || CipUX::Object::Action::Attribute::Change                               ||
# ||                                                                        ||
# || CipUX Object Layer Class                                               ||
# ||                                                                        ||
# || Copyright (C) 2007 - 2010 by Christian Kuelker. All rights reserved!   ||
# ||                                                                        ||
# || License: GNU GPL version 2 or any later version.                       ||
# ||                                                                        ||
# +==========================================================================+
# $Id: Change.pm 5011 2010-07-30 23:31:16Z christian-guest $
# $Revision: 5011 $
# $HeadURL$
# $Date: 2010-07-31 01:31:16 +0200 (Sat, 31 Jul 2010) $
# $Source$

package CipUX::Object::Action::Attribute::Change;

use 5.008001;
use strict;
use warnings;
use utf8;

use Carp;
use Class::Std;
use CipUX::Storage;
use Data::Dumper;
use Crypt::SmbHash qw(lmhash nthash);
use Log::Log4perl qw(:easy);
use Readonly;

use base qw(CipUX::Object::Action);

{    # BEGIN CLASS

    use version; our $VERSION = qv('3.4.0.5');
    use re 'taint';    # Keep data captured by parens tainted
    delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};    # Make %ENV safe

    # +======================================================================+
    # || CONSTANTS                                                          ||
    # +======================================================================+
    Readonly::Scalar my $EMPTY_STRING => q{};
    Readonly::Scalar my $auto_hr      => {
        userPassword         => sub { userPassword(@_) },
        sambaLMPassword      => sub { sambaLMPassword(@_); },
        sambaNTPassword      => sub { sambaNTPassword(@_); },
        sambaPwdLastSet      => sub { sambaPwdLastSet(@_); },
        sambaPasswordHistory => sub { sambaPasswordHistory(@_); },
        member               => sub { member(@_); },
    };

    # +======================================================================+
    # || INIT ARGS                                                          ||
    # +======================================================================+

    #my %cfg_of :ATTR( init_arg => 'cfg'); # store config file name

    # +======================================================================+
    # || GLOBAL VARS                                                        ||
    # +======================================================================+
    my $attr_hr = {};

    # +======================================================================+
    # || object                                                             ||
    # +======================================================================+

    # this is the entry point
    sub change_object_attribute_action {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;

        my $action
            = exists $arg_r->{action}
            ? $self->l( $arg_r->{action} )
            : $self->perr('action');

        my $type
            = exists $arg_r->{type}
            ? $self->l( $arg_r->{type} )
            : $self->perr('type');

        $attr_hr
            = exists $arg_r->{attr_hr} ? $self->h( $arg_r->{attr_hr} ) : {};

        # +------------------------------------------------------------------+
        # | prepare
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');
        $logger->debug( '> action     : ', $action );
        $logger->debug( '> type       : ', $type );
        $logger->debug( '> attr_hr    : ',
            { filter => \&Dumper, value => $attr_hr } );

        # list object types and check it
        my $type_ar = $self->list_type();
        my %type    = ();
        foreach my $t ( @{$type_ar} ) {
            $type{$t} = 1;
            $logger->debug( 'found type: ', $t );
        }
        if ( not defined $type{$type} ) {
            $self->exc( { msg => 'unknown type', value => $type } );
        }

       # +-------------------------------------------------------------------+
       # | change_object_attribute_action                                    |
       # +-------------------------------------------------------------------+

        # API 2
        my $object
            = exists $arg_r->{object}
            ? $self->l( $arg_r->{object} )
            : $self->perr('object');

        my $scope
            = exists $arg_r->{scope}
            ? $self->l( $arg_r->{scope} )
            : $self->perr('scope');

        # my $target =
        #  exists $arg_r->{target} ?
        #  $self->l( $arg_r->{target} )
        #  : undef;

        # $object->'add|delete|replace'
        my $changes_hr
            = exists $arg_r->{changes_hr}
            ? $self->h( $arg_r->{changes_hr} )
            : $self->perr('changes_hr');

        my $filter_hr
            = exists $arg_r->{filter_hr}
            ? $self->h( $arg_r->{filter_hr} )
            : $self->perr('filter_hr');

        my $target_hr
            = exists $arg_r->{target_hr}
            ? $self->h( $arg_r->{target_hr} )
            : $self->perr('target_hr');

        # debug API 2
        $logger->debug( '> object     : ', $object );
        $logger->debug( '> scope      : ', $scope );
        $logger->debug( '> changes_hr : ',
            { filter => \&Dumper, value => $changes_hr } );
        $logger->debug( '> filter_hr  : ',
            { filter => \&Dumper, value => $filter_hr } );
        $logger->debug( '> target_hr  : ',
            { filter => \&Dumper, value => $target_hr } );

        my $cfg_coupling_hr = $self->get_coupling_cfg();
        my $v_hr            = $cfg_coupling_hr->{$type};
        my $c_hr            = {};                          # create hash ref

        my $value_hr = $EMPTY_STRING;

        my $attr_ar = [];

        # for every object type $o in a given 'order': cipux_share_object, ...
        foreach my $o ( @{ $v_hr->{order} } ) {
            $logger->debug("foreach object type [$o] in ordered list:\n");

            # additional filter
            my $filter = $self->_compose_ldap_filter(
                { filter_hr => $filter_hr->{$o} } );

            if ( not exists $target_hr->{$o} ) {
                my $msg = 'go to next, because target not exists for';
                $logger->debug( $msg . q{: }, $o );
                next;
            }

            if ( not defined $target_hr->{$o} ) {
                my $msg = 'go to next, because target not defined for';
                $logger->debug( $msg . q{: }, $o );
                next;
            }

            if ( ref $target_hr->{$o} ne 'HASH' ) {
                my $msg = 'The target definition is not valid!';
                $msg .= 'The target should be a HASH reference.';
                $logger->debug( $msg . q{: }, $o );
                $self->exc( { msg => $msg, value => $o } );
            }

            # if a target=>ABC in param_hr is defined, we
            # exchange the LDAP attribute from cipux-task.cfgperl target
            #
            # 'target' => {                              # target_hr
            #    'cipux_role.group' => {                 # $o
            #        'memberUid' => 0,                   # $attr => $aval
            #        'member'    => 'cipux_account.user' # $attr => $aval
            #    },
            # },
            #
            # Example:
            #         target=>{
            #              client=>{
            #                 'nisNetgroupTriple' => 0,
            #              },
            #          },
            # Changes:
            #          nisNetgroupTriple=>undef
            #          target=>'(myhost,-,-)' OR value=>'(myhost,-,-)'
            # To:
            #          nisNetgroupTriple=>'(myhost,-,-)'
            my $value_hr = {};

            $logger->debug( 'attr_hr : ',
                { filter => \&Dumper, value => $attr_hr } );

            # TODO: consider replacing userPassword or value
            #       with non generic target
            if ( not exists $attr_hr->{value}
                and exists $attr_hr->{userPassword} )
            {
                $logger->debug('early set userPassword');
                $attr_hr->{value} = $attr_hr->{userPassword};
                my $aval = $target_hr->{$o}->{userPassword};
                if ( exists $attr_hr->{sambaLMPassword} ) {
                    $logger->debug('early set sambaLMPassword');
                    $attr_hr->{sambaLMPassword} = $self->_auto_attr(
                        {
                            attr     => 'sambaLMPassword',
                            aval     => $aval,
                            value_hr => $value_hr
                        }
                    );
                }
                if ( exists $attr_hr->{sambaNTPassword} ) {
                    $logger->debug('early set sambaNTPassword');
                    $attr_hr->{sambaNTPassword} = $self->_auto_attr(
                        {
                            attr     => 'sambaLMPassword',
                            aval     => $aval,
                            value_hr => $value_hr
                        }
                    );
                }
            }

            # foreach: member, memberUid
            foreach my $attr ( sort keys %{ $target_hr->{$o} } ) {
                $logger->debug("target_hr attr: [$attr] (value run)");

                # first: take value from named attribute
                # second: take value from pseudo attribute "value"
                $value_hr->{$attr}
                    = ( exists $attr_hr->{$attr}
                        and defined $attr_hr->{$attr} ) ? $attr_hr->{$attr}
                    : ( exists $attr_hr->{value}
                        and defined $attr_hr->{value} ) ? $attr_hr->{value}
                    : confess "No value for attribute [$attr] found!";
            }

            $logger->debug( 'value_hr : ',
                { filter => \&Dumper, value => $value_hr } );

            # calulate an apply auto values:
            foreach my $attr ( sort keys %{ $target_hr->{$o} } ) {
                $logger->debug("target_hr attr: [$attr] (auto run)");

                my $aval = $target_hr->{$o}->{$attr};
                push @{$attr_ar},
                    $self->_auto_attr(
                    { attr => $attr, aval => $aval, value_hr => $value_hr } );

            }

            $logger->debug( 'attr_ar : ',
                { filter => \&Dumper, value => $attr_ar } );

            # from CLI it is an ARRAY reference
            # from RPC it is a value

            # only query objects containing the attribute
            # ex.: cipux_course_share *.group = yes, *.user = no
            #            next if not defined $attr_ar;

            my $changes = $changes_hr->{$o};
            if ( not defined $changes ) {
                my $msg = 'go to next, because changes not defined for';
                $logger->debug( $msg . q{: }, $o );
                next;
            }
            if (
                not(   $changes eq 'add'
                    or $changes eq 'delete'
                    or $changes eq 'replace'
                    or $changes eq 'erase' )
                )
            {
                my $msg = 'Non valid changes found! ';
                $msg .= 'Changes should be add|delete|replace. ';
                $self->exc( { msg => $msg, value => $changes } );
            }
            else {
                $logger->debug( 'changes is ok: ', $changes );
            }

            # if changes is erase (=> escope=all) then we would like to delete
            # the LDAP attribute directly. This forces a different syntax on
            # the LDAP layer. With escope="all" we enable this syntax

            #     CipUX             LDAP
            #     changes  escope
            # ======================================
            #     add      none     modify changes
            #     delete   none     modify changes
            #     replace  none     modify changes
            #     erase    all      modify delete

            my $escope = ( $changes eq 'erase' ) ? 'all' : 'none';

            my $ldap = CipUX::Storage->new();

            # my $object_type_name = $cfg_coupling_hr->{$type};

            $value_hr = $ldap->set_value(
                {
                    type    => $o,
                    scope   => $scope,
                    escope  => $escope,
                    obj     => $object,     # value  => $value,
                    changes => $changes,
                    filter  => $filter,
                    attr_ar => $attr_ar,    # attr_ar => [],
                }
            );

        } ## end foreach my $o ( @{ $v_hr->{...

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return $value_hr;

    } ## end sub change_object_attribute_action

    # +=====================================================================+
    # || helper subroutines                                                ||
    # +=====================================================================+

    sub _auto_attr {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;

        # attribute: member, memberUid
        my $attr
            = exists $arg_r->{attr} ? $arg_r->{attr} : $self->perr('attr');

        # attribute value: 0, cipux_account.user
        my $aval
            = exists $arg_r->{aval} ? $arg_r->{aval} : $self->perr('aval');

        my $value_hr
            = exists $arg_r->{value_hr}
            ? $arg_r->{value_hr}
            : $self->perr('value_hr');

        # +------------------------------------------------------------------+
        # | main
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        $logger->debug( "ref auto_hr->{attr} ", ref( $auto_hr->{$attr} ) );
        my @value = ();
        my @attr  = ();

        # if CODE the it is a auto calc value
        if ( exists $auto_hr->{$attr}
            and ref $auto_hr->{$attr} eq 'CODE' )
        {

            if ( exists $value_hr->{$attr} ) {
                push @value, $value_hr->{$attr};
            }

            # Example: push @attr, $self->userPassword();
            push @attr, $attr;
            push @attr, $auto_hr->{$attr}(
                $self,
                {
                    aval     => $aval,
                    value_ar => \@value,
                }
            );
        }
        elsif ( exists $value_hr->{$attr} ) {
            push @attr, $attr;
            push @attr, $value_hr->{$attr};
        }
        else {
            push @attr, $attr;
            push @attr, '';

        }

        return @attr;

    }

    sub _compose_ldap_filter {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;

        #   'filter' => {
        #       'cipux_account.user' => {
        #           'cipuxRole'   => 'role',
        #           'cipuxIsRole' => 'TRUE',
        #           'cipuxIsSkel' => 'TRUE',
        #       },
        #       'cipux_account.group' => {
        #           'cipuxRole'   => 'role',
        #           'cipuxIsRole' => 'TRUE',
        #           'cipuxIsSkel' => 'TRUE',
        #       },
        my $filter_hr
            = exists $arg_r->{filter_hr}
            ? $arg_r->{filter_hr}
            : $self->perr('filter_hr');

        # +------------------------------------------------------------------+
        # | main
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $filter = $EMPTY_STRING;

        # &(cn=class84)
        # (objectClass=cipuxAccount)
        # (cipuxIsShare=TRUE)
        # (cipuxRole=course)
        if ( defined $filter_hr ) {

            foreach my $key ( keys %{$filter_hr} ) {
                my $value = $filter_hr->{$key};
                $filter .= "($key=$value)";
                $logger->debug("add search filter [$filter]");
            }

            return $filter;
        }

        return $EMPTY_STRING;

    }

    # +=====================================================================+
    # || Auto attribute sub                                                ||
    # +=====================================================================+

    sub userPassword {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $value_ar
            = exists $arg_r->{value_ar}
            ? $arg_r->{value_ar}
            : $self->perr('value_ar');

        # if defined $attr_hr->{userPassword}
        #    and  ref( $attr_hr->{userPassword} ) eq 'ARRAY' <---- CLI
        # elsif defined $attr_hr->{userPassword}             <---- RPC
        # else set it                                        <---- RND

        $attr_hr->{userPassword}
            = ( defined $attr_hr->{userPassword}
                and ref( $attr_hr->{userPassword} ) eq 'ARRAY' )
            ? $attr_hr->{userPassword}->[0]
            : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword}
            : ( defined $value_ar
                and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0]
            : defined $value_ar ? $value_ar
            :                     $self->random_password();

        my $password_hash = $self->hash_password(
            {
                mode     => 'crypt',
                password => $attr_hr->{userPassword}
            }
        );

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');

        # save the results
        # OK $attr_ar = [ $target_hr->{$o} => $value_ar ];
        return ["{crypt}$password_hash"];
    }

    sub sambaLMPassword {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;

        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $value_ar
            = exists $arg_r->{value_ar}
            ? $arg_r->{value_ar}
            : $self->perr('value_ar');

        $attr_hr->{userPassword}
            = ( defined $attr_hr->{userPassword}
                and ref( $attr_hr->{userPassword} ) eq 'ARRAY' )
            ? $attr_hr->{userPassword}->[0]
            : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword}
            : ( defined $value_ar
                and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0]
            : defined $value_ar ? $value_ar
            :                     $self->random_password();

        my $lm = lmhash( $attr_hr->{userPassword} );

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return $lm;
    }

    sub sambaNTPassword {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $value_ar
            = exists $arg_r->{value_ar}
            ? $arg_r->{value_ar}
            : $self->perr('value_ar');

        $attr_hr->{userPassword}
            = ( defined $attr_hr->{userPassword}
                and ref( $attr_hr->{userPassword} ) eq 'ARRAY' )
            ? $attr_hr->{userPassword}->[0]
            : defined $attr_hr->{userPassword} ? $attr_hr->{userPassword}
            : ( defined $value_ar
                and ref($value_ar) eq 'ARRAY' ) ? $value_ar->[0]
            : defined $value_ar ? $value_ar
            :                     $self->random_password();

        my $nt = nthash( $attr_hr->{userPassword} );

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return $nt;

    }

    sub sambaPasswordHistory {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $nt
            = '00000000000000000000000000000000000000000000000000000000000000';

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return $nt;

    }

    sub sambaPwdLastSet {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;
        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my $e = $self->date_epoch( { today => 1 } );

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return $e;

    }

    sub member {

        # +------------------------------------------------------------------+
        # | API
        my ( $self, $arg_r ) = @_;

        my $aval
            = exists $arg_r->{aval}
            ? $self->l( $arg_r->{aval} )
            : $self->perr('aval');
        my $value_ar
            = exists $arg_r->{value_ar}
            ? $arg_r->{value_ar}
            : $self->perr('value_ar');

        my $logger = get_logger(__PACKAGE__);
        $logger->debug('BEGIN');

        my @return = ();
        $logger->debug('target is member');

        my $storage = CipUX::Storage->new();

        my $structure_cfg_hr = $storage->get_storage_cfg();
        my $access_cfg_hr    = $storage->get_access_cfg();

        my $obj = $aval;    # e.g. cipux_account.user
        $logger->debug("RDN object is: $obj");

        my $basedn = $access_cfg_hr->{base_dn};
        $logger->debug("Base DN is: $basedn");

        my $rdn = $structure_cfg_hr->{$obj}->{struc_rdn};
        $logger->debug("RDN is: $rdn");

        my $dn_attr = $structure_cfg_hr->{$obj}->{dn_attr};
        $logger->debug("dn_attr: $dn_attr");

        if ( ref $value_ar eq 'ARRAY' ) {
            foreach my $uid ( @{$value_ar} ) {
                if ( ref $uid eq 'ARRAY' ) {
                    foreach my $u ( @{$uid} ) {
                        $logger->debug("value of target is $u");
                        push @return, "$dn_attr=$u,$rdn,$basedn";
                    }
                }
                else {
                    $logger->debug("value for that target is $uid");
                    push @return, "$dn_attr=$uid,$rdn,$basedn";
                }
            }
        }
        else {
            push @return, "$dn_attr=$value_ar,$rdn,$basedn";

        }

        # +------------------------------------------------------------------+
        # | API
        $logger->debug('END');
        return @return;
    }

}    # END INSIDE-OUT CLASS

1;

__END__

=pod

=head1 NAME

CipUX::Object::Action::Attribute::Change - Object layer class for CipUX

=head1 VERSION

version 3.4.0.5

=head1 SYNOPSIS

  use CipUX::Object::Action::Attribute::Change;

=head1 DESCRIPTION

Provides the functions cipux_object_create and cipux_object_destroy as well as
some auto-calculated values for example for userPassword.

=head1 ABSTRACT

The CipUX object layer is a generic abstract class, which can be
used by other classes or scripts.

The function cipux_object_create may create one or several LDAP nodes according
to the configuration structure in /etc/cipux/cipux-object.conf or
~/.cipux/cipux-object.conf.

The function cipux_object_destroy tries to remove one or more LDAP nodes.

=head1 SUBROUTINES/METHODS

The following functions will be exported by
CipUX::Object::Action::Attribute::Change.


=head2 change_object_attribute_action

Change (add, modify, erase) one or more attribute values.

 use CipUX::Object::Action::Attribute::Change;

 my $c = CipUX::Object::Action::Attribute::Change->new();

 $c->change_object_attribute_action( {

 # API 1 args
     action  => $action,
     type    => $type,
     attr_hr => $attr_hr,

 # API 2 args
     object => $object,
     scope => $scope,
     changes_hr => $changes_hr,
     filter_hr => $filter_hr,
     target_hr => $target_hr,
 } );

Where as for example:

     action     => 'change_object_attribute_action',
     type       => 'cipux_account_object',
     attr_hr    => $attr_hr,
     object     => 'rpctestadmin',
     scope      => 'one',
     changes_hr => $changes_hr,
     filter_hr  => $filter_hr,
     target_hr  => $target_hr,


=head2 userPassword

TODO

=head2 sambaNTPassword

TODO

=head2 sambaLMPassword

TODO

=head2 sambaPasswordHistory

TODO

=head2 sambaPwdLastSet

TODO

=head2 member

TODO


=head1 DIAGNOSTICS

TODO

=head1 CONFIGURATION AND ENVIRONMENT

TODO

=head1 DEPENDENCIES

Carp
Class:Std
CipUX
CipUX::Storage
Data::Dumper
Date::Manip
Log::Log4perl
Readonly

=head1 INCOMPATIBILITIES

Not known.


=head1 BUGS AND LIMITATIONS

Not known.


=head1 SEE ALSO

See the CipUX web page and the manual at L<http://www.cipux.org>

See the mailing list L<http://sympa.cipworx.org/wws/info/cipux-devel>

=head1 AUTHOR

Christian Kuelker  E<lt>christian.kuelker@cipworx.orgE<gt>

=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

