1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
package Plack::Middleware::Auth::Htpasswd;
use strict;
use warnings;
use base 'Plack::Middleware';
use Plack::Util::Accessor qw(realm file file_root);
use Plack::Request;
use Authen::Htpasswd;
use MIME::Base64;
use Path::Class;
sub prepare_app {
my $self = shift;
die "must specify either file or file_root"
unless defined $self->file || $self->file_root;
}
sub call {
my($self, $env) = @_;
my $auth = $env->{HTTP_AUTHORIZATION};
return $self->unauthorized
unless $auth && $auth =~ /^Basic (.*)$/;
my $auth_string = $1;
my ($user, $pass) = split /:/, (MIME::Base64::decode($auth_string) || ":");
$pass = '' unless defined $pass;
if ($self->authenticate($env, $user, $pass)) {
$env->{REMOTE_USER} = $user;
return $self->app->($env);
}
else {
return $self->unauthorized;
}
}
sub _check_password {
my $self = shift;
my ($file, $user, $pass) = @_;
return Authen::Htpasswd->new($file)->check_user_password($user, $pass);
}
sub authenticate {
my $self = shift;
my ($env, $user, $pass) = @_;
return $self->_check_password($self->file, $user, $pass)
if defined $self->file;
my $req = Plack::Request->new($env);
my $dir = dir($self->file_root);
my @htpasswd = reverse
map { $_->file('.htpasswd')->stringify }
map { $dir = $dir->subdir($_) }
split m{/}, $req->path;
for my $htpasswd (@htpasswd) {
next unless -f $htpasswd && -r _;
return $self->_check_password($htpasswd, $user, $pass);
}
return;
}
sub unauthorized {
my $self = shift;
my $body = 'Authorization required';
return [
401,
[
'Content-Type' => 'text/plain',
'Content-Length' => length $body,
'WWW-Authenticate' => 'Basic realm="'
. ($self->realm || "restricted area")
. '"'
],
[ $body ],
];
}
1;
|
