File Coverage

blib/lib/Apache/AppSamurai/AuthBase.pm

Criterion	Covered	Total	%
statement	12	89	13.4
branch	0	42	0.0
condition	0	16	0.0
subroutine	4	13	30.7
pod	9	9	100.0
total	25	169	14.7

# Apache::AppSamurai::AuthBase - AppSamurai authentication plugin base
#                                module.

# $Id: AuthBase.pm,v 1.15 2008/04/30 21:40:05 pauldoom Exp $

##
# Copyright (c) 2008 Paul M. Hirsch ([e-mail]).
# All rights reserved.
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
##

# This is a base authentication wrapper for Apache::AppSamurai.
# AppSamurai can use one or more authentication methods to authenticate
# users.  Each method, besides the special AuthServer method, requires
# a module name Apache::AppSamurai::.  All AppSamurai::AuthXXX
# modules should be derived from this base module.

package Apache::AppSamurai::AuthBase;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = substr(q$Revision: 1.15 $, 10, -1);

use Carp;

sub new {
    my $this = shift;
    my $class = (ref($this) || ($this));
    my $me = {};

    bless($me, $class);

    # Call Configure to fill out the $me->{conf} hash
    $me->Configure(@_);
    $me->{init} = 0;
    $me->{errors} = [];

    # If the username and password were passed with the new request,
    # process and return immediately.
    if (defined($me->{conf}{user}) && defined($me->{conf}{pass})) {
	return $me->Authenticate($me->{conf}{user}, $me->{conf}{pass});
    }
    return $me;
}

#### OVERRIDE Configure(), Initialize(), and Authenticator() FOR NEW ####
#### AuthXXX MODULES                                                 ####

# Configure the conf hash.  If you want to override theses defaults, or
# add new ones, create your own Configure() in your AuthXXX module
sub Configure {
    my $self = shift;
    # Initial configuration.  Put defaults here before the @_ args are
    # pulled in.
    $self->{conf} = { UserMin => 3,
		      UserMax => 256,
		      UserChars => '\w\d_\-\.',
		      UserStripWhite => 1,
		      UserUc => 0,
		      UserLc => 0,
		      PassMin => 4,
		      PassMax => 16384,
		      PassChars => '\w\d !\@\#\$\%\^\&\*:\,\.\?\-_=\+',
		      PassStripWhite => 0,
		      DefaultLogLevel => 'error',
		      @_,
		  };

    return 1;
}


# All setup should go here, including configuring authentication modules.
# This will be called by Authenticate() 99% of the time, but for some auth
# types, may be useful to be called in new() as well.
sub Initialize {
    my $self = shift;
    # May only be initialized once
    ($self->{init} == 1) && (return 1);

    # Make sure we have config (in case someone tries to call us directly)
    (defined($self->{conf}) && (scalar keys %{$self->{conf}})) || (croak "Could not initialize!  Module not configured!");

    # Make sure to complain if something goes wrong
    (1 == 1) || ($self->AddError("Failed to initialize in " . __PACKAGE__ . "::Initialize") && return 0);

    # Set this after successful initialization
    $self->{init} = 1;
    return 1;
}


# Perform the authentication.  Returns a "yes" value (1, true) on success
# and "no" value (0, false, or undef) on failure.  The function takes
# three arguments.  1) The object itself  2) The username  3) The password
# The username and password at this point have been through ALL checks in
# the module. (Valid chars, valid length, etc,)
sub Authenticator {
    my $self = shift;
    my $user = shift;
    my $pass = shift;

    # Enter stuff here

    # DEFAULT DENY #
    return 0;
}

###########################################################################


