source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Unix.pm

Last change on this file was 2612, checked in by nanardon, 2 weeks ago

use real attribute number in unix base, fixe test
  • Property svn:keywords set to Id Rev
File size: 13.1 KB
Line 
1package LATMOS::Accounts::Bases::Unix;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases);
8use LATMOS::Accounts::Log;
9use Fcntl qw(:flock);
10use Encode;
11
12our $VERSION = (q$Rev: 1975 $ =~ /^Rev: (\d+) /)[0];
13
14=head1 NAME
15
16LATMOS::Ad - Perl extension for blah blah blah
17
18=head1 SYNOPSIS
19
20  use LATMOS::Accounts::Bases;
21  my $base = LATMOS::Accounts::Bases->new('unix');
22  ...
23
24=head1 DESCRIPTION
25
26Account base access over standard unix file format.
27
28=head1 FUNCTIONS
29
30=cut
31
32=head2 new(%config)
33
34Create a new LATMOS::Ad object for windows AD $domain.
35
36domain / server: either the Ad domain or directly the server
37
38ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.
39
40=cut
41
42sub new {
43    my ($class, %config) = @_;
44   
45    my $base = {
46        # are we using shadow, default to yes
47        use_shadow => (defined($config{use_shadow}) ? $config{use_shadow} : 1),
48        min_gid => $config{min_gid},
49        min_uid => $config{min_uid},
50        nis_overflow => ($config{nis_overflow} || ''),
51        users => {},
52        groups => {},
53    };
54
55    foreach (qw(passwd shadow group gshadow)) {
56        if ($config{$_}) {
57            $base->{$_} = $config{$_};
58        } elsif ($config{directory}) {
59            $base->{$_} = $config{directory} . '/' . $_;
60        } else {
61            $base->{$_} = "/etc/$_";
62        }
63    }
64
65
66    bless($base, $class);
67}
68
69my @password_fields = qw(account password uidNumber gidNumber gecos home shell);
70my @shadow_fields =   qw(account spassword last_changed before_ch after_ch exp_warn exp_disable disable res);
71my @group_fields =    qw(group_name passwd gid user_list);
72my @gshadow_fields =  qw(group_name spassword unknown suser_list);
73
74# All UNIX account file are colon separated field
75# This function factorize open/read/split fields
76
77sub _load_unix_file {
78    my ($self, $file, $callback) = @_;
79    my $enc = find_encoding($self->config('encoding') || 'iso-8859-14')
80        or do {
81        $self->log(LA_ERROR, "Cannot find encoding %s", $self->config('encoding') || 'iso-8859-15');
82        return;
83    };
84    open(my $handle, '<', $file) or do {
85        $self->log(LA_ERR, "Cannot open unix file `%s' for reading (%s)", $file, $!);
86        return;
87    };
88    $self->log(LA_DEBUG, "Reading file $file");
89    flock($handle, LOCK_EX);
90    while (my $line = <$handle>) {
91        chomp($line);
92        $line = encode('utf-8', $line);
93        my @ch = split(':', $line);
94        $callback->(@ch);
95    }
96    close($handle);
97    return 1;
98}
99
100=head2 load
101
102Read file and load data into memory
103
104=cut
105
106sub load {
107    my ($self) = @_;
108
109    # If already loaded, just say ok !
110    $self->{_loaded} and return 1;
111   
112    $self->_load_unix_file(
113        $self->{passwd},
114        sub {
115            my @ch = @_;
116            my $user = $ch[0] or return;
117            # TODO add check ?
118            foreach (@password_fields) {
119                $self->{users}{$user}{$_} = shift(@ch);
120            }
121            if ($self->{users}{$user}{password} =~ /^!!/) {
122                $self->{users}{$user}{password} =~ s/^!!//;
123                $self->{users}{$user}{locked} = 1;
124            }
125            $self->{users}{$user}{shell} ||= '';
126            $self->{users}{$user}{shell} =~ s/^-//;
127            $self->{users}{$user}{_id} = $user;
128        },
129    ) or do {
130        $self->log(LA_ERR, "Cannot parse %s", $self->{passwd});
131        return;
132    };
133   
134    $self->_load_unix_file(
135        $self->{group},
136        sub {
137            my @ch = @_;
138            my $group = $ch[0];
139
140            foreach (@group_fields) {
141                $self->{groups}{$group}{$_} = shift(@ch);
142            }
143            $self->{groups}{$group}{_id} = $group;
144
145            # split user in the group
146            foreach (split(',', ($self->{groups}{$group}{'user_list'} || ''))) {
147                $self->{groups}{$group}{'users'}{$_} = 1;
148            }
149        }
150    ) or do {
151        $self->log(LA_ERR, "Cannot parse %s", $self->{group});
152        return;
153    };
154
155    # Post processing group for split group because nis
156    foreach my $group (keys %{$self->{groups} || {}}) {
157        if (my ($realgroup) = $group =~ /(.*)_\d\d$/) {
158            if (exists($self->{groups}{$realgroup}) &&
159                $self->{groups}{$realgroup}{gid} == $self->{groups}{$group}{gid}) {
160               # for sure, it's the same
161                foreach (keys %{$self->{groups}{$group}{'users'} || {}}) {
162                    $self->{groups}{$realgroup}{'users'}{$_} = 1;
163                }
164                delete($self->{groups}{$group});
165            }
166        }
167    }
168
169    # using shadow ? then reading shadow file
170    if ($self->{use_shadow}) {
171
172    $self->_load_unix_file(
173        $self->{shadow},
174        sub {
175            my @ch = @_;
176            my $user = $ch[0];
177            foreach (@shadow_fields) {
178                $self->{users}{$user}{$_} = shift(@ch);
179            }
180            if ($self->{users}{$user}{spassword} =~ /^!!/) {
181                $self->{users}{$user}{spassword} =~ s/^!!//;
182                $self->{users}{$user}{locked} = 1;
183            }
184        }
185    ) or do {
186        $self->log(LA_ERR, "Cannot parse %s", $self->{shadow});
187        return;
188    };
189
190    $self->_load_unix_file(
191        $self->{gshadow},
192        sub {
193            my @ch = @_;
194            my $group = $ch[0];
195            # TODO add check ?
196            foreach (@gshadow_fields) {
197                $self->{groups}{$group}{$_} = shift(@ch);
198            }
199            # split user in the group
200            foreach (split(',', $self->{groups}{$group}{'suser_list'} || '')) {
201                $self->{groups}{$group}{'susers'}{$_} = 1;
202            }
203        }
204    ) or do {
205        $self->log(LA_ERR, "Cannot parse %s", $self->{gshadow});
206        return;
207    };
208
209    } # use shadow ?
210
211    $self->{_loaded} = 1;
212
213    1;
214}
215
216sub _save_unix_file {
217    my ($self, $file, @data) = @_;
218    my $enc = find_encoding($self->config('encoding') || 'iso-8859-14')
219        or do {
220        $self->log(LA_ERROR, "Cannot find encoding %s", $self->config('encoding') || 'iso-8859-15');
221        return;
222    };
223    open(my $handle, '>>', $file) or do {
224        la_log(LA_ERR, "Cannot open unix file `%s' for writing (%s)", $file, $!);
225        return;
226    };
227    flock($handle, LOCK_EX);
228    truncate($handle, 0);
229    foreach my $line (@data) {
230        my $string = join(':', map { my $f = $_; $f =~ s/:/;/g; $f } map { defined($_) ? $_ : '' } @$line) . "\n";
231        $string = decode('utf8', $string);
232        print $handle $string;
233    }
234    close($handle);
235    $self->log(LA_INFO, $file . " saved");
236    return 1;
237}
238
239sub _commit {
240    my ($self) = @_;
241
242    $self->_save_unix_file(
243        $self->{passwd},
244        map {[
245            $_,
246            ($self->{users}{$_}{locked}
247                ? '!!' . ($self->{users}{$_}{password} || '')
248                : ($self->{users}{$_}{password} || 'x')), # No empty pass !!
249            $self->{users}{$_}{uidNumber},
250            $self->{users}{$_}{gidNumber},
251            $self->{users}{$_}{gecos} || '',
252            $self->{users}{$_}{home} || '/dev/null',
253            ($self->{users}{$_}{locked} ? '-' : '') . ($self->{users}{$_}{shell}
254                || '/bin/false'),
255        ]} sort { $self->{users}{$a}{uidNumber} <=> $self->{users}{$b}{uidNumber} } keys %{$self->{users}}
256    ) or return;
257
258    my @grouplines = ();
259    foreach (
260        sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} }
261        keys %{$self->{groups}}) {
262        my @gline = ($_, $self->{groups}{$_}{password} || 'x',
263            $self->{groups}{$_}{gid},
264            join(',', sort keys %{$self->{groups}{$_}{users} || {}}),
265        );
266        if (length(join(':', @gline)) >= 1023) {
267            $self->{nis_overflow} ||= '';
268            if ($self->{nis_overflow} eq 'kill') {
269                $gline[3] = 'LINE_TOO_LONG';
270            } elsif ($self->{nis_overflow} eq 'truncate') {
271                my $len = length(join(':', @gline[0 .. 2])) + 1;
272                my @users = sort keys %{$self->{groups}{$_}{users} || {}};
273                while (@users && $len + length(join(',', @users)) >= 1023) {
274                    pop(@users);
275                }
276                $gline[3] = join(',', @users);
277            } elsif($self->{nis_overflow} eq 'split') {
278                my @users = sort keys %{$self->{groups}{$_}{users} || {}};
279                my $count = 0;
280                my @nextusers;
281                while (my $u = shift(@users)) {
282                    my $needflush = 0;
283                    if (length(join(':', @gline[0 .. 2])) + 1 +
284                        length(join(',', (@nextusers, $u))) >= 1023) {
285                        unshift(@users, $u);
286                        $needflush = 1;
287                    } else {
288                        push(@nextusers, $u);
289                    }
290                    if (!@users || $needflush) {
291                        push(@grouplines, [
292                            $gline[0] . ($count ? sprintf('_%02d', $count) :''),
293                            $gline[1],
294                            $gline[2],
295                            join(',', @nextusers) ]
296                        );
297                        @nextusers = (); $count++;
298                    }
299                }
300                next;
301            }
302        }
303        push(@grouplines, \@gline);
304    }
305    $self->_save_unix_file(
306        $self->{group},
307        @grouplines,
308    ) or return;
309
310    if ($self->{use_shadow}) {
311
312    $self->_save_unix_file(
313        $self->{shadow},
314        map {[
315            $_,
316            ($self->{users}{$_}{locked}
317                ? '!!' . ($self->{users}{$_}{spassword} || '')
318                : $self->{users}{$_}{spassword} || 'x'),
319            $self->{users}{$_}{last_changed},
320            $self->{users}{$_}{before_ch},
321            $self->{users}{$_}{after_ch},
322            $self->{users}{$_}{exp_warn},
323            $self->{users}{$_}{exp_disable},
324            $self->{users}{$_}{disable},
325            $self->{users}{$_}{res},
326        ]} sort { $self->{users}{$a}{uidNumber} <=> $self->{users}{$b}{uidNumber} } keys %{$self->{users}}
327    ) or return;
328
329
330    $self->_save_unix_file(
331        $self->{gshadow},
332        map {[
333            $_,
334            $self->{groups}{$_}{spassword} || 'x',
335            $self->{groups}{$_}{unknown},
336            join(',', keys %{$self->{groups}{$_}{susers} || {}}), 
337        ]} sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} } keys %{$self->{groups}}
338    ) or return;
339
340    } # If use shadow
341
342    1
343}
344
345sub list_objects {
346    my ($self, $otype) = @_;
347
348    # objects are store into sub ref:
349    my $internal_obj = {
350        user => 'users',
351        group => 'groups',
352    }->{$otype} or return;
353    my @obj = sort keys %{$self->{$internal_obj} || {} };
354    for ($otype) {
355        /^user$/ and
356            return grep { $self->{$internal_obj}{$_}{uidNumber} >= ($self->{min_uid} || 0) } @obj;
357        /^group$/ and
358            return grep { $self->{$internal_obj}{$_}{gid} >= ($self->{min_gid} || 0) } @obj;
359    }
360}
361
362sub create_object {
363    my ($self, $otype, $id, %gdata) = @_;
364
365    my %data;
366
367    foreach my $attr (keys %gdata) {
368        if (my $oattr = $self->attribute($otype, $attr)) {
369            $data{ $oattr->iname } = $gdata{$attr};
370        } else {
371            $data{$attr} = $gdata{$attr};
372        }   
373    }
374
375    # objects are store into sub ref:
376    my $internal_obj = {
377        user => 'users',
378        group => 'groups',
379    }->{$otype};
380    for ($otype) {
381        if (/^user$/ && (!defined($data{uidNumber}) || !defined($data{gidNumber}))) {
382            $self->log(LA_ERR, "uid or gid missing to create $otype");
383            return;
384        }
385        if(/^group$/ && !defined($data{gid})) {
386            $self->log(LA_ERR, "gid missing to create $otype");
387            return;
388        }
389    }
390
391    if ($self->{$internal_obj}{$id}) {
392        $self->log(LA_ERR, "Object %s.%s already exists", $otype, $id);
393        return
394    }
395
396    $self->{$internal_obj}{$id} = {
397        account => $id,
398        uid => $data{uid},
399        gid => $data{gid},
400        uidNumber => $data{uidNumber},
401        gidNumber => $data{gidNumber},
402        _id => $id,
403    };
404
405    my $obj = $self->get_object($otype, $id) or do {
406        $self->log(LA_ERR, "Cannot find freshly create $otype $id");
407        return;
408    };
409
410    $obj->set_fields(%data) or return;
411    $obj
412}
413
414sub _delete_object {
415    my ($self, $otype, $id, %data) = @_;
416
417    # objects are store into sub ref:
418    my $internal_obj = {
419        user => 'users',
420        group => 'groups',
421    }->{$otype};
422    delete $self->{$internal_obj}{$id};
423    1
424}
425
426sub _rename_object {
427    my ($self, $otype, $id, $newid) = @_;
428    my $internal_obj = {
429        user => 'users',
430        group => 'groups',
431    }->{$otype};
432   
433    if (exists($self->{$internal_obj}{$newid})) {
434        $self->log(LA_ERR, 'cannot rename %s/%s, %s already exists',
435            $otype, $id, $newid);
436        return;
437   }
438
439   $self->{$internal_obj}{$newid} = $self->{$internal_obj}{$id};
440   delete($self->{$internal_obj}{$id});
441
442   1
443}
444
4451;
446
447__END__
448
449=head1 SEE ALSO
450
451=head1 AUTHOR
452
453Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
454
455=head1 COPYRIGHT AND LICENSE
456
457Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
458
459This library is free software; you can redistribute it and/or modify
460it under the same terms as Perl itself, either Perl version 5.10.0 or,
461at your option, any later version of Perl 5 you may have available.
462
463
464=cut
Note: See TracBrowser for help on using the repository browser.