source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ldap/User.pm @ 657

package LATMOS::Accounts::Bases::Ldap::User;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Ldap::objects);
use Net::LDAP;
use Net::LDAPS;
use Net::LDAP::Entry;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED ); 
use Net::LDAP::Util     qw( escape_filter_value );
use LATMOS::Accounts::Log;

our $VERSION = (q$Rev: 649 $ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Ldap - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Ldap;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for LATMOS::Ldap, created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 FUNCTIONS

=cut

sub _class_filter { '(&(ObjectClass=posixAccount))' }

sub _key_attr { 'cn' } 

sub _my_ldap_classes { qw(
    top
    inetOrgPerson
    organizationalPerson
    posixAccount
    shadowAccount
) }

sub _delayed_fields {
    my ($self)= @_;
    return qw();
}

sub _canonical_fields {
    my ($self, $base, $mode) = @_;
    (
        qw(displayName givenName homePhone homePostalAddress
        initials mail sn
        mobile o uid manager facsimileTelephoneNumber), # inetOrgPerson
        qw(uidNumber gidNumber homeDirectory
        userPassword loginShell
        gecos description), # posixAccount
        qw(shadowLastChange
        shadowMin shadowMax
        shadowWarning
        shadowInactive
        shadowExpire
        shadowFlag), # shadowAccount
        qw(street postOfficeBox postalCode postalAddress streetAddress
        physicalDeliveryOfficeName ou st l telephoneNumber), # organizationalPerson
        ('memberOf'),
        ($mode
            !~ /w/
              ? qw(cn dn)
              : ()
        )
    )
}

sub _create {
    my ($class, $base, $id, %data) = @_;

    my $entry = Net::LDAP::Entry->new();

    $entry->dn(join(',',
        sprintf('cn=%s', escape_filter_value($id)),
        $base->object_base_dn($class->type),
    ));
    $entry->replace(objectClass =>
        [ $class->_my_ldap_classes ],);
    $data{sn} ||= $id; # sn is mandatory
    $data{homeDirectory} ||= '/dev/null'; # homeDirectory is mandatory
    foreach (keys %data) {
        $class->_populate_entry($entry,
            $_, $data{$_}, $base);
    }

    my $msg = $base->ldap->add($entry);
    if ($msg->code) {
        $base->log(LA_ERR, "Cannot create user: %s", $msg->error);
        return 0;
    }
    return 1;
}

sub get_field {
    my ($self, $field) = @_;

    $field eq 'streetAddress' and $field = 'street';
    $field eq 'memberOf' and do {
        my @res;
        $self->base->_unlimited_search(
            base => $self->base->object_base_dn('group'),
            filter => sprintf(
                '(&(objectClass=posixGroup)(memberUID=%s))',
                escape_filter_value($self->id),
            ),
            callback => sub {
                my ($mesg, $entry) = @_;
                ref $entry eq 'Net::LDAP::Entry' or return;
                push(@res, $entry->get_value('cn'));
                1;
            },
        );
        return [ sort(@res) ];
    };
    $field eq 'manager' and do {
        my $dn = $self->SUPER::get_field($field) or return;
        return $self->base->_get_object_from_dn($dn)->get_value('cn');
    };
    $self->SUPER::get_field($field);
}

sub _populate_entry {
    my ($self, $entry, $f, $val, $base) = @_;
    $base ||= $self->base;
    for ($f) {
        /^sn$/ and $val ||= $entry->get_value('cn');
        /^memberOf$/ and do {
            my %users;
            $users{$_}{e} = 1 foreach (ref $self
                ? $self->get_attributes('memberOf')
                : ());
            $users{$_}{n} = 1 foreach (@{ $val || []});
            foreach (keys %users) {
                $users{$_}{e} && $users{$_}{n} and next;
                my $group = $base->get_object('group', $_) or next;
                if ($users{$_}{e}) {
                    $group->{entry}->delete(memberUID => $entry->get_value('cn'));
                } elsif ($users{$_}{n}) {
                    $group->{entry}->add(memberUID => $entry->get_value('cn'));
                } # else {} # can't happen
                my $mesg = $group->{entry}->update($base->ldap);
                if ($mesg->code) {
                    $base->log(LA_ERR, "Cannot set attributes: %s", $mesg->error);
                    return;
                }
            }
            return 1;
        };
        /^userPassword$/ and do {
            # openldap use prefix to identify encryption passwd
            # {CRYPT} is system dependant, eg use crypt from system
            # As we run openldap on UNIX, this should not be a problem
            # as we use perl crypt() which does the same
            # This code will have to be changed if we use openldap on other UNIX
            $val = '{CRYPT}' . ($val || 'xxx');
            next;
        };
        /^manager$/ && $val and do {
            my $user = $base->get_object('user', $val) or
            next;
            $val = $user->get_field('dn');
            next;
        };
        /^homeDirectory$/ and $val ||= '/dev/null';
    }
    $self->SUPER::_populate_entry($entry, $f, $val, $base);
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@aerov.jussieu.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut