]>
Commit | Line | Data |
---|---|---|
1 | package Plack::Middleware::Auth::Complex; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
7 | our $VERSION = '0.000_001'; | |
8 | $VERSION = eval $VERSION; # see L<perlmodstyle> | |
9 | ||
10 | use parent qw/Plack::Middleware/; | |
11 | ||
12 | use Authen::Passphrase; | |
13 | use Authen::Passphrase::BlowfishCrypt; | |
14 | use Bytes::Random::Secure qw/random_bytes/; | |
15 | use DBI; | |
16 | use Digest::SHA qw/hmac_sha1_base64/; | |
17 | use Email::Simple; | |
18 | use Email::Sender::Simple qw/sendmail/; | |
19 | use MIME::Base64 qw/decode_base64/; | |
20 | use Plack::Request; | |
21 | ||
22 | sub default_opts {( | |
23 | dbi_connect => ['dbi:Pg:', '', ''], | |
24 | select_user => 'SELECT passphrase, email FROM users WHERE id = ?', | |
25 | update_pass => 'UPDATE users SET passphrase = ? WHERE id = ?', | |
26 | insert_user => 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)', | |
27 | mail_subject => 'Password reset token', | |
28 | realm => 'restricted area', | |
29 | token_max_age => 60 * 60 * 24, | |
30 | username_regex => qr/^\w{2,20}$/a, | |
31 | register_url => '/register', | |
32 | passwd_url => '/passwd', | |
33 | request_reset_url => '/request-reset', | |
34 | reset_url => '/reset' | |
35 | )} | |
36 | ||
37 | sub new { | |
38 | my ($class, $opts) = @_; | |
39 | my %self = $class->default_opts; | |
40 | %self = (%self, %$opts); | |
41 | my $self = bless \%self, $class; | |
42 | $self->init; | |
43 | $self | |
44 | } | |
45 | ||
46 | sub init { | |
47 | my ($self) = @_; | |
48 | $self->{dbh} = DBI->connect(@{$self->{dbi_connect}}) or die $DBI::errstr; | |
49 | $self->{post_connect_cb}->($self) if $self->{post_connect_cb}; | |
50 | $self->{insert_sth} = $self->{dbh}->prepare($self->{insert_user}) or die $self->{dbh}->errstr; | |
51 | $self->{select_sth} = $self->{dbh}->prepare($self->{select_user}) or die $self->{dbh}->errstr; | |
52 | $self->{update_sth} = $self->{dbh}->prepare($self->{update_pass}) or die $self->{dbh}->errstr; | |
53 | } | |
54 | ||
55 | sub get_user { | |
56 | my ($self, $user) = @_; | |
57 | $self->{select_sth}->execute($user) or die $self->{sth}->errstr; | |
58 | $self->{select_sth}->fetchrow_hashref | |
59 | } | |
60 | ||
61 | sub check_passphrase { | |
62 | my ($self, $username, $passphrase) = @_; | |
63 | my $user = $self->get_user($username); | |
64 | return 0 unless $user; | |
65 | Authen::Passphrase->from_rfc2307($user->{passphrase})->match($passphrase) | |
66 | } | |
67 | ||
68 | sub hash_passphrase { | |
69 | my ($self, $passphrase) = @_; | |
70 | Authen::Passphrase::BlowfishCrypt->new( | |
71 | cost => 10, | |
72 | passphrase => $passphrase, | |
73 | salt_random => 1, | |
74 | )->as_rfc2307 | |
75 | } | |
76 | ||
77 | sub set_passphrase { | |
78 | my ($self, $username, $passphrase) = @_; | |
79 | $self->{update_sth}->execute($self->hash_passphrase($passphrase), $username) | |
80 | } | |
81 | ||
82 | sub make_reset_hmac { | |
83 | my ($self, $username, @data) = @_; | |
84 | $self->{hmackey} //= random_bytes 512; | |
85 | my $user = $self->get_user($username); | |
86 | my $message = join ' ', $username, $user->{passphrase}, @data; | |
87 | hmac_sha1_base64 $message, $self->{hmackey}; | |
88 | } | |
89 | ||
90 | sub mail_body { | |
91 | my ($self, $username, $token) = @_; | |
92 | my $hours = $self->{token_max_age} / 60 / 60; | |
93 | $hours .= $hours == 1 ? ' hour' : ' hours'; | |
94 | <<EOF; | |
95 | Someone has requested a password reset for your account. | |
96 | ||
97 | To reset your password, please submit the reset password form on the | |
98 | website using the following information: | |
99 | ||
100 | Username: $username | |
101 | Password: <your new password> | |
102 | Reset token: $token | |
103 | ||
104 | The token is valid for $hours. | |
105 | EOF | |
106 | } | |
107 | ||
108 | sub send_reset_email { | |
109 | my ($self, $username) = @_; | |
110 | my $expire = time + $self->{token_max_age}; | |
111 | my $token = $self->make_reset_hmac($username, $expire) . ":$expire"; | |
112 | my $user = $self->get_user($username); | |
113 | sendmail (Email::Simple->create( | |
114 | header => [ | |
115 | From => $self->{mail_from}, | |
116 | To => $user->{email}, | |
117 | Subject => $user->{mail_subject}, | |
118 | ], | |
119 | body => $self->mail_body($username, $token), | |
120 | )); | |
121 | } | |
122 | ||
123 | ################################################## | |
124 | ||
125 | sub response { | |
126 | my ($self, $code, $body) = @_; | |
127 | return [ | |
128 | $code, | |
129 | ['Content-Type' => 'text/plain', | |
130 | 'Content-Length' => length $body], | |
131 | [ $body ], | |
132 | ]; | |
133 | } | |
134 | ||
135 | sub reply { shift->response(200, $_[0]) } | |
136 | sub bad_request { shift->response(400, $_[0]) } | |
137 | sub internal_server_error { shift->response(500, $_[0]) } | |
138 | ||
139 | sub unauthorized { | |
140 | my ($self) = @_; | |
141 | my $body = 'Authorization required'; | |
142 | return [ | |
143 | 401, | |
144 | ['Content-Type' => 'text/plain', | |
145 | 'Content-Length' => length $body, | |
146 | 'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ], | |
147 | [ $body ], | |
148 | ]; | |
149 | } | |
150 | ||
151 | ################################################## | |
152 | ||
153 | sub call_register { | |
154 | my ($self, $req) = @_; | |
155 | my %parms; | |
156 | for (qw/username password confirm_password email/) { | |
157 | $parms{$_} = $req->param($_); | |
158 | return $self->bad_request("Missing parameter $_") unless $parms{$_}; | |
159 | } | |
160 | ||
161 | return $self->bad_request('Username must match ' . $self->{username_regex}) unless $parms{username} =~ /$self->{username_regex}/; | |
162 | return $self->bad_request('Username already in use') if $self->get_user($parms{username}); | |
163 | return $self->bad_request('The two passwords do not match') unless $parms{password} eq $parms{confirm_password}; | |
164 | $self->{insert_sth}->execute($parms{username}, $self->hash_passphrase($parms{password}), $parms{email}); | |
165 | return $self->reply('Registered successfully') | |
166 | } | |
167 | ||
168 | sub call_passwd { | |
169 | my ($self, $req) = @_; | |
170 | return $self->unauthorized unless $req->user; | |
171 | my %parms; | |
172 | for (qw/password new_password confirm_new_password/) { | |
173 | $parms{$_} = $req->param($_); | |
174 | return $self->bad_request("Missing parameter $_") unless $parms{$_}; | |
175 | } | |
176 | ||
177 | return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password}); | |
178 | return $self->bad_request('The two passwords do not match') unless $parms{new_password} eq $parms{confirm_new_password}; | |
179 | $self->set_passphrase($req->user, $parms{new_password}); | |
180 | return $self->reply('Password changed successfully'); | |
181 | } | |
182 | ||
183 | sub call_request_reset { | |
184 | my ($self, $req) = @_; | |
185 | return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from}; | |
186 | my $username = $req->param('username'); | |
187 | my $user = $self->get_user($username) or return $self->bad_request('No such user'); | |
188 | my $ok = 0; | |
189 | eval { | |
190 | $self->send_reset_email($username); | |
191 | $ok = 1; | |
192 | }; | |
193 | return $self->reply('Email sent') if $ok; | |
194 | return $self->internal_server_error($@); | |
195 | } | |
196 | ||
197 | sub call_reset { | |
198 | my ($self, $req) = @_; | |
199 | my %parms; | |
200 | for (qw/username new_password confirm_new_password token/) { | |
201 | $parms{$_} = $req->param($_); | |
202 | return $self->bad_request("Missing parameter $_") unless $parms{$_}; | |
203 | } | |
204 | ||
205 | my $user = $self->get_user($parms{username}) or return $self->bad_request('No such user'); | |
206 | return $self->bad_request('The two passwords do not match') unless $parms{new_password} eq $parms{confirm_new_password}; | |
207 | my ($token, $exp) = split ':', $parms{token}; | |
208 | my $goodtoken = $self->make_reset_hmac($parms{username}, $exp); | |
209 | return $self->bad_request('Bad reset token') unless $token eq $goodtoken; | |
210 | return $self->bad_request('Reset token has expired') if time >= $exp; | |
211 | $self->set_passphrase($parms{username}, $parms{new_password}); | |
212 | return $self->reply('Password reset successfully'); | |
213 | } | |
214 | ||
215 | sub call { | |
216 | my ($self, $env) = @_; | |
217 | my $auth = $env->{HTTP_AUTHORIZATION}; | |
218 | if ($auth && $auth =~ /^Basic (.*)$/i) { | |
219 | my ($user, $pass) = split /:/, decode_base64($1), 2; | |
220 | $env->{REMOTE_USER} = $user if $self->check_passphrase($user, $pass); | |
221 | } | |
222 | ||
223 | my $req = Plack::Request->new($env); | |
224 | ||
225 | if ($req->method eq 'POST') { | |
226 | return $self->call_register($req) if $req->path eq $self->{register_url}; | |
227 | return $self->call_passwd($req) if $req->path eq $self->{passwd_url}; | |
228 | return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url}; | |
229 | return $self->call_reset($req) if $req->path eq $self->{reset_url}; | |
230 | } | |
231 | ||
232 | $env->{authcomplex} = $self; | |
233 | $self->app->($env); | |
234 | } | |
235 | ||
236 | 1; | |
237 | __END__ | |
238 | ||
239 | =head1 NAME | |
240 | ||
241 | Plack::Middleware::Auth::Complex - Feature-rich authentication system | |
242 | ||
243 | =head1 SYNOPSIS | |
244 | ||
245 | use Plack::Builder; | |
246 | ||
247 | builder { | |
248 | enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org'; | |
249 | sub { | |
250 | my ($env) = @_; | |
251 | [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]] | |
252 | } | |
253 | } | |
254 | ||
255 | =head1 DESCRIPTION | |
256 | ||
257 | AuthComplex is an authentication system for Plack applications that | |
258 | allows user registration, password changing and password reset. | |
259 | ||
260 | AuthComplex sets REMOTE_USER if the request includes correct basic | |
261 | authentication and intercepts POST requests to some configurable URLs. | |
262 | It also sets C<$env->{authcomplex}> to itself before passing the | |
263 | request. | |
264 | ||
265 | Some options can be controlled by passing a hashref to the | |
266 | constructor. More customization can be achieved by subclassing this | |
267 | module. | |
268 | ||
269 | =head2 Intercepted URLs | |
270 | ||
271 | Only POST requests are intercepted. Parameters can be either query | |
272 | parameters or body parameters. Using query parameters is not | |
273 | recommended. These endpoints return 200 for success, 400 for client | |
274 | error and 500 for server errors. All parameters are mandatory. | |
275 | ||
276 | =over | |
277 | ||
278 | =item B<POST> /register?username=user&password=pw&confirm_password=pw&email=user@example.org | |
279 | ||
280 | This URL creates a new user with the given username, password and | |
281 | email. The two passwords must match, the user must match | |
282 | C<username_regex> and the user must not already exist. | |
283 | ||
284 | =item B<POST> /passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw | |
285 | ||
286 | This URL changes the password of a user. The user must be | |
287 | authenticated (otherwise the endpoint will return 401). | |
288 | ||
289 | =item B<POST> /request-reset?username=user | |
290 | ||
291 | This URL requests a password reset token for the given user. The token | |
292 | will be sent to the user's email address. | |
293 | ||
294 | A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>. | |
295 | ||
296 | =item B<POST> /reset?username=user&new_password=pw&confirm_new_password=pw&token=token | |
297 | ||
298 | This URL performs a password reset. | |
299 | ||
300 | =back | |
301 | ||
302 | =head2 Constructor arguments | |
303 | ||
304 | =over | |
305 | ||
306 | =item dbi_connect | |
307 | ||
308 | Arrayref of arguments to pass to DBI->connect. Defaults to | |
309 | C<['dbi:Pg', '', '']>. | |
310 | ||
311 | =item post_connect_cb | |
312 | ||
313 | Callback (coderef) that is called just after connecting to the | |
314 | database. Used by the testsuite to create the users table. | |
315 | ||
316 | =item select_user | |
317 | ||
318 | SQL statement that selects a user by username. Defaults to | |
319 | C<'SELECT id, passphrase, email FROM users WHERE id = ?'>. | |
320 | ||
321 | =item update_pass | |
322 | ||
323 | SQL statement that updates a user's password. Defaults to | |
324 | C<'UPDATE users SET passphrase = ? WHERE id = ?'>. | |
325 | ||
326 | =item insert_user | |
327 | ||
328 | SQL statement that inserts a user. Defaults to | |
329 | C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>. | |
330 | ||
331 | =item hmackey | |
332 | ||
333 | HMAC key used for password reset tokens. If not provided it is | |
334 | generated randomly, in which case reset tokens do not persist across | |
335 | application restarts. | |
336 | ||
337 | =item mail_from | |
338 | ||
339 | From: header of password reset emails. If not provided, password reset | |
340 | is disabled. | |
341 | ||
342 | =item mail_subject | |
343 | ||
344 | The subject of password reset emails. Defaults to | |
345 | C<'Password reset token'>. | |
346 | ||
347 | =item realm | |
348 | ||
349 | Authentication realm. Defaults to C<'restricted area'>. | |
350 | ||
351 | =item token_max_age | |
352 | ||
353 | Password reset token validity, in seconds. Defaults to 24 hours. | |
354 | ||
355 | =item username_regex | |
356 | ||
357 | Regular expression that matches valid usernames. Defaults to | |
358 | C<qr/^\w{2,20}$/a>. | |
359 | ||
360 | =item register_url | |
361 | ||
362 | URL for registering. Defaults to C<'/register'>. | |
363 | ||
364 | =item passwd_url | |
365 | ||
366 | URL for changing your password. Defaults to C<'/passwd'>. | |
367 | ||
368 | =item request_reset_url | |
369 | ||
370 | URL for requesting a password reset token by email. Defaults to | |
371 | C<'/request-reset'>. | |
372 | ||
373 | =item reset_url | |
374 | ||
375 | URL for resetting your password with a reset token. Defaults to | |
376 | C<'/reset'>. | |
377 | ||
378 | =back | |
379 | ||
380 | =head2 Methods | |
381 | ||
382 | =over | |
383 | ||
384 | =item B<default_opts> | |
385 | ||
386 | Returns a list of default options for the constructor. | |
387 | ||
388 | =item B<new>(I<\%opts>) | |
389 | ||
390 | Creates a new AuthComplex object. | |
391 | ||
392 | =item B<init> | |
393 | ||
394 | Called at the end of the constructor. The default implementation | |
395 | connects to the database, calls C<post_connect_cb> and prepares the | |
396 | SQL statements. | |
397 | ||
398 | =item B<get_user>(I<$username>) | |
399 | ||
400 | Returns a hashref with (at least) the following keys: passphrase (the | |
401 | RFC2307-formatted passphrase of the user), email (the user's email | |
402 | address). | |
403 | ||
404 | =item B<check_passphrase>(I<$username>, I<$passphrase>) | |
405 | ||
406 | Returns true if the given plaintext passphrase matches the one | |
407 | obtained from database. Default implementation uses L<Authen::Passphrase>. | |
408 | ||
409 | =item B<hash_passphrase>(I<$passphrase>) | |
410 | ||
411 | Returns a RFC2307-formatted hash of the passphrase. Default | |
412 | implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost | |
413 | of 10 and a random salt. | |
414 | ||
415 | =item B<set_passphrase>(I<$username>, I<$passphrase>) | |
416 | ||
417 | Changes a user's passphrase to the given value. | |
418 | ||
419 | =item B<make_reset_hmac>(I<$username>, [I<@data>]) | |
420 | ||
421 | Returns the HMAC part of the reset token. | |
422 | ||
423 | =item B<mail_body>(I<$username>, I<$token>) | |
424 | ||
425 | Returns the body of the password reset email for the given username | |
426 | and password reset token. | |
427 | ||
428 | =item B<send_reset_email>(I<$username>) | |
429 | ||
430 | Generates a new reset token and sends it to the user via email. | |
431 | ||
432 | =item B<response>(I<$code>, I<$body>) | |
433 | ||
434 | Helper method. Returns a PSGI response with the given response code | |
435 | and string body. | |
436 | ||
437 | =item B<reply>(I<$message>) | |
438 | ||
439 | Shorthand for C<response(200, $message)>. | |
440 | ||
441 | =item B<bad_request>(I<$message>) | |
442 | ||
443 | Shorthand for C<response(400, $message)>. | |
444 | ||
445 | =item B<internal_server_error>(I<$message>) | |
446 | ||
447 | Shorthand for C<response(500, $message)>. | |
448 | ||
449 | =item B<unauthorized> | |
450 | ||
451 | Returns a 401 Authorization required response. | |
452 | ||
453 | =item B<call_register>(I<$req>) | |
454 | ||
455 | Handles the C</register> endpoint. I<$req> is a Plack::Request object. | |
456 | ||
457 | =item B<call_passwd>(I<$req>) | |
458 | ||
459 | Handles the C</passwd> endpoint. I<$req> is a Plack::Request object. | |
460 | ||
461 | =item B<call_request_reset>(I<$req>) | |
462 | ||
463 | Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object. | |
464 | ||
465 | =item B<call_reset>(I<$req>) | |
466 | ||
467 | Handles the C</reset> endpoint. I<$req> is a Plack::Request object. | |
468 | ||
469 | =back | |
470 | ||
471 | =head1 AUTHOR | |
472 | ||
473 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
474 | ||
475 | =head1 COPYRIGHT AND LICENSE | |
476 | ||
477 | Copyright (C) 2015 by Marius Gavrilescu | |
478 | ||
479 | This library is free software; you can redistribute it and/or modify | |
480 | it under the same terms as Perl itself, either Perl version 5.20.1 or, | |
481 | at your option, any later version of Perl 5 you may have available. | |
482 | ||
483 | ||
484 | =cut |