source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Ad/User.pm @ 197

package LATMOS::Accounts::Bases::Ad::User;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases::Ad::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 );

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

=head1 NAME

LATMOS::Ad - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Ad;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for LATMOS::Ad, 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=user) (!(ObjectClass=computer)))' }

sub _key_attr { 'cn' } 

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

sub _canonical_fields {
    my ($self, $base, $mode) = @_;
    (
        qw(
        sn name givenName
        sAMAccountName uid gecos
        homeDirectory loginShell
        uidNumber gidNumber gecos
        userPassword
        shadowLastChange shadowMin shadowMax
        shadowWarning shadowInactive shadowExpire
        shadowFlag
        description
        mail
        ipPhone otherTelephone department
        title modbile homePhone
        memberOf
        accountExpires
        streetAddress postalCode postOfficeBox l
        physicalDeliveryOfficeName
        company st
        displayName
        initials
        manager
        userAccountControl
        locked
        ),
        ($mode !~ /w/
            ? qw(cn dn uSNCreated uSNChanged directReports)
            : ()
        )
    )
}

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('sAMAccountName', $id);
    $entry->replace(objectClass => [ qw(top person organizationalPerson user)],);
    $entry->replace(userAccountControl => 66112);
    # This attributes cannot be set via LDAP:
    #$entry->replace(sAMAccountType => 0x30000000);
    $entry->replace(accountExpires => '9223372036854775807'); # TODO hardcoded, burk
    $entry->replace(userPrincipalName => "$id\@" . $base->ad_domain);
    foreach (keys %data) {
        $class->_populate_entry($entry, $_, $data{$_});
    }
    my $msg = $base->ldap->add($entry);
    warn $msg->error if ($msg->code);
    return $msg->code ? 0 : 1;
}

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

    $field eq 'memberOf' and do {
        my @res;
        $self->base->_unlimited_search(
            base => $self->base->object_base_dn('group'),
            filter => sprintf(
                '(&(objectClass=group)(member=%s))',
                escape_filter_value($self->{entry}->dn),
            ),
            callback => sub {
                my ($mesg, $entry) = @_;
                ref $entry eq 'Net::LDAP::Entry' or return;
                push(@res, $entry->get_value('cn'));
            },
        );
        return [ sort(@res) ];
    };
    $field eq 'directReports' and do {
        my $res = $self->SUPER::get_field($field);
        return [
            map { $self->base->_get_object_from_dn($_)->get_value('cn') }
            @{ ref $res ? $res : [ $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 set_fields {
    my ($self, %data) = @_;
    my %ndata;
    while (my ($f, $val) = each(%data)) {
        $f eq 'memberOf' and do {
            my %users;
            $users{$_}{e} = 1 foreach (@{ $self->get_field('memberOf') || []});
            $users{$_}{n} = 1 foreach (@{ $val || []});
            foreach (keys %users) {
                $users{$_}{e} && $users{$_}{n} and next;
                my $user = $self->base->get_object('group', $_) or next;
                if ($users{$_}{e}) {
                    $self->{entry}->del(memberOf => $user->get_field('dn'));
                } elsif ($users{$_}{n}) {
                    $self->{entry}->add(memberOf => $user->get_field('dn'));
                } # else {} # can't happen
                my $mesg = $self->{entry}->update($self->base->ldap);
            }
            next;
        };
        $f eq 'manager' && $val and do {
            my $user = $self->base->get_object('user', $val) or next;
            $ndata{$f} = $user->get_field('dn');
            next;
        };
        $f eq 'locked' and do {
            my $uac = $self->get_field('userAccountControl');
            if ($val) {
                $uac |= 0x00000002;
            } else {
                $uac &= (0xFFFFFFFF ^ 0x00000002);
            }
            $ndata{userAccountControl} = "$uac";
            next;
        };
        $ndata{$f} = $val;
    }
    $self->SUPER::set_fields(%ndata);
}

sub set_password {
    my ($self, $clear_pass) = @_;
    my $charmap = Unicode::Map8->new('latin1')  or  die;
    my $newUniPW = $charmap->tou('"'.$clear_pass.'"')->byteswap()->utf16();
    my $mesg = $self->base->ldap->modify(
        $self->get_c_field('dn'),
        changes => [
        #replace => [ userPassword => $clear_pass ],
        replace => [ unicodePwd => $newUniPW ],

        ]
    );
    if ($mesg->code && $mesg->code != 82) {
        warn $mesg->error;
        return;
    } else { return 1 }
}

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