File Coverage

blib/lib/Unix/Login.pm

Criterion	Covered	Total	%
statement	12	87	13.7
branch	0	42	0.0
condition	0	18	0.0
subroutine	4	8	50.0
pod	2	3	66.6
total	18	158	11.3

# $Id: Login.pm,v 1.8 2003/08/29 22:42:59 nwiger Exp $
####################################################################
#
# Copyright (c) 2000-2003 Nathan Wiger
#
# This is designed to simulate a command-line login on UNIX machines.
# In an array context it returns the std getpwnam array or undef,
# and in a scalar context it returns just the username or undef if
# the login fails.
#
####################################################################

# Basic module setup
package Unix::Login;

use strict;
use vars qw(@ISA @EXPORT $VERSION %CONF);

use Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(login);

# Straight from CPAN
$VERSION = do { my @r=(q$Revision: 1.8 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };

# Errors
use Carp;

# On interrupt, reset term and exit failure
sub sttyexit () { system 'stty echo'; exit 1 }
$SIG{INT}  = \&sttyexit;
$SIG{TERM} = \&sttyexit;
$SIG{QUIT} = \&sttyexit;

# Configuration - these are all the default values
%CONF = (

    # Max login attempts
    attempts       => 3,

    # What todo on failure
    failmesg       => "Login incorrect\n",
    failsleep      => 3,
    failexit       => 1,

    # Misc default strings
    banner         => "Please Login\n",
    bannerfile     => '',
    login          => "login: ",
    password       => "Password: ",

    # Take the username from the process?
    sameuser       => 0,

    # Do we allow them to login with no password??
    passreq        => 1,

    # If can't find homedir
    nohomemesg     => "No home directory! Setting HOME=/\n",

    # Where to take input from
    input          => \*STDIN,
    output         => \*STDOUT,

    # Set ENV variables?
    setenv         => 1,
    clearenv       => 0,
    path           => '/usr/bin:',
    supath         => '/usr/sbin:/usr/bin',
    maildir        => '/var/mail',

    # Use TomC's User::pwent module?
    pwent          => 0,

    # Exec the person's shell?
    cdhome         => 0,
    execshell      => 0

);

#------------------------------------------------
# "Constructor" function to handle defaults
#------------------------------------------------

#######
# Usage: $ul = Unix::Login->new(banner => "Welcome to Bob's");
#
# This constructs a new Unix::Login object (optional, silly)
#######

sub new {
    # Easy mostly-std new()
    my $self = shift;
    my $class = ref($self) || $self;

    # override presets with remaining stuff in @_
    my %conf = (%CONF, @_);
    return bless \%conf, $class;
}

#------------------------------------------------
# Private Functions
#------------------------------------------------

#######
# Usage: my($self, @args) = _self_or_default(@_);
#
# Modified object checker from CGI.pm, no object for speed
#######

sub _self_or_default {
    local $^W = 0;
    return @_ if ref $_[0] eq 'Unix::Login';
    unshift @_, \%CONF;     # just need hash anyways
    return @_;
}

#------------------------------------------------
# Public functions - all are exportable
#------------------------------------------------

#######
# Usage: $ul->login or login();
#
# This is designed to simulate a command-line long on UNIX machines.
# In an array context it returns the std getpwnam array or undef,
# and in a scalar contact it returns just the username or undef if
# the login fails.
#
# The args are optional; if no args are given, then the default
# banner is the basename of the script (`basename $0`), the
# default login prompt is "login: ", the default password string
# is "Password: ", and the default fail string is "Login incorrect".
#######

sub login {

    my($self, @attr) = _self_or_default(@_);
    my %conf = (%{$self}, @attr);

    my($logintry, $passwdtry, @pwstruct);

    # Read our input/output
    *INPUT  = $conf{input};
    *OUTPUT = $conf{output};

    # Print out banner once
    print OUTPUT "\n", $conf{banner}, "\n" if $conf{banner};

    # Read our banner file; we print this each iteration
    my $banner = '';
    if ($conf{bannerfile}) {
        if (open(BFILE, "<" . $conf{bannerfile})) {
            $banner = join '', ;
            close BFILE;
        }
    }

    # While loop
    my $success = 0;
    for (my $i=0; $i < $conf{attempts}; $i++) {

        print OUTPUT $banner;          # /etc/issue

        if ($conf{sameuser}) {
            $logintry = getpwuid($<)
                || croak "Unidentifiable user running process";
        } else {
            do {
                print OUTPUT $conf{login};
                $logintry = ;
                unless ($logintry) {       # catch ^D
                    sttyexit if $conf{failexit};
                    return;
                }
                $logintry =~ s/\s+//g;     # catch "   "
            } while (! $logintry);
        }

        # Look it up by name - explicitly say "CORE::"
        # since we may be using User::pwent...
        @pwstruct = CORE::getpwnam($logintry);

        # Lose the echo during password entry
        system 'stty -echo';
        print OUTPUT $conf{password};
        chomp($passwdtry = );
        print OUTPUT "\n";
        system 'stty echo';

        # Require a passwd from the passwd file?
        if ($pwstruct[0] && ! $pwstruct[1] && $conf{passreq}) {
            sttyexit if $conf{failexit};
            return;
        }

        # Check to make sure we have both a valid username and passwd
        if ($pwstruct[0] && crypt($passwdtry, $pwstruct[1]) eq $pwstruct[1]) {
            $success++;
            last;
        }

        # Fake a UNIX login prompt wait
        sleep $conf{failsleep};
        print OUTPUT $conf{failmesg};
    }

    unless ($success) {
        sttyexit if $conf{failexit};
        return;
    }

    # Do a few basic things
    if ($conf{setenv}) {
        undef %ENV if $conf{clearenv};	# clean slate
        $ENV{LOGNAME} = $pwstruct[0];
        $ENV{PATH}    = ($pwstruct[2] == 0) ? $conf{supath} : $conf{path};
        $ENV{HOME}    = $pwstruct[7];
        $ENV{SHELL}   = $pwstruct[8];
        $ENV{MAIL}    = $conf{maildir} . '/' . $pwstruct[0];
    }

    # Fork a shell if, for some strange reason, we are asked to.
    # We use the little-known indirect object form of exec()
    # to set $0 to -sh so we get a login shell.
    if ($conf{execshell}) {
        if ($> == 0) {
            $< = $> = $pwstruct[2];
            $( = $) = $pwstruct[3];
        } else {
            carp "Warning: Cannot setuid/setgid unless running as root";
        }
        (my $shell = $pwstruct[8]) =~ s!^.*/!!;	# basename
        exec { $pwstruct[8] } "-$shell";
    }

    if ($conf{cdhome}) {
        # Like real login, try to chdir to homedir
        unless (-d $pwstruct[7] && chdir $pwstruct[7]) {
            print OUTPUT $conf{nohomemesg};
            $ENV{HOME} = '/';
        }
    }

    # Return appropriate info
    if (wantarray) {
        return @pwstruct;
    } elsif ($conf{pwent}) {
        require User::pwent;
        return User::pwent::getpwnam($pwstruct[0]);
    } else {
        return $pwstruct[0];
    }
}

1;

#
# Documentation starts down here
#
__END__