view release on metacpan or  search on metacpan

lib/App/Authentication/Htpasswd.pm  view on Meta::CPAN

#############################################################################
## $Id: Htpasswd.pm 9817 2007-07-30 22:46:19Z spadkins $
#############################################################################

package App::Authentication::Htpasswd;
$VERSION = (q$Revision: 9817 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Authentication;
@ISA = ( "App::Authentication" );

use strict;

=head1 NAME

App::Authentication::Htpasswd - Interface for authentication using an htpasswd file

=head1 SYNOPSIS

    use App;

    $context = App->context();
    $authentication = $context->service("Authentication");  # or ...
    $authentication = $context->authentication();

    if ($authentication->validate_password($username, $password)) {
       ...
    }

=head1 DESCRIPTION

An App::Authentication::Htpasswd service is a means by which a user may be authenticated
using an htpasswd file.

=cut

#############################################################################
# PUBLIC METHODS
#############################################################################

=head1 Public Methods:

=cut

#############################################################################
# validate_password()
#############################################################################

=head2 validate_password()

    * Signature: $username = $auth->validate_password();
    * Param:     void
    * Return:    $username        string
    * Throws:    App::Exception::Authentication
    * Since:     0.01

    Sample Usage:

    $username = $auth->validate_password();

=cut

sub validate_password {
    &App::sub_entry if ($App::trace);
    my ($self, $username, $password) = @_;
    my $valid = 0;

    my $context = $self->{context};
    my $htpasswd_file = $context->get_option("htpasswd_file");

    if (-e $htpasswd_file) {
        my ($uname, $pword);
        if (open(PFILE, "< $htpasswd_file")) {
            while (<PFILE>) {
                chomp;
                ($uname, $pword) = split(/:/);
                last if ($uname eq $username);
                $uname = "";
            }
            close(PFILE);
            if ($uname) {
                my $crypt = crypt($password, $pword);
                $valid = ($pword eq $crypt) ? 1 : 0;
            }
        }
    }
    &App::sub_exit($valid) if ($App::trace);
    return($valid);
}

=head1 ACKNOWLEDGEMENTS

 * Author:  Stephen Adkins <spadkins@gmail.com>
 * License: This is free software. It is licensed under the same terms as Perl itself.

=head1 SEE ALSO

L<C<App::Context>|App::Context>,
L<C<App::Service>|App::Service>

=cut

1;