#!/usr/bin/env perl
use 5.028;
use Mojolicious::Lite -signatures;
use Mojo::SQLite;
use File::Spec::Functions qw/catfile tmpdir/;
use PBKDF2::Tiny qw/derive_hex verify_hex/;
use Crypt::Random::Source qw/get_strong/;
# Run me via:
# morbo --listen=http://127.0.0.1:3000 --listen=https://127.0.0.1:4430 mojo_login_example.pl
#app->secrets(['A Login Example - TODO: set this string!']);
app->sessions->secure(1);
# disable template cache in development mode (e.g. under morbo):
app->renderer->cache->max_keys(0) if app->mode eq 'development';
helper sql => sub { state $sql = Mojo::SQLite->new('sqlite:'
. catfile(tmpdir, 'test.db') ) };
app->sql->migrations->from_string(<<'END_MIGRATIONS')->migrate;
-- 1 up
CREATE TABLE Users ( Username TEXT NOT NULL PRIMARY KEY,
Salt TEXT NOT NULL, Password TEXT NOT NULL,
AuthAttempts INTEGER NOT NULL DEFAULT 0, DelayExpires INTEGER );
-- 1 down
DROP TABLE IF EXISTS Users;
END_MIGRATIONS
{ my $db = app->sql->db; # for testing, insert sample users:
if ( not $db->query('SELECT COUNT(*) FROM Users')->arrays->[0][0] ) {
my $salt1 = unpack 'H*', get_strong(64);
$db->insert('Users', { Username => 'Foo', Salt => $salt1,
Password => derive_hex('SHA-512', 'Bar', $salt1, 5000) } );
my $salt2 = unpack 'H*', get_strong(64);
$db->insert('Users', { Username => 'Quz', Salt => $salt2,
Password => derive_hex('SHA-512', 'Baz', $salt2, 5000) } );
} }
helper do_login => sub ($c) {
my $promise = Mojo::Promise->new;
my ($user,$pass) = ($c->param('username'), $c->param('password'));
my $db = $c->sql->db;
my $user_rec = eval {
my $tx = $db->begin('exclusive');
my $u = $db->select( Users => [qw/ Salt Password AuthAttempts
DelayExpires /], { Username => $user } )->hashes;
die "Username not found" unless @$u;
$db->query('UPDATE Users SET AuthAttempts=AuthAttempts+1,'
.'DelayExpires=? WHERE Username=?', time+60*60, $user );
$tx->commit;
$u->[0] } or do {
Mojo::IOLoop->timer( 2 => sub { $promise->reject } );
return $promise };
Mojo::IOLoop->timer( 2 * $user_rec->{AuthAttempts} => sub {
utf8::encode( $pass ); # needed for verify_hex
utf8::encode( my $salt = $user_rec->{Salt} );
if ( verify_hex( $user_rec->{Password}, 'SHA-512', $pass,
$salt, 5000 ) ) {
$db->query('UPDATE Users SET AuthAttempts=0,DelayExpires='
.'NULL WHERE Username=? OR ?>DelayExpires',
$user, time );
$promise->resolve($user);
}
else { Mojo::IOLoop->timer( 2 => sub { $promise->reject } ) }
});
return $promise;
};
helper logged_in => sub ($c) {
length( $c->session('username') ) ? $c->session : undef };
any '/' => sub ($c) { $c->render('index') } => 'index';
group { # everything in this group requires HTTPS b/c of this "under":
under sub ($c) {
return 1 if $c->req->is_secure;
$c->redirect_to( $c->url_for->to_abs->scheme('https')
->port(4430) ); # this port is just for this demo
return undef;
};
get '/login' => sub ($c) { $c->render('login') } => 'login';
post '/login' => sub ($c) { # form handler
return $c->render(text => 'Bad CSRF token!', status => 403)
if $c->validation->csrf_protect->has_error('csrf_token');
$c->render_later;
$c->do_login->then(sub ($user) {
$c->session( expiration => 60*60 );
$c->session( username => $user );
$c->redirect_to('secure');
})->catch(sub {
$c->flash(login_error => 'Bad username or password');
$c->redirect_to('login');
});
} => 'login';
any '/logout' => sub ($c) {
delete $c->session->{username};
$c->redirect_to('index');
} => 'logout';
group { # everything in this group requires login
under sub ($c) {
return 1 if $c->logged_in;
$c->redirect_to('login');
return undef;
};
any '/secure' => sub ($c) { $c->render('secure') } =>'secure';
};
};
app->start;
__DATA__
@@ layouts/main.html.ep
<%= title %>
Debug Info
User
Attemps
Expires
% my $res = sql->db->select('Users', [qw/ Username AuthAttempts DelayExpires /]);
% while ( my $row = $res->array ) {