File Coverage

blib/lib/Plack/Middleware/Auth/Basic.pm
Criterion Covered Total %
statement 30 33 90.9
branch 9 14 64.2
condition 3 7 42.8
subroutine 8 9 88.8
pod 2 3 66.6
total 52 66 78.7


line stmt bran cond sub pod time code
1             package Plack::Middleware::Auth::Basic;
2 4     4   20845 use strict;
  4         8  
  4         127  
3 4     4   20 use parent qw(Plack::Middleware);
  4         7  
  4         25  
4 4     4   219 use Plack::Util::Accessor qw( realm authenticator );
  4         8  
  4         22  
5 4     4   20 use Scalar::Util;
  4         8  
  4         173  
6 4     4   1613 use MIME::Base64;
  4         2544  
  4         1310  
7              
8             sub prepare_app {
9 4     4 1 9 my $self = shift;
10              
11 4 50       16 my $auth = $self->authenticator or die 'authenticator is not set';
12 4 50 33     32 if (Scalar::Util::blessed($auth) && $auth->can('authenticate')) {
    50          
13 0     0   0 $self->authenticator(sub { $auth->authenticate(@_[0,1]) }); # because Authen::Simple barfs on 3 params
  0         0  
14             } elsif (ref $auth ne 'CODE') {
15 0         0 die 'authenticator should be a code reference or an object that responds to authenticate()';
16             }
17             }
18              
19             sub call {
20 10     10 1 22 my($self, $env) = @_;
21              
22             my $auth = $env->{HTTP_AUTHORIZATION}
23 10 100       29 or return $self->unauthorized;
24              
25             # note the 'i' on the regex, as, according to RFC2617 this is a
26             # "case-insensitive token to identify the authentication scheme"
27 8 50       50 if ($auth =~ /^Basic (.*)$/i) {
28 8   50     69 my($user, $pass) = split /:/, (MIME::Base64::decode($1) || ":"), 2;
29 8 50       112 $pass = '' unless defined $pass;
30 8 100       38 if ($self->authenticator->($user, $pass, $env)) {
31 6         62 $env->{REMOTE_USER} = $user;
32 6         29 return $self->app->($env);
33             }
34             }
35              
36 2         43 return $self->unauthorized;
37             }
38              
39             sub unauthorized {
40 4     4 0 7 my $self = shift;
41 4         6 my $body = 'Authorization required';
42             return [
43 4   50     33 401,
44             [ 'Content-Type' => 'text/plain',
45             'Content-Length' => length $body,
46             'WWW-Authenticate' => 'Basic realm="' . ($self->realm || "restricted area") . '"' ],
47             [ $body ],
48             ];
49             }
50              
51             1;
52              
53             __END__