File Coverage

blib/lib/User/AccountChecker.pm

Criterion	Covered	Total	%
statement	9	33	27.2
branch	0	12	0.0
condition			n/a
subroutine	3	9	33.3
pod	6	6	100.0
total	18	60	30.0

package User::AccountChecker;

use warnings;
use strict;

use FindBin qw($Bin $Script);

=head1 NAME

User::AccountChecker - I

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';


=head1 SYNOPSIS

S
I>

A little code snippet :

    use User::AccountChecker;

    my $uuac = User::AccountChecker->new();
    # need to identify current user
    die("You are not allowed to continue.\n") unless($uuac->isuser('root'));

    # check if root user
    if ($uuac->isroot) {
        print("You are root.\n");
    } else {
        print("You are not root.\n");
    }

    # need root permissions for a shell command
    my $shellcommand = $uuac->shellrootcmd("cat /etc/shadow");
    # if current user is root, $shellcommand == "cat /etc/shadow"
    # otherwise, $shellcommand == "sudo cat /etc/shadow", and
    # $ENV{'SUDO_ASKPASS'} if ssh-askpass is installed

    # force a script to be runned as root
    $uuac->runasroot(@ARGV);
    # $uuac->isroot() should be true

    # need root permissions to continue
    $uuac->musttoberoot();
    print("if you see this message then you get root permissions.\n");

=head1 SUBROUTINES/METHODS

=head2 new

Cnew()>

I

=over 4

=item

return new instance of User::AccountChecker

=back

=cut

sub new {
    my ($this) = shift;
    return bless({}, $this);
}

=head2 isuser

C<$object-Eisuser($name)>

I>.>

=over 4

=item

S>        the name of the user account to check>

=item

return true if the current user is B>, false otherwise

=back

=cut

sub isuser {
    my ($this, $name) = @_;
    return ($name eq getpwuid($<)) ? 1 : 0;
}

=head2 isroot

C<$object-Eisroot()>

I

=over 4

=item

return true if the current user is root, false otherwise

=back

=cut

sub isroot {
    my ($this) = shift;
    return $this->isuser("root");
}

=head2 musttoberoot

C<$object-Emusttoberoot()>

S
I>

=cut

sub musttoberoot {
    my ($this) = shift;
    unless ($this->isroot) {
        die("You must to be logged as root.");
    }
}

=head2 shellrootcmd

C<$object-Eshellrootcmd($command)>

S> if it is founded.>
I>

=over 4

=item

S>        the command to wich add sudo>

=item

return B> with sudo prefix if the current user isn't root, else return B>

=back

=cut

sub shellrootcmd {
    my ($this, $cmd) = @_;
    # current user is root
    return $cmd if ($this->isroot);
    # current user is not root
    # ask pass
    my $askpass =  `which ssh-askpass`;
    chomp($askpass);
    if (-e $askpass) {
        $ENV{'SUDO_ASKPASS'} = $askpass;
    }
    $cmd =~ s/(&&|\|)/$1 sudo/ig;
    return 'sudo '.$cmd;
}

=head2 runasroot

C<$object-Erunasroot($commandargs)>

I

=over 4

=item

S>        the command arguments (eg. @ARGV)>

=back

=cut

sub runasroot {
    my ($this, @args) = @_;
    if (!$this->isroot()) {
        my $sargs   = (@args > 0) ? ' '.join(' ', @args) : '';
        my $cmd     = $this->shellrootcmd('su -c "'.$Bin.'/'.$Script.$sargs.'"');
        chomp($cmd);
        system($cmd);
        exit 0;
    }
}

=head1 AUTHOR

Eric Villard, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc User::AccountChecker


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2010 Eric Villard.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of User::AccountChecker