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

Last change on this file since 1616 was 1616, checked in by nanardon, 9 years ago

Fix upgrade of objectClass for user

File size: 8.8 KB
RevLine 
[288]1package LATMOS::Accounts::Bases::Ldap::User;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Ldap::objects);
8use Net::LDAP;
9use Net::LDAPS;
10use Net::LDAP::Entry;
11use Net::LDAP::Control::Paged;
12use Net::LDAP::Constant qw( LDAP_CONTROL_PAGED ); 
13use Net::LDAP::Util     qw( escape_filter_value );
14use LATMOS::Accounts::Log;
[1117]15use LATMOS::Accounts::Bases::Ldap::Group;
[1122]16use LATMOS::Accounts::Utils;
[1603]17use Crypt::SmbHash;
[288]18
19our $VERSION = (q$Rev: 649 $ =~ /^Rev: (\d+) /)[0];
20
21=head1 NAME
22
23LATMOS::Ldap - Perl extension for blah blah blah
24
25=head1 SYNOPSIS
26
27  use LATMOS::Ldap;
28  blah blah blah
29
30=head1 DESCRIPTION
31
32Stub documentation for LATMOS::Ldap, created by h2xs. It looks like the
33author of the extension was negligent enough to leave the stub
34unedited.
35
36Blah blah blah.
37
38=head1 FUNCTIONS
39
40=cut
41
42sub _class_filter { '(&(ObjectClass=posixAccount))' }
43
44sub _key_attr { 'cn' } 
45
[292]46sub _my_ldap_classes { qw(
47    top
48    inetOrgPerson
49    organizationalPerson
50    posixAccount
51    shadowAccount
[1603]52    sambaSamAccount
[292]53) }
54
[1603]55sub _computeSSID {
56    my ($value) = @_;
57    $value * 2 + 1000
58}
59
[861]60sub _get_attr_schema {
61    my ($class, $base) = @_;
62    $class->SUPER::_get_attr_schema($base,
63    {
64        displayName => { },
65        givenName => { },
66        homePhone => { },
67        homePostalAddress => { },
68        initials => { },
69        mail => { },
70        sn => { },
71        mobile => { },
72        o => { },
[1033]73        uid => { mandatory => 1 },
[861]74        manager => {
75            delayed => 1,
76            can_values => sub { $base->list_objects('user') },
77        },
78        facsimileTelephoneNumber => { },
[1603]79        uidNumber => {
80            uniq => 1,
81            post => sub {
82                my ($self, $value) = @_;
[1616]83                $self->object->set_fields(sambaSID => $self->object->base->sambaSID(_computeSSID($value)));
[1603]84            },
85        },
[861]86        gidNumber => {
87            reference => 'group',
88            mandatory => 1,
89            can_values => sub {
90                map { $base->get_object('group',
91                        $_)->get_attributes('gidNumber') }
92                $base->list_objects('group')
93            },
94            display => sub {
95                my ($self, $val) = @_;
96                my ($gr) = $self->base->search_objects('group', "gidNumber=$val")
97                    or return;
98                return $gr;
99            },
[288]100
[861]101        },
102        homeDirectory => { },
103        userPassword => { },
104        loginShell => { },
105        gecos => { },
106        description => { },
107        shadowLastChange => { },
108        shadowMin => { },
109        shadowMax => { },
110        shadowWarning => { },
111        shadowInactive => { },
112        shadowExpire => { },
113        shadowFlag => { },
114        street => { },
115        postOfficeBox => { },
116        postalCode => { },
117        postalAddress => { },
118        streetAddress => { },
119        physicalDeliveryOfficeName => { },
120        ou => { },
121        st => { },
122        l => { },
123        telephoneNumber => { },
[1495]124        memberOf => {
125            delayed => 1,
126            multiple => 1,
127            reference => 'group',
128        },
[861]129        cn => { ro => 1, },
130        dn => { ro => 1, },
131        objectClass => { ro => 1, },
132        pwdAccountLockedTime => {},
133        pwdPolicySubentry => {},
134        pwdChangedTime => { ro => 1 },
135        labeledURI => {},
[1603]136        userPassword    => { readable => 0, },
137        sambaLMPassword => { readable => 0, },
138        sambaNTPassword => { readable => 0, },
[1616]139        sambaSID => { ro => 1 },
[861]140    }
141    );
[288]142}
143
[1616]144sub _update_class {
145    my ($self) = @_;
146
147    $self->SUPER::_update_class(
148        sambaSID => $self->base->sambaSID(
149            _computeSSID($self->_get_attributes('uidNumber'))
150        )
151    );
152}
153
[288]154sub _create {
155    my ($class, $base, $id, %data) = @_;
156
157    my $entry = Net::LDAP::Entry->new();
158
159    $entry->dn(join(',',
[1115]160        sprintf('%s=%s',
[1117]161            $class->_dn_attribute($base),
[1115]162            escape_filter_value($id)),
163            $base->object_base_dn($class->type),
164        )
165    );
[288]166    $entry->replace(objectClass =>
[292]167        [ $class->_my_ldap_classes ],);
[1117]168    $data{cn} ||= $data{sn} || $id; # cn is mandatory
[383]169    $data{sn} ||= $id; # sn is mandatory
[1117]170    $data{uid} ||= $id; # uid is mandatory
[1603]171    $data{sambaSID} = $base->sambaSID(_computeSSID($data{uidNumber}));
[514]172    $data{homeDirectory} ||= '/dev/null'; # homeDirectory is mandatory
[1117]173    $data{$class->_key_attribute($base)} = $id;
[288]174    foreach (keys %data) {
175        $class->_populate_entry($entry,
[380]176            $_, $data{$_}, $base);
[288]177    }
178
179    my $msg = $base->ldap->add($entry);
180    if ($msg->code) {
181        $base->log(LA_ERR, "Cannot create user: %s", $msg->error);
182        return 0;
183    }
[445]184    return 1;
[288]185}
186
[715]187sub _rename {
188    my ($class, $base, $uid, $newuid) = @_;
189
190    $class->SUPER::_rename($base, $uid, $newuid) or return;
191}
192
[288]193sub get_field {
194    my ($self, $field) = @_;
195
[294]196    $field eq 'streetAddress' and $field = 'street';
[288]197    $field eq 'memberOf' and do {
198        my @res;
199        $self->base->_unlimited_search(
200            base => $self->base->object_base_dn('group'),
201            filter => sprintf(
[618]202                '(&(objectClass=posixGroup)(memberUID=%s))',
203                escape_filter_value($self->id),
[288]204            ),
205            callback => sub {
206                my ($mesg, $entry) = @_;
207                ref $entry eq 'Net::LDAP::Entry' or return;
[1115]208                push(@res, $entry->get_value(
[1117]209                    LATMOS::Accounts::Bases::Ldap::Group->_key_attribute($self->base),
[1115]210                ));
[618]211                1;
[288]212            },
213        );
214        return [ sort(@res) ];
215    };
[295]216    $field eq 'manager' and do {
217        my $dn = $self->SUPER::get_field($field) or return;
[861]218        my $manager = $self->base->_get_object_from_dn($dn) or return;
[1174]219        return $manager->get_value(__PACKAGE__->_key_attribute($self->base));
[295]220    };
[288]221    $self->SUPER::get_field($field);
222}
223
[380]224sub _populate_entry {
225    my ($self, $entry, $f, $val, $base) = @_;
226    $base ||= $self->base;
227    for ($f) {
[1121]228        /^sn$/ and $val ||= $entry->get_value($self->_key_attribute);
[380]229        /^memberOf$/ and do {
[288]230            my %users;
[380]231            $users{$_}{e} = 1 foreach (ref $self
[621]232                ? $self->get_attributes('memberOf')
[380]233                : ());
[288]234            $users{$_}{n} = 1 foreach (@{ $val || []});
235            foreach (keys %users) {
236                $users{$_}{e} && $users{$_}{n} and next;
[767]237                my $group = $base->get_object('group', $_) or next;
[288]238                if ($users{$_}{e}) {
[1115]239                    $group->{entry}->delete(memberUID =>
[1117]240                        $entry->get_value(
241                            LATMOS::Accounts::Bases::Ldap::User->_key_attribute($base),
242                        )
243                    );
[767]244                } elsif ($users{$_}{n}) {
[1115]245                    $group->{entry}->add(memberUID =>
[1117]246                        $entry->get_value(
247                            LATMOS::Accounts::Bases::Ldap::User->_key_attribute($base),
248                        )
249                    );
[288]250                } # else {} # can't happen
[380]251                my $mesg = $group->{entry}->update($base->ldap);
252                if ($mesg->code) {
[381]253                    $base->log(LA_ERR, "Cannot set attributes: %s", $mesg->error);
[380]254                    return;
255                }
[288]256            }
[622]257            return 1;
[288]258        };
[380]259        /^manager$/ && $val and do {
[861]260            my $user = $base->get_object('user', $val) or do {
261                $val = undef;
262                next;
263            };
[380]264            $val = $user->get_field('dn');
[295]265            next;
266        };
[1122]267        /^gecos$/ and do {
268            $val = to_ascii($val);
269        };
[514]270        /^homeDirectory$/ and $val ||= '/dev/null';
[288]271    }
[380]272    $self->SUPER::_populate_entry($entry, $f, $val, $base);
[288]273}
274
[1603]275sub _set_password {
276    my ($self, $clear_pass) = @_;
277
278    my @salt_char = (('a' .. 'z'), ('A' .. 'Z'), (0 .. 9), '/', '.');
279    my $salt = join('', map { $salt_char[rand(scalar(@salt_char))] } (1 .. 8));
280    # openldap use prefix to identify encryption passwd
281    # {CRYPT} is system dependant, eg use crypt from system
282    # As we run openldap on UNIX, this should not be a problem
283    # as we use perl crypt() which does the same
284    # This code will have to be changed if we use openldap on other UNIX
285    my $md5 = '{CRYPT}' . crypt($clear_pass, '$1$' . $salt);
286
287    my ($lm, $nt) = ntlmgen $clear_pass;
288
289    my $res = $self->set_fields(
290        userPassword    => $md5,
291        sambaLMPassword => $lm,
292        sambaNTPassword => $nt,
293    );
294    $self->base->log(LA_NOTICE, 'Mot de passe changé pour %s', $self->id)
295    if($res);
296    return $res;
297}
298
[288]2991;
300
301__END__
302
303=head1 SEE ALSO
304
305=head1 AUTHOR
306
307Olivier Thauvin, E<lt>olivier.thauvin@aerov.jussieu.frE<gt>
308
309=head1 COPYRIGHT AND LICENSE
310
311Copyright (C) 2008 CNRS SA/CETP/LATMOS
312
313This library is free software; you can redistribute it and/or modify
314it under the same terms as Perl itself, either Perl version 5.10.0 or,
315at your option, any later version of Perl 5 you may have available.
316
317
318=cut
Note: See TracBrowser for help on using the repository browser.