File Coverage

lib/Dancer/Plugin/Auth/Basic.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	19	20	95.0
condition	20	25	80.0
subroutine	9	9	100.0
pod			n/a
total	101	108	93.5

package Dancer::Plugin::Auth::Basic;

use strict;
use warnings;

# ABSTRACT: Basic HTTP authentication for Dancer web apps

our $VERSION = '0.030'; # VERSION

use Dancer ':syntax';
use Dancer::Plugin;
use Dancer::Response;
use HTTP::Headers;
use MIME::Base64;

my $settings = plugin_setting;

# Protected paths defined in the configuration
my $paths = {};
# "Global" users
my $users = {};

if (exists $settings->{paths}) {
    $paths = $settings->{paths};
}

if (exists $settings->{users}) {
    $users = $settings->{users};
}

sub _check_password {
    my ($password, $text) = @_;

    my $crypt;

    if (($crypt = $password =~ /^\$\w+\$/) || $password =~ /^\{\w+\}/) {
        # Crypt or RFC 2307 format
        eval {
            require Authen::Passphrase;
            1;
        }
        or do {
            error "Can't use Authen::Passphrase: " . $@;
            return 0;
        };

        my $ppr;

        eval {
            $ppr = $crypt ? Authen::Passphrase->from_crypt($password) :
                Authen::Passphrase->from_rfc2307($password);
        }
        or do {
            error "Can't construct an Authen::Passphrase recognizer object: " .
                $@;
            return 0;
        };

        return $ppr->match($text);
    }
    else {
        # Password in cleartext
        return $password eq $text;
    }
}

sub _auth_basic {
    my (%options) = @_;

    # Get authentication data from request
    my $auth = request->header('Authorization');

    my $authorized = undef;

    if (defined $auth && $auth =~ /^Basic (.*)$/) {
        my ($user, $password) = split(/:/, (MIME::Base64::decode($1) || ":"));

        if (exists $options{user}) {
            # A single user is defined
            $authorized = $user eq $options{user} &&
                _check_password($options{password}, $password);
        }

        if (!defined($authorized) && exists($options{users})) {
            # Multiple users are defined
            $authorized = exists($options{users}->{$user}) &&
                _check_password($options{users}->{$user}, $password);
        }

        if (!$authorized && defined($users)) {
            # Use the "global" users list
            $authorized = exists $users->{$user} &&
                _check_password($users->{$user}, $password);
        }

        if ($authorized) {
            # Authorization successful
            request->env->{REMOTE_USER} = $user;
            return 1;
        }

        if (!defined($authorized)) {
            # No users defined? NONE SHALL PASS!
            warning __PACKAGE__ . ": No user/password defined";
        }
    }

    my $content = "Authorization required";

    return halt(Dancer::Response->new(
        status => 401,
        content => $content,
        headers => [
            'Content-Type' => 'text/plain',
            'Content-Length' => length($content),
            'WWW-Authenticate' => 'Basic realm="' . ($options{realm} ||
                "Restricted area") . '"'
        ]
    ));
}

my $check = sub {
    # Check if the request matches one of the protected paths (reverse sort the
    # paths to find the longest matching path first)
    foreach my $path (reverse sort keys %$paths) {
        my $path_re = '^' . quotemeta($path);
        if (request->path_info =~ qr{$path_re}) {
            _auth_basic %{$paths->{$path}};
            last;
        }
    }
};

# Dynamic paths
hook before => $check;
# Static paths
hook before_file_render => $check;

register auth_basic => \&_auth_basic;
register_plugin;

1; # End of Dancer::Plugin::Auth::Basic

__END__