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

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