#-------------------------------------------------------------------------------
# (C) British Crown Copyright 2006-17 Met Office.
#
# This file is part of FCM, tools for managing and building source code.
#
# FCM is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# FCM is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with FCM. If not, see .
#-------------------------------------------------------------------------------
use strict;
use warnings;
package FCM::Admin::Users::Passwd;
use base qw{FCM::Class::CODE};
use FCM::Admin::Config;
use FCM::Admin::User;
use Text::ParseWords qw{shellwords};
my %ACTION_OF = (
get_users_info => \&_get_users_info,
verify_users => \&_verify_users,
);
__PACKAGE__->class({}, {action_of => {%ACTION_OF}});
my $CONFIG = FCM::Admin::Config->instance();
# Gets a HASH of users using the POSIX password DB.
# %user_of = ($name => , ...)
sub _get_users_info {
my ($attrib_ref, @only_users) = @_;
if (@only_users) {
return _get_only_users_info($attrib_ref, @only_users);
}
my $gid_max = $CONFIG->get_passwd_gid_max();
my $uid_max = $CONFIG->get_passwd_uid_max();
my $gid_min = $CONFIG->get_passwd_gid_min();
my $uid_min = $CONFIG->get_passwd_uid_min();
my %user_of;
USER:
while (my ($name, $uid, $gid, $gecos) = (getpwent())[0, 2, 3, 6]) {
if ( exists($user_of{$name})
|| defined($uid_max) && $uid > $uid_max || $uid < $uid_min
|| defined($gid_max) && $gid > $gid_max || $gid < $gid_min
|| !$gecos
|| (@only_users && grep {$_ eq $name} @only_users)
) {
next USER;
}
my $email = _guess_email_from_gecos($attrib_ref, $gecos);
if (!$email) {
next USER;
}
$user_of{$name} = FCM::Admin::User->new({
name => $name,
display_name => (split(q{,}, $gecos))[0],
email => $email,
});
}
endpwent();
return \%user_of;
}
# Gets a HASH of users matching @only_users using the POSIX password DB.
# %user_of = ($name => , ...)
sub _get_only_users_info {
my ($attrib_ref, @only_users) = @_;
my %user_of;
for my $user (@only_users) {
my ($name, $gecos) = (getpwnam($user))[0, 6];
if ($name && $gecos) {
$user_of{$name} = FCM::Admin::User->new({
name => $name,
display_name => (split(q{,}, $gecos))[0],
email => _guess_email_from_gecos($attrib_ref, $gecos),
});
}
}
return (wantarray() ? %user_of : \%user_of);
}
# Guess a user's email from gecos information
sub _guess_email_from_gecos {
my ($attrib_ref, $gecos) = @_;
my $domain = $CONFIG->get_passwd_email_domain();
my $name = index($gecos, q{,}) > 0 ? (split(q{,}, $gecos))[0] : $gecos;
return ($name =~ qr{\s}msx)
? undef : lc($name) . ($domain ? '@' . $domain : q{});
}
# Return a list of bad users in @users.
sub _verify_users {
my ($attrib_ref, @users) = @_;
grep {!getpwnam($_)} @users;
}
1;
__END__
=head1 NAME
FCM::Admin::Users::Passwd
=head1 SYNOPSIS
use FCM::Admin::Users::Passwd;
my $users_info_util = FCM::Admin::Users::Passwd->new();
$users_info_util->get_users();
=head1 DESCRIPTION
Utility for obtaining user information from passwd information.
=head1 METHODS
=over 4
=item $util->get_users_info()
Return a HASH (in list context) or a reference to a HASH (in scalar context)
{name => , ...}. The HASH should contain all entries
in the passwd database that appear to be real users.
=item $util->verify_users(@users)
Return a list of bad users in @users.
=back
=head1 COPYRIGHT
E<169> Crown copyright Met Office. All rights reserved.
=cut