File Coverage

blib/lib/Dancer2/Plugin/Auth/HTTP/Basic/DWIW.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	14	18	77.7
condition	5	10	50.0
subroutine	9	9	100.0
pod			n/a
total	80	89	89.8

use strict;
use warnings;

package Dancer2::Plugin::Auth::HTTP::Basic::DWIW;
# ABSTRACT: HTTP Basic authentication plugin for Dancer2 that does what I want.
$Dancer2::Plugin::Auth::HTTP::Basic::DWIW::VERSION = '0.07';
use MIME::Base64;
use Dancer2::Plugin;

our $HANDLERS = {
    check_login => undef,
    no_auth     => undef,
};

register http_basic_auth => sub {
    my ($dsl, $stuff, $sub, @other_stuff) = @_;

    my $realm = plugin_setting->{'realm'} // 'Please login';

    return sub {
        local $@ = undef;
        eval {
            my $header = $dsl->app->request->header('Authorization') || die \401;

            my ($auth_method, $auth_string) = split(' ', $header);

            $auth_method ne 'Basic' || $auth_string || die \400;

            my ($username, $password) = split(':', decode_base64($auth_string), 2);

            $username || $password || die \401;

            if(my $handler = $HANDLERS->{check_login}) {
                if(ref($handler) eq 'CODE') {
                    my $check_result = eval { $handler->($username, $password); };

                    if($@) {
                        $dsl->error("Error while validating credentials: $@");
                        die \500;
                    }

                    if(!$check_result) {
                        die \401;
                    }
                }
            }
        };

        unless ($@) {
            return $sub->($dsl, @other_stuff);
        }
        else {
            my $error_code = ${$@};

            $dsl->header('WWW-Authenticate' => 'Basic realm="' . $realm . '"');
            $dsl->status($error_code);

            if(my $handler = $HANDLERS->{no_auth}) {
                if(ref($handler) eq 'CODE') {
                    return $handler->();
                }
            }

            return;
        }
    };
};

register http_basic_auth_login => sub {
    my ($dsl) = @_;
    my $app = $dsl->app;

    my @auth_header = split(' ', $dsl->app->request->header('Authorization'));
    my $auth_string = $auth_header[1];
    my @auth_parts  = split(':', decode_base64($auth_string), 2);

    return @auth_parts;
},
{
    is_global => 0
};

register http_basic_auth_set_check_handler => sub {
    my ($dsl, $handler) = @_;

    warn 'This is deprecated! Please use http_basic_auth_handler check_login => sub {}';
    $dsl->http_basic_auth_handler(check_login => $handler);
};

register http_basic_auth_handler => sub {
    my ($dsl, $name, $handler) = @_;
    $HANDLERS->{$name} = $handler;
};

register_plugin for_versions => [2];
1;

__END__