/
Digest.pm
231 lines (163 loc) · 5.72 KB
/
Digest.pm
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
package Plack::Middleware::Auth::Digest;
use 5.008001;
use strict;
use warnings;
use parent qw/Plack::Middleware/;
use Plack::Util::Accessor qw/realm authenticator password_hashed secret nonce_ttl/;
use MIME::Base64 ();
use Digest::MD5 ();
use Digest::HMAC_SHA1 ();
our $VERSION = '0.03';
sub hash {
Digest::MD5::md5_hex(join ":", @_);
}
sub prepare_app {
my $self = shift;
if ($self->authenticator && ref $self->authenticator ne 'CODE') {
die 'authenticator should be a code reference';
}
unless ($self->secret) {
die "Auth::Digest secret key is not set.";
}
}
sub call {
my ($self, $env) = @_;
my $auth = $env->{HTTP_AUTHORIZATION} or return $self->unauthorized;
if ($auth =~ /^Digest (.*)/) {
my $auth = $self->parse_challenge($1) || {};
$auth->{method} = $env->{REQUEST_METHOD};
if ($auth->{uri} ne $env->{REQUEST_URI}) {
return [ 400, ['Content-Type', 'text/plain'], [ "Bad Request" ] ];
}
my $password = $self->authenticator->($auth->{username}, $env);
if ( defined $password
&& $self->valid_nonce($auth)
&& $self->digest($password, $auth) eq $auth->{response}) {
if ($self->stale_nonce($auth)) {
return $self->unauthorized(stale => "true");
}
$env->{REMOTE_USER} = $auth->{username};
return $self->app->($env);
}
}
return $self->unauthorized;
}
sub parse_challenge {
my($self, $header) = @_;
my $auth;
while ($header =~ /(\w+)\=("[^\"]+"|[^,]+)/g ) {
$auth->{$1} = dequote($2);
}
return $auth;
}
sub dequote {
my $s = shift;
$s =~ s/^"(.*)"$/$1/;
$s =~ s/\\(.)/$1/g;
$s;
}
sub digest {
my($self, $password, $auth) = @_;
my $hashed = $self->password_hashed
? $password : hash($auth->{username}, $auth->{realm}, $password);
return hash($hashed, @{$auth}{qw(nonce nc cnonce qop)}, hash("$auth->{method}:$auth->{uri}"));
}
sub unauthorized {
my $self = shift;
my %params = @_;
my $body = '401 Authorization required';
my $realm = $self->realm || "restricted area";
my $nonce = $self->generate_nonce(time);
my $algorithm = 'MD5';
my $qop = 'auth';
my $challenge = qq|Digest realm="$realm", nonce="$nonce", algorithm=$algorithm, qop="$qop"|;
$challenge .= qq(, stale=true) if $params{stale};
return [
401,
[
'Content-Type' => 'text/plain',
'Content-Length' => length $body,
'WWW-Authenticate' => $challenge,
],
[ $body ],
];
}
sub valid_nonce {
my($self, $auth) = @_;
my($time, $digest) = split / /, MIME::Base64::decode_base64($auth->{nonce});
$auth->{_nonce_time} = $time; # cache for stale check
return $time && $digest && $digest eq $self->hmac($time);
}
sub stale_nonce {
my($self, $auth) = @_;
$auth->{_nonce_time} < time - ($self->nonce_ttl || 60);
}
sub generate_nonce {
my($self, $time) = @_;
my $nonce = MIME::Base64::encode_base64(join " ", $time, $self->hmac($time));
chomp $nonce;
return $nonce;
}
sub hmac {
my($self, $time) = @_;
Digest::HMAC_SHA1::hmac_sha1_hex($time, $self->secret);
}
1;
__END__
=head1 NAME
Plack::Middleware::Auth::Digest - Digest authentication
=head1 SYNOPSIS
enable "Auth::Digest", realm => "Secured", secret => "blahblahblah",
authenticator => sub {
my ($username, $env) = @_;
return $password; # for $username
};
# Or return MD5 hash of "$username:$realm:$password"
enable "Auth::Digest", realm => "Secured", secret => "blahblahblah",
password_hashed => 1,
authenticator => sub { return $password_hashed };
=head1 DESCRIPTION
Plack::Middleware::Auth::Digest is a Plack middleware component that
enables Digest authentication. Your C<authenticator> callback is called using
two parameters: a username as a string and the PSGI C<$env> hash. Your callback
should return a password, either as a raw password or a hashed password.
=head1 CONFIGURATIONS
=over 4
=item authenticator
A callback that takes a username and PSGI C<$env> hash and returns a password
for the user, either in a plaintext password or a MD5 hash of
"username:realm:password" (quotes not included) when
C<password_hashed> option is enabled.
=item password_hashed
A boolean (0 or 1) to indicate whether C<authenticator> callback
returns passwords in a plaintext or hashed. Defaults to 0 (plaintext).
=item realm
A string to represent the realm. Defaults to I<restricted area>.
=item secret
Server secret text string that is used to sign nonce. Required.
=item nonce_ttl
Time-to-live seconds to prevent replay attacks. Defaults to 60.
=back
=head1 LIMITATIONS
This middleware expects that the application has a full access to the
headers sent by clients in PSGI environment. That is normally the case
with standalone Perl PSGI web servers such as L<Starman> or
L<HTTP::Server::Simple::PSGI>.
However, in a web server configuration where you can't achieve this
(i.e. using your application via mod_perl, CGI or FastCGI), this
middleware does not work since your application can't know the value
of C<Authorization:> header.
If you use Apache as a web server and CGI or mod_perl to run your PSGI
application, you can use mod_rewrite to pass the Authorization header
to the application with the rewrite rule like following.
RewriteEngine on
RewriteRule .* - [E=HTTP_AUTHORIZATION:%{HTTP:Authorization},L]
=head1 AUTHOR
Yuji Shimada E<lt>xaicron@cpan.orgE<gt>
Tatsuhiko Miyagawa
=head1 SEE ALSO
L<Plack::Middleware::Auth::Basic>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut