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

package LATMOS::Accounts::Bases::Unix;

use 5.010000;
use strict;
use warnings;

use base qw(LATMOS::Accounts::Bases);
use LATMOS::Accounts::Log;

our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];

=head1 NAME

LATMOS::Ad - Perl extension for blah blah blah

=head1 SYNOPSIS

  use LATMOS::Accounts::Bases;
  my $base = LATMOS::Accounts::Bases->new('unix');
  ...

=head1 DESCRIPTION

Account base access over standard unix file format.

=head1 FUNCTIONS

=cut

=head2 new(%options)

Create a new LATMOS::Ad object for windows AD $domain.

domain / server: either the Ad domain or directly the server

ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.

=cut

sub new {
    my ($class, %options) = @_;
    
    my $base = {
        passwd =>  $options{passwd} || '/etc/passwd',
        shadow =>  $options{shadow} || '/etc/shadow',
        group =>   $options{group} || '/etc/group',
        gshadow => $options{gshadow} || '/etc/gshadow',
        # are we using shadow, default to yes
        use_shadow => (defined($options{use_shadow}) ? $options{use_shadow} : 1),
        min_gid => $options{min_gid},
        min_uid => $options{min_uid},
        users => {},
        groups => {},
    };

    bless($base, $class);
}

sub _canonicals_fields {
    my ($self, $type, $for) = @_;
    $type = lc($type);
    {
        user => {
            uidNumber       => 'uid',
            gidNumber       => 'gid',
            displayName     => 'gecos',
            gecos           => 'gecos',
            homeDirectory   => 'home',
            loginShell      => 'shell',
            userPassword    => ($self->{use_shadow} ? 'spassword' : 'password'),
            memberOf        => 'memberOf',
            locked          => 'locked',
            ($for !~ /w/ ? (
            givenName       => 'givenName',
            sn              => 'sn',
            uid             => 'login',
            sAMAccountName  => 'login',
            ) : ()),
            $self->{use_shadow} ?
            (
            shadowLastChange => 'last_changed',
            shadowMin       => 'before_ch',
            shadowMax       => 'after_ch',
            shadowWarning   => 'exp_warn',
            shadowInactive  => 'exp_disable',
            shadowExpire    => 'disable',
            shadowFlag      => 'res',
            ) : (), 
            # description => not supported
        },
        group => {
            ($for !~ /w/ ? (
            sAMAccountName  => 'group_name',
            ) : ()),
            gidNumber       => 'gid',
            memberUID       => 'user_list',
        },
    }->{$type}
}

sub list_canonical_fields {
    my ($self, $type, $for) = @_;
    $for ||= 'rw';
    keys %{ $self->_canonicals_fields($type, $for) || {} }
}

sub get_field_name {
    my ($self, $type, $cfield, $for) = @_;
    $for ||= 'rw';
    ($self->_canonicals_fields($type, $for) || {})->{$cfield}
}

my @password_fields = qw(account password uid gid gecos home shell);
my @shadow_fields =   qw(account spassword last_changed before_ch after_ch exp_warn exp_disable disable res);
my @group_fields =    qw(group_name passwd gid user_list);
my @gshadow_fields =  qw(group_name spassword unknown suser_list);

# All UNIX account file are colon separated field
# This function factorize open/read/split fields

sub _load_unix_file {
    my ($self, $file, $callback) = @_;
    open(my $handle, '<', $file) or do {
        la_log(LA_ERR, "Cannot open unix file `%s' for reading (%s)", $file, $!);
        return;
    };
    while (my $line = <$handle>) {
        chomp($line);
        my @ch = split(':', $line);
        $callback->(@ch);
    }
    close($handle);
    return 1;
}

=head2 load

Read file and load data into memory

=cut

sub load {
    my ($self) = @_;
    
    $self->_load_unix_file(
        $self->{passwd},
        sub {
            my @ch = @_;
            my $user = $ch[0] or return;
            # TODO add check ?
            foreach (@password_fields) {
                $self->{users}{$user}{$_} = shift(@ch);
            }
            if ($self->{users}{$user}{password} =~ /^!!/) {
                $self->{users}{$user}{password} =~ s/^!!//;
                $self->{users}{$user}{locked} = 1;
            }
            $self->{users}{$user}{shell} =~ s/^-//;
        },
    ) or return;
    
    $self->_load_unix_file(
        $self->{group},
        sub {
            my @ch = @_;
            my $group = $ch[0];
            # TODO add check ?
            foreach (@group_fields) {
                $self->{groups}{$group}{$_} = shift(@ch);
            }
            # split user in the group
            foreach (split(',', ($self->{groups}{$group}{'user_list'} || ''))) {
                $self->{groups}{$group}{'users'}{$_} = 1;
            }
        }
    ) or return;

    # using shadow ? then reading shadow file
    if ($self->{use_shadow}) {

    $self->_load_unix_file(
        $self->{shadow},
        sub {
            my @ch = @_;
            my $user = $ch[0];
            foreach (@shadow_fields) {
                $self->{users}{$user}{$_} = shift(@ch);
            }
            if ($self->{users}{$user}{spassword} =~ /^!!/) {
                $self->{users}{$user}{spassword} =~ s/^!!//;
                $self->{users}{$user}{locked} = 1;
            }
        }
    ) or return;

    $self->_load_unix_file(
        $self->{gshadow},
        sub {
            my @ch = @_;
            my $group = $ch[0];
            # TODO add check ?
            foreach (@gshadow_fields) {
                $self->{groups}{$group}{$_} = shift(@ch);
            }
            # split user in the group
            foreach (split(',', $self->{groups}{$group}{'suser_list'} || '')) {
                $self->{groups}{$group}{'susers'}{$_} = 1;
            }
        }
    ) or return;

    } # use shadow ?

    1;
}

sub _save_unix_file {
    my ($self, $file, @data) = @_;
    open(my $handle, '>', $file) or do {
        la_log(LA_ERR, "Cannot open unix file `%s' for writing (%s)", $file, $!);
        return;
    };
    foreach my $line (@data) {
        print $handle join(':', map { defined($_) ? $_ : '' } @$line) . "\n";
    }
    close($handle);
    return 1;
}

sub _commit {
    my ($self) = @_;

    $self->_save_unix_file(
        $self->{passwd},
        map {[
            $_,
            ($self->{users}{$_}{locked}
                ? '!!' . ($self->{users}{$_}{password} || '')
                : ($self->{users}{$_}{password} || 'x')), # No empty pass !!
            $self->{users}{$_}{uid},
            $self->{users}{$_}{gid},
            $self->{users}{$_}{gecos} || '',
            $self->{users}{$_}{home} || '/dev/null',
            ($self->{users}{$_}{locked} ? '-' : '') . ($self->{users}{$_}{shell}
                || '/bin/false'),
        ]} sort { $self->{users}{$a}{uid} <=> $self->{users}{$b}{uid} } keys %{$self->{users}}
    ) or return;

    $self->_save_unix_file(
        $self->{group},
        map {[
            $_,
            $self->{groups}{$_}{password} || 'x',
            $self->{groups}{$_}{gid},
            join(',', keys %{$self->{groups}{$_}{users} || {}}), 
        ]} sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} } keys %{$self->{groups}}
    ) or return;

    if ($self->{use_shadow}) {

    $self->_save_unix_file(
        $self->{shadow},
        map {[
            $_,
            ($self->{users}{$_}{locked}
                ? '!!' . ($self->{users}{$_}{spassword} || '')
                : $self->{users}{$_}{spassword} || 'x'),
            $self->{users}{$_}{last_changed},
            $self->{users}{$_}{before_ch},
            $self->{users}{$_}{after_ch},
            $self->{users}{$_}{exp_warn},
            $self->{users}{$_}{exp_disable},
            $self->{users}{$_}{disable},
            $self->{users}{$_}{res},
        ]} sort { $self->{users}{$a}{uid} <=> $self->{users}{$b}{uid} } keys %{$self->{users}}
    ) or return;


    $self->_save_unix_file(
        $self->{gshadow},
        map {[
            $_,
            $self->{groups}{$_}{spassword} || 'x',
            $self->{groups}{$_}{unknown},
            join(',', keys %{$self->{groups}{$_}{susers} || {}}), 
        ]} sort {  $self->{groups}{$a}{gid} <=> $self->{groups}{$b}{gid} } keys %{$self->{groups}}
    ) or return;

    } # If use shadow

    1
}

sub list_objects {
    my ($self, $otype) = @_;

    # objects are store into sub ref:
    my $internal_obj = {
        user => 'users',
        group => 'groups',
    }->{$otype};
    my @obj = sort keys %{$self->{$internal_obj} || {} };
    for ($otype) {
        /^user$/ and
            return grep { $self->{$internal_obj}{$_}{uid} >= ($self->{min_uid} || 0) } @obj;
        /^group$/ and
            return grep { $self->{$internal_obj}{$_}{gid} >= ($self->{min_gid} || 0) } @obj;
    }
}

sub create_object {
    my ($self, $otype, $id, %data) = @_;

    # objects are store into sub ref:
    my $internal_obj = {
        user => 'users',
        group => 'groups',
    }->{$otype};
    for ($otype) {
        /^user$/ && !defined($data{uid}) && !defined($data{gid}) and return;
        /^group$/ && !defined($data{gid}) and return;
    }

    if ($self->{$internal_obj}{$id}) { return };
    $self->{$internal_obj}{$id} = {
        account => $id,
        uid => $data{uid},
        gid => $data{gid},
    };
    my $obj = $self->get_object($otype, $id) or return;
    $obj->set_fields(%data);
    $obj
}

sub delete_object {
    my ($self, $otype, $id, %data) = @_;

    # objects are store into sub ref:
    my $internal_obj = {
        user => 'users',
        group => 'groups',
    }->{$otype};
    delete $self->{$internal_obj}{$id};
    1
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.


=cut