File Coverage

blib/lib/Dancer2/Plugin/Auth/HTTP/Basic/DWIW.pm
Criterion Covered Total %
statement 49 49 100.0
branch 14 18 77.7
condition 5 10 50.0
subroutine 8 8 100.0
pod n/a
total 76 85 89.4


line stmt bran cond sub pod time code
1 7     7   7836860 use strict;
  7         16  
  7         298  
2 7     7   38 use warnings;
  7         23  
  7         661  
3              
4             package Dancer2::Plugin::Auth::HTTP::Basic::DWIW;
5             # ABSTRACT: HTTP Basic authentication plugin for Dancer2 that does what I want.
6             $Dancer2::Plugin::Auth::HTTP::Basic::DWIW::VERSION = '0.0901';
7 7     7   3521 use MIME::Base64;
  7         5771  
  7         591  
8 7     7   5510 use Dancer2::Plugin;
  7         433909  
  7         102  
9              
10             our $HANDLERS = {
11             check_login => undef,
12             no_auth => undef,
13             };
14              
15             register http_basic_auth => sub {
16 6     6   873153 my ($dsl, $stuff, $sub, @other_stuff) = @_;
17              
18 6   50     34 my $realm = plugin_setting->{'realm'} // 'Please login';
19              
20             return sub {
21 12     12   1848181 local $@ = undef;
22 12         33 eval {
23 12   100     132 my $header = $dsl->app->request->header('Authorization') || die \401;
24              
25 8         1718 my ($auth_method, $auth_string) = split(' ', $header);
26              
27 8 50 33     68 $auth_method ne 'Basic' || $auth_string || die \400;
28              
29 8         55 my ($username, $password) = split(':', decode_base64($auth_string), 2);
30              
31 8 50 33     88 $username || $password || die \401;
32              
33 8 100       90 if(my $handler = $HANDLERS->{check_login}) {
34 5 50       21 if(ref($handler) eq 'CODE') {
35 5         10 my $check_result = eval { $handler->($username, $password); };
  5         22  
36              
37 5 100       51 if($@) {
38 1         7 $dsl->error("Error while validating credentials: $@");
39 1         759 die \500;
40             }
41              
42 4 100       19 if(!$check_result) {
43 2         11 die \401;
44             }
45             }
46             }
47             };
48              
49 12 100       974 unless ($@) {
50 5         67 return $sub->($dsl->app, @other_stuff);
51             }
52             else {
53 7         26 my $error_code = ${$@};
  7         19  
54              
55 7         52 $dsl->response_header('WWW-Authenticate' => 'Basic realm="' . $realm . '"');
56 7         1668 $dsl->status($error_code);
57              
58 7 100       827 if(my $handler = $HANDLERS->{no_auth}) {
59 2 50       11 if(ref($handler) eq 'CODE') {
60 2         12 return $handler->();
61             }
62             }
63              
64 5         19 return;
65             }
66 6         1165 };
67             };
68              
69             register http_basic_auth_login => sub {
70 4     4   48 my ($dsl) = @_;
71 4         13 my $app = $dsl->app;
72              
73 4         37 my @auth_header = split(' ', $dsl->app->request->header('Authorization'));
74 4         145 my $auth_string = $auth_header[1];
75 4         35 my @auth_parts = split(':', decode_base64($auth_string), 2);
76              
77 4         28 return @auth_parts;
78             },
79             {
80             is_global => 0
81             };
82              
83             register http_basic_auth_handler => sub {
84 4     4   815163 my ($dsl, $name, $handler) = @_;
85 4         21 $HANDLERS->{$name} = $handler;
86             };
87              
88             register_plugin for_versions => [2];
89             1;
90              
91             __END__