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 dSHeuristics ), ($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); $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); 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; #return [ map { $self->base->get_value('cn') } @{ ref $res ? $res : [ $res ] } ]; }; $field eq 'manager' and do { #my $entry = $self->SUPER::get_field($field) or return; #return $entry->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, Eolivier.thauvin@aerov.jussieu.frE =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