]>
iEval git - plack-middleware-auth-complex.git/blob - lib/Plack/Middleware/Auth/Complex.pm
1 package Plack
::Middleware
::Auth
::Complex
;
7 our $VERSION = '0.000_001';
8 $VERSION = eval $VERSION; # see L<perlmodstyle>
10 use parent qw
/Plack::Middleware/;
12 use Authen
::Passphrase
;
13 use Authen
::Passphrase
::BlowfishCrypt
;
14 use Bytes
::Random
::Secure qw
/random_bytes/;
16 use Digest
::SHA qw
/hmac_sha1_base64 sha256/;
18 use Email
::Sender
::Simple qw
/sendmail/;
19 use MIME
::Base64 qw
/decode_base64/;
21 use Tie
::Hash
::Expire
;
24 dbi_connect
=> ['dbi:Pg:', '', ''],
25 select_user
=> 'SELECT passphrase, email FROM users WHERE id = ?',
26 update_pass
=> 'UPDATE users SET passphrase = ? WHERE id = ?',
27 insert_user
=> 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
28 mail_subject
=> 'Password reset token',
29 realm
=> 'restricted area',
31 cache_max_age
=> 5 * 60,
32 token_max_age
=> 60 * 60,
33 username_regex
=> qr/^\w{2,20}$/a,
34 register_url
=> '/action/register',
35 passwd_url
=> '/action/passwd',
36 request_reset_url
=> '/action/request-reset',
37 reset_url
=> '/action/reset'
41 my ($class, $opts) = @_;
42 my %self = $class->default_opts;
43 %self = (%self, %$opts);
44 my $self = bless \
%self, $class;
51 $self->{dbh
} = DBI
->connect(@
{$self->{dbi_connect
}}) or die $DBI::errstr
;
52 $self->{post_connect_cb
}->($self) if $self->{post_connect_cb
};
53 $self->{insert_sth
} = $self->{dbh
}->prepare($self->{insert_user
}) or die $self->{dbh
}->errstr;
54 $self->{select_sth
} = $self->{dbh
}->prepare($self->{select_user
}) or die $self->{dbh
}->errstr;
55 $self->{update_sth
} = $self->{dbh
}->prepare($self->{update_pass
}) or die $self->{dbh
}->errstr;
59 my ($self, $parms) = @_;
60 my %parms = $parms->flatten;
61 $self->{insert_sth
}->execute($parms{username
}, $self->hash_passphrase($parms{password
}), $parms{email
})
65 my ($self, $user) = @_;
66 $self->{select_sth
}->execute($user) or die $self->{sth
}->errstr;
67 $self->{select_sth
}->fetchrow_hashref
70 sub check_passphrase
{
71 my ($self, $username, $passphrase) = @_;
72 unless ($self->{cache
}) {
73 tie
my %cache, 'Tie::Hash::Expire', {expire_seconds
=> $self->{cache_max_age
}};
74 $self->{cache
} = \
%cache;
76 my $cachekey = sha256
"$username:$passphrase";
77 return $self->{cache
}{$cachekey} if exists $self->{cache
}{$cachekey};
78 my $user = $self->get_user($username);
79 return 0 unless $user;
80 my $ret = Authen
::Passphrase
->from_rfc2307($user->{passphrase
})->match($passphrase);
81 $self->{cache
}{$cachekey} = $ret if $ret || $self->{cache_fail
};
86 my ($self, $passphrase) = @_;
87 Authen
::Passphrase
::BlowfishCrypt
->new(
89 passphrase
=> $passphrase,
95 my ($self, $username, $passphrase) = @_;
96 $self->{update_sth
}->execute($self->hash_passphrase($passphrase), $username)
100 my ($self, $username, @data) = @_;
101 $self->{hmackey
} //= random_bytes
512;
102 my $user = $self->get_user($username);
103 my $message = join ' ', $username, $user->{passphrase
}, @data;
104 hmac_sha1_base64
$message, $self->{hmackey
};
108 my ($self, $username, $token) = @_;
109 my $hours = $self->{token_max_age
} / 60 / 60;
110 $hours .= $hours == 1 ?
' hour' : ' hours';
112 Someone has requested a password reset for your account.
114 To reset your password, please submit the reset password form on the
115 website using the following information:
118 Password: <your new password>
121 The token is valid for $hours.
125 sub send_reset_email
{
126 my ($self, $username) = @_;
127 my $expire = time + $self->{token_max_age
};
128 my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
129 my $user = $self->get_user($username);
130 sendmail
(Email
::Simple
->create(
132 From
=> $self->{mail_from
},
133 To
=> $user->{email
},
134 Subject
=> $self->{mail_subject
},
136 body
=> $self->mail_body($username, $token),
140 ##################################################
143 my ($self, $code, $body) = @_;
146 ['Content-Type' => 'text/plain',
147 'Content-Length' => length $body],
152 sub reply
{ shift->response(200, $_[0]) }
153 sub bad_request
{ shift->response(400, $_[0]) }
154 sub internal_server_error
{ shift->response(500, $_[0]) }
158 my $body = 'Authorization required';
161 ['Content-Type' => 'text/plain',
162 'Content-Length' => length $body,
163 'WWW-Authenticate' => 'Basic realm="' . $self->{realm
} . '"' ],
168 ##################################################
171 my ($self, $req) = @_;
173 for (qw
/username password confirm_password email/) {
174 $parms{$_} = $req->param($_);
175 return $self->bad_request("Missing parameter $_") unless $parms{$_};
178 return $self->bad_request('Username must match ' . $self->{username_regex
}) unless $parms{username
} =~ /$self->{username_regex}/;
179 return $self->bad_request('Username already in use') if $self->get_user($parms{username
});
180 return $self->bad_request('The two passwords do not match') unless $parms{password
} eq $parms{confirm_password
};
182 $self->create_user($req->parameters);
183 return $self->reply('Registered successfully')
187 my ($self, $req) = @_;
188 return $self->unauthorized unless $req->user;
190 for (qw
/password new_password confirm_new_password/) {
191 $parms{$_} = $req->param($_);
192 return $self->bad_request("Missing parameter $_") unless $parms{$_};
195 return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password
});
196 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
197 $self->set_passphrase($req->user, $parms{new_password
});
198 return $self->reply('Password changed successfully');
201 sub call_request_reset
{
202 my ($self, $req) = @_;
203 return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from
};
204 my $username = $req->param('username');
205 my $user = $self->get_user($username) or return $self->bad_request('No such user');
208 $self->send_reset_email($username);
211 return $self->reply('Email sent') if $ok;
212 return $self->internal_server_error($@
);
216 my ($self, $req) = @_;
218 for (qw
/username new_password confirm_new_password token/) {
219 $parms{$_} = $req->param($_);
220 return $self->bad_request("Missing parameter $_") unless $parms{$_};
223 my $user = $self->get_user($parms{username
}) or return $self->bad_request('No such user');
224 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
225 my ($token, $exp) = split ':', $parms{token
};
226 my $goodtoken = $self->make_reset_hmac($parms{username
}, $exp);
227 return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
228 return $self->bad_request('Reset token has expired') if time >= $exp;
229 $self->set_passphrase($parms{username
}, $parms{new_password
});
230 return $self->reply('Password reset successfully');
234 my ($self, $env) = @_;
235 my $auth = $env->{HTTP_AUTHORIZATION
};
236 if ($auth && $auth =~ /^Basic (.*)$/i) {
237 my ($user, $pass) = split /:/, decode_base64
($1), 2;
238 $env->{REMOTE_USER
} = $user if $self->check_passphrase($user, $pass);
241 my $req = Plack
::Request
->new($env);
243 if ($req->method eq 'POST') {
244 return $self->call_register($req) if $req->path eq $self->{register_url
};
245 return $self->call_passwd($req) if $req->path eq $self->{passwd_url
};
246 return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url
};
247 return $self->call_reset($req) if $req->path eq $self->{reset_url
};
250 $env->{authcomplex
} = $self;
259 Plack::Middleware::Auth::Complex - Feature-rich authentication system
266 enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
269 [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
275 AuthComplex is an authentication system for Plack applications that
276 allows user registration, password changing and password reset.
278 AuthComplex sets REMOTE_USER if the request includes correct basic
279 authentication and intercepts POST requests to some configurable URLs.
280 It also sets C<$env->{authcomplex}> to itself before passing the
283 Some options can be controlled by passing a hashref to the
284 constructor. More customization can be achieved by subclassing this
287 =head2 Intercepted URLs
289 Only POST requests are intercepted. Parameters can be either query
290 parameters or body parameters. Using query parameters is not
291 recommended. These endpoints return 200 for success, 400 for client
292 error and 500 for server errors. All parameters are mandatory.
296 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
298 This URL creates a new user with the given username, password and
299 email. The two passwords must match, the user must match
300 C<username_regex> and the user must not already exist.
302 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
304 This URL changes the password of a user. The user must be
305 authenticated (otherwise the endpoint will return 401).
307 =item B<POST> /action/request-reset?username=user
309 This URL requests a password reset token for the given user. The token
310 will be sent to the user's email address.
312 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
314 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
316 This URL performs a password reset.
320 =head2 Constructor arguments
326 Arrayref of arguments to pass to DBI->connect. Defaults to
327 C<['dbi:Pg', '', '']>.
329 =item post_connect_cb
331 Callback (coderef) that is called just after connecting to the
332 database. Used by the testsuite to create the users table.
336 SQL statement that selects a user by username. Defaults to
337 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
341 SQL statement that updates a user's password. Defaults to
342 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
346 SQL statement that inserts a user. Defaults to
347 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
351 HMAC key used for password reset tokens. If not provided it is
352 generated randomly, in which case reset tokens do not persist across
353 application restarts.
357 From: header of password reset emails. If not provided, password reset
362 The subject of password reset emails. Defaults to
363 C<'Password reset token'>.
367 Authentication realm. Defaults to C<'restricted area'>.
371 If true, all authentication results are cached. If false, only
372 successful logins are cached. Defaults to false.
376 Authentication cache timeout, in seconds. Authentication results are
377 cached for this number of seconds to avoid expensive hashing. Defaults
382 Password reset token validity, in seconds. Defaults to 1 hour.
386 Regular expression that matches valid usernames. Defaults to
391 URL for registering. Defaults to C<'/action/register'>.
395 URL for changing your password. Defaults to C<'/action/passwd'>.
397 =item request_reset_url
399 URL for requesting a password reset token by email. Defaults to
400 C<'/action/request-reset'>.
404 URL for resetting your password with a reset token. Defaults to
413 =item B<default_opts>
415 Returns a list of default options for the constructor.
417 =item B<new>(I<\%opts>)
419 Creates a new AuthComplex object.
423 Called at the end of the constructor. The default implementation
424 connects to the database, calls C<post_connect_cb> and prepares the
427 =item B<create_user>(I<$parms>)
429 Inserts a new user into the database. I<$parms> is a
430 L<Hash::MultiValue> object containing the request parameters.
432 =item B<get_user>(I<$username>)
434 Returns a hashref with (at least) the following keys: passphrase (the
435 RFC2307-formatted passphrase of the user), email (the user's email
438 =item B<check_passphrase>(I<$username>, I<$passphrase>)
440 Returns true if the given plaintext passphrase matches the one
441 obtained from database. Default implementation uses L<Authen::Passphrase>.
443 =item B<hash_passphrase>(I<$passphrase>)
445 Returns a RFC2307-formatted hash of the passphrase. Default
446 implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
447 of 10 and a random salt.
449 =item B<set_passphrase>(I<$username>, I<$passphrase>)
451 Changes a user's passphrase to the given value.
453 =item B<make_reset_hmac>(I<$username>, [I<@data>])
455 Returns the HMAC part of the reset token.
457 =item B<mail_body>(I<$username>, I<$token>)
459 Returns the body of the password reset email for the given username
460 and password reset token.
462 =item B<send_reset_email>(I<$username>)
464 Generates a new reset token and sends it to the user via email.
466 =item B<response>(I<$code>, I<$body>)
468 Helper method. Returns a PSGI response with the given response code
471 =item B<reply>(I<$message>)
473 Shorthand for C<response(200, $message)>.
475 =item B<bad_request>(I<$message>)
477 Shorthand for C<response(400, $message)>.
479 =item B<internal_server_error>(I<$message>)
481 Shorthand for C<response(500, $message)>.
483 =item B<unauthorized>
485 Returns a 401 Authorization required response.
487 =item B<call_register>(I<$req>)
489 Handles the C</register> endpoint. I<$req> is a Plack::Request object.
491 =item B<call_passwd>(I<$req>)
493 Handles the C</passwd> endpoint. I<$req> is a Plack::Request object.
495 =item B<call_request_reset>(I<$req>)
497 Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object.
499 =item B<call_reset>(I<$req>)
501 Handles the C</reset> endpoint. I<$req> is a Plack::Request object.
507 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
509 =head1 COPYRIGHT AND LICENSE
511 Copyright (C) 2015 by Marius Gavrilescu
513 This library is free software; you can redistribute it and/or modify
514 it under the same terms as Perl itself, either Perl version 5.20.1 or,
515 at your option, any later version of Perl 5 you may have available.
This page took 0.085601 seconds and 4 git commands to generate.