view release on metacpan or  search on metacpan

lib/Unix/setuid.pm  view on Meta::CPAN

package Unix::setuid;

our $DATE = '2014-10-09'; # DATE
our $VERSION = '0.02'; # VERSION

use 5.010001;
use strict;
use warnings;

use POSIX qw();

use Exporter qw(import);
our @EXPORT = qw($RUID $EUID $RUSER $EUSER);

our $RUID ; tie $RUID , 'Unix::setuid::ruid'  or die "Can't tie \$RUID";
our $EUID ; tie $EUID , 'Unix::setuid::euid'  or die "Can't tie \$EUID";
our $RUSER; tie $RUSER, 'Unix::setuid::ruser' or die "Can't tie \$RUSER";
our $EUSER; tie $EUSER, 'Unix::setuid::euser' or die "Can't tie \$EUSER";

{
    package Unix::setuid::ruid;
    sub TIESCALAR { bless [], $_[0] }
    sub FETCH     { $< }
    sub STORE     { $< = $_[1] }
}

{
    package Unix::setuid::euid;
    sub TIESCALAR { bless [], $_[0] }
    sub FETCH     { $> }
    sub STORE     { $> = $_[1] }
}

{
    package Unix::setuid::ruser;
    sub TIESCALAR { bless [], $_[0] }
    sub FETCH     { my @pw = getpwuid($<); @pw ? $pw[0] : $< }
    sub STORE     {
        if ($_[1] =~ /\A\d+\z/) {
            $< = $_[1];
        } else {
            my @pw = getpwuid($_[1]);
            die "No such user '$_[1]'" unless @pw;
            $< = $pw[2];
        }
    }
}

{
    package Unix::setuid::euser;
    sub TIESCALAR { bless [], $_[0] }
    sub FETCH     { my @pw = getpwuid($>); @pw ? $pw[0] : $> }
    sub STORE     {
        if ($_[1] =~ /\A\d+\z/) {
            $> = $_[1];
        } else {
            my @pw = getpwnam($_[1]);
            die "No such user '$_[1]'" unless @pw;
            $> = $pw[2];
        }
    }
}

1;
#ABSTRACT: Get/set real/effective UID/username via (localizeable) variable

__END__

=pod

=encoding UTF-8

=head1 NAME

Unix::setuid - Get/set real/effective UID/username via (localizeable) variable

=head1 VERSION

This document describes version 0.02 of Unix::setuid (from Perl distribution Unix-setuid), released on 2014-10-09.

=head1 SYNOPSIS

 use Unix::setuid; # exports $RUID, $EUID, $RUSER, $EUSER
 say "Real      UID : $RUID";
 say "Effective UID : $EUID";
 say "Real username : $RUSER";
 say "Effective user: $EUSER";
 {
     # become UID 1000 temporarily
     local $EUID = 1000;
     # same thing
     #local $EUSER = "jajang"; # or 1000
 }
 # we're back to previous UID/user

=head1 DESCRIPTION

This module is inspired by L<File::chdir> and L<File::umask>, using a tied
scalar variable to get/set stuffs. One benefit of this is being able to use
Perl's "local" with it, effectively setting something locally.

=head1 EXPORTS

=head2 $RUID (real UID)

This will get/set C<< $< >>.

=head2 $EUID (effective UID)

This will get/set C<< $> >>.

=head2 $RUSER (real user)