view release on metacpan or  search on metacpan

lib/Ubic/Credentials/OS/POSIX.pm  view on Meta::CPAN

package Ubic::Credentials::OS::POSIX;
$Ubic::Credentials::OS::POSIX::VERSION = '1.60';
use strict;
use warnings;

use parent qw(Ubic::Credentials);

# ABSTRACT: POSIX-specific credentials implementation


use List::MoreUtils qw(uniq);

use Params::Validate qw(:all);
use Carp;

sub new {
    my $class = shift;
    my $params = validate(@_, {
        user => 0,
        group => 0,
        service => { optional => 1, isa => 'Ubic::Service' },
    });

    my $self = {};
    if (defined $params->{user}) {
        if (defined $params->{service}) {
            croak "Only one of 'user' and 'service' parameters should be specified";
        }
        $self->{user} = $params->{user};
        $self->{group} = $params->{group} if defined $params->{group};
    }
    elsif (defined $params->{service}) {
        $self->{user} = $params->{service}->user;
        my @group = $params->{service}->group;
        $self->{group} = [ @group ] if @group;
    }
    else {
        $self->{real_user_id} = $<;
        $self->{effective_user_id} = $>;
        $self->{real_group_id} = [ split / /, $( ];
        $self->{effective_group_id} = [ split / /, $) ];
        # TODO - derive user from real_user_id when user is not specified (or from effective_user_id?!)
    }

    return bless $self => $class;
}

sub user {
    my $self = shift;
    unless (defined $self->{user}) {
        my $user = getpwuid($>);
        unless (defined $user) {
            die "failed to get user name by uid $>";
        }
        $self->{user} = $user;
    }
    return $self->{user};
}

sub group {
    my $self = shift;
    unless (defined $self->{group}) {
        $self->_user2group;
    }
    unless (ref $self->{group}) {
        $self->{group} = [ $self->{group} ];
    }
    return @{ $self->{group} };
}

sub _user2uid {
    my $self = shift;
    my $user = $self->user;
    my $id = scalar getpwnam($user);
    unless (defined $id) {
        die "user $user not found";
    }
    return $id;
}

sub real_user_id {
    my $self = shift;
    return $self->{real_user_id} if defined $self->{real_user_id};
    return $self->_user2uid;
}

sub effective_user_id {
    my $self = shift;
    return $self->{effective_user_id} if defined $self->{effective_user_id};
    return $self->_user2uid;
}

sub _group2gid {
    my $self = shift;
    my @group = $self->group;
    my @gid;
    for my $group (@group) {
        my $gid = getgrnam($group);
        unless (defined $gid) {
            croak "group $group not found";
        }
        push @gid, $gid;
    }
    @gid = (@gid, @gid) if @gid == 1; # otherwise $) = "1 0"; $) = "1" leaves 0 in group list
    return @gid;