# The bulk of the work happens here, calling Initialize(), CheckInput(), and
# Authenticator(), and returning a true (1)/ false (0) status.
sub Authenticate {
    my $self = shift;
    (scalar(@_) == 2) || (croak 'Usage: $a->Authenticate($user, $pass);');
    my ($user, $pass) = @_;

    ## DEFAULT DENY ##
    my $authenticated = 0;

    # Check for clean input.
    ($user = $self->CheckInputUser($user)) || ($self->AddError('warn', 'Invalid username') && return 0);
    ($pass = $self->CheckInputPass($pass)) || ($self->AddError('warn', 'Invalid password') && return 0);

    # Initialize if not yet done
    if (!$self->{init}) {
	($self->Initialize()) || (return 0);
    }

    ## This is where the Authentication happens.  Create your own overridden
    # Authenticator functions today!
    ($self->Authenticator($user, $pass)) && ($authenticated = 1);

    return $authenticated;
}


# Filter or reject the username.  Return the username (with
# modifications, if needed) on success, or nothing on failure.
# CUSTOMIZE THIS TO ONLY ALLOW VALID USERNAMES FOR YOUR AUTH MODULE!
# BE CAREFUL IF YOU RETURN AN ALTERED USERNAME!  Most bases should be covered
# by the various UserXXX config options, but add more as needed here.
sub CheckInputUser {
    my $self = shift;
    my $user = (shift || return undef);

    # Strip surrounding whitespace, if so configured
    if ($self->{conf}{UserStripWhite}) {
	$user =~ s/^\s*(.+?)\s*$/$1/;
    }
    my $ulen = length($user);

    # Check username against the list of valid username characters
    unless ($user =~ /^([$self->{conf}{UserChars}]+)$/) {
	$self->AddError('warn', 'Username contains invalid characters');
	return undef;
    }

    # Check for a valid username length.
    if ($ulen < $self->{conf}{UserMin}) {
	$self->AddError('warn', "Username too small ($ulen)");
	return undef;
    } elsif ($ulen > $self->{conf}{UserMax}) {
	$self->AddError('warn', "Username too large ($ulen)");
	return undef;
    }

    # uc() or lc() if so configured.
    if ($self->{conf}{UserUc}) {
	$user = uc($user);
    } elsif ($self->{conf}{UserLc}) {
	$user = lc($user);
    }

    return $user;
}


# Filter or reject the password.  Return the password (with
# modifications, if needed) on success, or nothing on failure.
# CUSTOMIZE THIS TO ONLY ALLOW VALID PASSWORDS FOR YOUR AUTH MODULE!
# BE CAREFUL IF YOU RETURN AN ALTERED PASSWORD!  In almost all cases,
# you should fail out instead of trying to help a user.  No lc($pass)
# unless your backend authentication checker really is case insensitive.
sub CheckInputPass {
    my $self = shift;
    my $pass = (shift || return undef);

    # Strip surrounding whitespace, if so configured
    if ($self->{conf}{PassStripWhite}) {
	$pass =~ s/^\s*(.+?)\s*$/$1/;
    }
    my $plen = length($pass);

    # Check password against the list of valid password characters
    unless ($pass =~ /^([$self->{conf}{PassChars}]+)$/) {
	$self->AddError('warn', 'Password contains invalid characters');
	return undef;
    }

    # Check for a valid password length.
    if ($plen < $self->{conf}{PassMin}) {
	$self->AddError('warn', "Password too small ($plen)");
	return undef;
    } elsif ($plen > $self->{conf}{PassMax}) {
	$self->AddError('warn', "Password too large ($plen)");
	return undef;
    }

    return $pass;
}


# Add error to the list
sub AddError {
    my $self = shift;
    if (scalar(@_) == 2) {
	push(@{$self->{errors}}, [$_[0], ref($self) . ": " . $_[1]]);
    } else {
	push(@{$self->{errors}}, [$self->{conf}{DefaultLogLevel}, ref($self) . ": " . $_[0]]);
    }
    return 1;
}

# Return an array of errors if there are any, or undef if there are not.
sub Errors {
    my $self = shift;
    if (scalar(@{$self->{errors}})) {
	return $self->{errors};
    }

    return undef;
}

1; # End of Apache::AppSamurai::AuthBase

__END__