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

Last change on this file since 1123 was 1123, checked in by nanardon, 12 years ago

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