#!/usr/bin/env perl
package AuthApp;
use lib 'lib';
use Web::Simple;
use Authen::Passphrase::SaltedDigest;
with 'Web::Simple::Application::Role::Authentication';
use AuthApp::Schema;
has 'schema' => (is => 'lazy');
has 'deployed' => (is => 'rw');
sub dispatch_request {
my ($self) = @_;
my $user;
$self->check_authenticated($user);
sub (GET + /) {
my ($self) = @_;
return [ 200, [ 'Content-type', 'text/html' ], [ $self->main_page($user) ]];
},
sub (POST + /login + %username=&password=) {
my ($self, $usern, $passw) = @_;
my $user = $self->get_check_user($usern, $passw);
if($user) {
return ($self->set_authenticated($user),
[ 303, [ 'Content-type', 'text/html',
'Location', '/' ],
[ 'Login succeeded, back to ' ]]);
} else {
return [ 200, [ 'Content-type', 'text/html' ], [ 'Login failed' ]];
}
},
sub (POST + /register + %username=&password=) {
my ($self, $username, $password) = @_;
## FIXME: Check length of inputs!
my $newuser = $self->create_user($username, $password);
if($newuser) {
return
[ 303, [ 'Content-type', 'text/html',
'Location', '/' ],
[ 'Registration succeeded, back to ' ]];
} else {
return [ 200, [ 'Content-type', 'text/html' ], [ 'Registration failed' ]];
}
},
sub (GET + /logout) {
my ($self) = @_;
if($user) {
$user = undef;
}
return ($self->logout,
[ 303, [ 'Content-type', 'text/html',
'Location', '/' ],
[ 'Logout succeeded, back to ' ]]);
},
}
## Implement these two (examples based on DBIx::Class):
## _ident_from_user, return a unique way of identifying a user, this
## will be stored in the session
sub _ident_from_user {
my ($self, $user) = @_;
return $user->ident_condition;
}
## _user_from_ident, return a user object, given the unique user identifier
sub _user_from_ident {
my ($self, $ident) = @_;
return $self->users_rs->find($ident);
}
sub _build_schema {
my ($self) = @_;
my $schema = AuthApp::Schema->connect("dbi:SQLite:auth.db");
if(!$self->deployed) {
$schema->deploy;
$self->deployed(1);
}
return $schema;
}
sub get_check_user {
my ($self, $username, $password) = @_;
my $user = $self->schema->resultset('User')->find({ username => $username });
if($user && $user->password->match($password)) {
return $user;
}
return;
}
sub create_user {
my ($self, $username, $password) = @_;
my $user = $self->schema->resultset('User')->find({ username => $username });
if($user) {
warn "Cowardly refusing to re-create an existing user $username";
return;
}
$user = $self->schema->resultset('User')->create({
username => $username,
password => Authen::Passphrase::SaltedDigest->new(algorithm => "SHA-1", salt_random => 20, passphrase=>$password),
});
return $user;
}
sub main_page {
my ($self, $user) = @_;
my $is_user = $user ? $user->username . ' is logged in. Logout' : <
Register:
FORM
return << "HTML";
Auth App
$is_user
HTML
}
AuthApp->run_if_script;