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

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