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

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

Fix id information into Unix base
  • Property svn:keywords set to Id Rev
File size: 12.4 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$ =~ /^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 uid gid 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 return;
130   
131    $self->_load_unix_file(
132        $self->{group},
133        sub {
134            my @ch = @_;
135            my $group = $ch[0];
136
137            foreach (@group_fields) {
138                $self->{groups}{$group}{$_} = shift(@ch);
139            }
140            $self->{groups}{$group}{_id} = $group;
141
142            # split user in the group
143            foreach (split(',', ($self->{groups}{$group}{'user_list'} || ''))) {
144                $self->{groups}{$group}{'users'}{$_} = 1;
145            }
146        }
147    ) or return;
148
149    # Post processing group for split group because nis
150    foreach my $group (keys %{$self->{groups} || {}}) {
151        if (my ($realgroup) = $group =~ /(.*)_\d\d$/) {
152            if (exists($self->{groups}{$realgroup}) &&
153                $self->{groups}{$realgroup}{gid} == $self->{groups}{$group}{gid}) {
154               # for sure, it's the same
155                foreach (keys %{$self->{groups}{$group}{'users'} || {}}) {
156                    $self->{groups}{$realgroup}{'users'}{$_} = 1;
157                }
158                delete($self->{groups}{$group});
159            }
160        }
161    }
162
163    # using shadow ? then reading shadow file
164    if ($self->{use_shadow}) {
165
166    $self->_load_unix_file(
167        $self->{shadow},
168        sub {
169            my @ch = @_;
170            my $user = $ch[0];
171            foreach (@shadow_fields) {
172                $self->{users}{$user}{$_} = shift(@ch);
173            }
174            if ($self->{users}{$user}{spassword} =~ /^!!/) {
175                $self->{users}{$user}{spassword} =~ s/^!!//;
176                $self->{users}{$user}{locked} = 1;
177            }
178        }
179    ) or return;
180
181    $self->_load_unix_file(
182        $self->{gshadow},
183        sub {
184            my @ch = @_;
185            my $group = $ch[0];
186            # TODO add check ?
187            foreach (@gshadow_fields) {
188                $self->{groups}{$group}{$_} = shift(@ch);
189            }
190            # split user in the group
191            foreach (split(',', $self->{groups}{$group}{'suser_list'} || '')) {
192                $self->{groups}{$group}{'susers'}{$_} = 1;
193            }
194        }
195    ) or return;
196
197    } # use shadow ?
198
199    $self->{_loaded} = 1;
200
201    1;
202}
203
204sub _save_unix_file {
205    my ($self, $file, @data) = @_;
206    my $enc = find_encoding($self->config('encoding') || 'iso-8859-14')
207        or do {
208        $self->log(LA_ERROR, "Cannot find encoding %s", $self->config('encoding') || 'iso-8859-15');
209        return;
210    };
211    open(my $handle, '>>', $file) or do {
212        la_log(LA_ERR, "Cannot open unix file `%s' for writing (%s)", $file, $!);
213        return;
214    };
215    flock($handle, LOCK_EX);
216    truncate($handle, 0);
217    foreach my $line (@data) {
218        my $string = join(':', map { my $f = $_; $f =~ s/:/;/g; $f } map { defined($_) ? $_ : '' } @$line) . "\n";
219        $string = decode('utf8', $string);
220        print $handle $string;
221    }
222    close($handle);
223    $self->log(LA_INFO, $file . " saved");
224    return 1;
225}
226
227sub _commit {
228    my ($self) = @_;
229
230    $self->_save_unix_file(
231        $self->{passwd},
232        map {[
233            $_,
234            ($self->{users}{$_}{locked}
235                ? '!!' . ($self->{users}{$_}{password} || '')
236                : ($self->{users}{$_}{password} || 'x')), # No empty pass !!
237            $self->{users}{$_}{uid},
238            $self->{users}{$_}{gid},
239            $self->{users}{$_}{gecos} || '',
240            $self->{users}{$_}{home} || '/dev/null',
241            ($self->{users}{$_}{locked} ? '-' : '') . ($self->{users}{$_}{shell}
242                || '/bin/false'),
243        ]} sort { $self->{users}{$a}{uid} <=> $self->{users}{$b}{uid} } keys %{$self->{users}}
244    ) or return;
245
246    my @grouplines = ();
247    foreach (
248        sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} }
249        keys %{$self->{groups}}) {
250        my @gline = ($_, $self->{groups}{$_}{password} || 'x',
251            $self->{groups}{$_}{gid},
252            join(',', sort keys %{$self->{groups}{$_}{users} || {}}),
253        );
254        if (length(join(':', @gline)) >= 1023) {
255            $self->{nis_overflow} ||= '';
256            if ($self->{nis_overflow} eq 'kill') {
257                $gline[3] = 'LINE_TOO_LONG';
258            } elsif ($self->{nis_overflow} eq 'truncate') {
259                my $len = length(join(':', @gline[0 .. 2])) + 1;
260                my @users = sort keys %{$self->{groups}{$_}{users} || {}};
261                while (@users && $len + length(join(',', @users)) >= 1023) {
262                    pop(@users);
263                }
264                $gline[3] = join(',', @users);
265            } elsif($self->{nis_overflow} eq 'split') {
266                my @users = sort keys %{$self->{groups}{$_}{users} || {}};
267                my $count = 0;
268                my @nextusers;
269                while (my $u = shift(@users)) {
270                    my $needflush = 0;
271                    if (length(join(':', @gline[0 .. 2])) + 1 +
272                        length(join(',', (@nextusers, $u))) >= 1023) {
273                        unshift(@users, $u);
274                        $needflush = 1;
275                    } else {
276                        push(@nextusers, $u);
277                    }
278                    if (!@users || $needflush) {
279                        push(@grouplines, [
280                            $gline[0] . ($count ? sprintf('_%02d', $count) :''),
281                            $gline[1],
282                            $gline[2],
283                            join(',', @nextusers) ]
284                        );
285                        @nextusers = (); $count++;
286                    }
287                }
288                next;
289            }
290        }
291        push(@grouplines, \@gline);
292    }
293    $self->_save_unix_file(
294        $self->{group},
295        @grouplines,
296    ) or return;
297
298    if ($self->{use_shadow}) {
299
300    $self->_save_unix_file(
301        $self->{shadow},
302        map {[
303            $_,
304            ($self->{users}{$_}{locked}
305                ? '!!' . ($self->{users}{$_}{spassword} || '')
306                : $self->{users}{$_}{spassword} || 'x'),
307            $self->{users}{$_}{last_changed},
308            $self->{users}{$_}{before_ch},
309            $self->{users}{$_}{after_ch},
310            $self->{users}{$_}{exp_warn},
311            $self->{users}{$_}{exp_disable},
312            $self->{users}{$_}{disable},
313            $self->{users}{$_}{res},
314        ]} sort { $self->{users}{$a}{uid} <=> $self->{users}{$b}{uid} } keys %{$self->{users}}
315    ) or return;
316
317
318    $self->_save_unix_file(
319        $self->{gshadow},
320        map {[
321            $_,
322            $self->{groups}{$_}{spassword} || 'x',
323            $self->{groups}{$_}{unknown},
324            join(',', keys %{$self->{groups}{$_}{susers} || {}}), 
325        ]} sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} } keys %{$self->{groups}}
326    ) or return;
327
328    } # If use shadow
329
330    1
331}
332
333sub list_objects {
334    my ($self, $otype) = @_;
335
336    # objects are store into sub ref:
337    my $internal_obj = {
338        user => 'users',
339        group => 'groups',
340    }->{$otype} or return;
341    my @obj = sort keys %{$self->{$internal_obj} || {} };
342    for ($otype) {
343        /^user$/ and
344            return grep { $self->{$internal_obj}{$_}{uid} >= ($self->{min_uid} || 0) } @obj;
345        /^group$/ and
346            return grep { $self->{$internal_obj}{$_}{gid} >= ($self->{min_gid} || 0) } @obj;
347    }
348}
349
350sub create_object {
351    my ($self, $otype, $id, %data) = @_;
352
353    # objects are store into sub ref:
354    my $internal_obj = {
355        user => 'users',
356        group => 'groups',
357    }->{$otype};
358    for ($otype) {
359        if (/^user$/ && (!defined($data{uid}) || !defined($data{gid}))) {
360            $self->log(LA_ERR, "uid or gid missing to create $otype");
361            return;
362        }
363        if(/^group$/ && !defined($data{gid})) {
364            $self->log(LA_ERR, "uid or gid missing to create $otype");
365            return;
366        }
367    }
368
369    if ($self->{$internal_obj}{$id}) {
370        $self->log(LA_ERR, "Object %s.%s already exists", $otype, $id);
371        return
372    }
373
374    $self->{$internal_obj}{$id} = {
375        account => $id,
376        uid => $data{uid},
377        gid => $data{gid},
378        _id => $id,
379    };
380
381    my $obj = $self->get_object($otype, $id) or do {
382        $self->log(LA_ERR, "Cannot find freshly create $otype $id");
383        return;
384    };
385
386    $obj->set_fields(%data) or return;
387    $obj
388}
389
390sub _delete_object {
391    my ($self, $otype, $id, %data) = @_;
392
393    # objects are store into sub ref:
394    my $internal_obj = {
395        user => 'users',
396        group => 'groups',
397    }->{$otype};
398    delete $self->{$internal_obj}{$id};
399    1
400}
401
402sub _rename_object {
403    my ($self, $otype, $id, $newid) = @_;
404    my $internal_obj = {
405        user => 'users',
406        group => 'groups',
407    }->{$otype};
408   
409    if (exists($self->{$internal_obj}{$newid})) {
410        $self->log(LA_ERR, 'cannot rename %s/%s, %s already exists',
411            $otype, $id, $newid);
412        return;
413   }
414
415   $self->{$internal_obj}{$newid} = $self->{$internal_obj}{$id};
416   delete($self->{$internal_obj}{$id});
417
418   1
419}
420
4211;
422
423__END__
424
425=head1 SEE ALSO
426
427=head1 AUTHOR
428
429Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
430
431=head1 COPYRIGHT AND LICENSE
432
433Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
434
435This library is free software; you can redistribute it and/or modify
436it under the same terms as Perl itself, either Perl version 5.10.0 or,
437at your option, any later version of Perl 5 you may have available.
438
439
440=cut
Note: See TracBrowser for help on using the repository browser.