[plack-middleware-auth-complex.git] / lib / Plack / Middleware / Auth / Complex.pm

package Plack::Middleware::Auth::Complex;

use 5.014000;
use strict;
use warnings;

our $VERSION = '0.001';

use parent qw/Plack::Middleware/;
use re '/s';

use Authen::Passphrase;
use Authen::Passphrase::BlowfishCrypt;
use Bytes::Random::Secure qw/random_bytes/;
use Carp qw/croak/;
use DBI;
use Digest::SHA qw/hmac_sha1_base64 sha256/;
use Email::Simple;
use Email::Sender::Simple qw/sendmail/;
use MIME::Base64 qw/decode_base64/;
use Plack::Request;
use Tie::Hash::Expire;

sub default_opts {(
	dbi_connect       => ['dbi:Pg:', '', ''],
	select_user       => 'SELECT passphrase, email FROM users WHERE id = ?',
	update_pass       => 'UPDATE users SET passphrase = ? WHERE id = ?',
	insert_user       => 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
	mail_subject      => 'Password reset token',
	realm             => 'restricted area',
	cache_fail        => 0,
	cache_max_age     => 5 * 60,
	token_max_age     => 60 * 60,
	username_regex    => qr/^\w{2,20}$/as,
	register_url      => '/action/register',
	passwd_url        => '/action/passwd',
	request_reset_url => '/action/request-reset',
	reset_url         => '/action/reset'
)}

sub new {
	my ($class, $opts) = @_;
	my %self = $class->default_opts;
	%self = (%self, %$opts);
	my $self = bless \%self, $class;
	$self
}

sub init {
	my ($self) = @_;
	$self->{dbh} = DBI->connect(@{$self->{dbi_connect}})              or croak $DBI::errstr;
	$self->{post_connect_cb}->($self) if $self->{post_connect_cb}; # uncoverable branch false
	$self->{insert_sth} = $self->{dbh}->prepare($self->{insert_user}) or croak $self->{dbh}->errstr;
	$self->{select_sth} = $self->{dbh}->prepare($self->{select_user}) or croak $self->{dbh}->errstr;
	$self->{update_sth} = $self->{dbh}->prepare($self->{update_pass}) or croak $self->{dbh}->errstr;
}

sub create_user {
	my ($self, $parms) = @_;
	my %parms = $parms->flatten;
	$self->{insert_sth}->execute($parms{username}, $self->hash_passphrase($parms{password}), $parms{email}) or croak $self->{insert_sth}->errstr;
}

sub get_user {
	my ($self, $user) = @_;
	$self->{select_sth}->execute($user) or croak $self->{select_sth}->errstr;
	$self->{select_sth}->fetchrow_hashref
}

sub check_passphrase {
	my ($self, $username, $passphrase) = @_;
	unless ($self->{cache}) {
		## no critic (ProhibitTies)
		tie my %cache, 'Tie::Hash::Expire', {expire_seconds => $self->{cache_max_age}};
		$self->{cache} = \%cache;
	}
	my $cachekey = sha256 "$username:$passphrase";
	return $self->{cache}{$cachekey} if exists $self->{cache}{$cachekey}; # uncoverable branch true
	my $user = $self->get_user($username);
	return 0 unless $user;
	my $ret = Authen::Passphrase->from_rfc2307($user->{passphrase})->match($passphrase);
	$self->{cache}{$cachekey} = $ret if $ret || $self->{cache_fail};
	$ret
}

sub hash_passphrase {
	my ($self, $passphrase) = @_;
	Authen::Passphrase::BlowfishCrypt->new(
		cost => 10,
		passphrase => $passphrase,
		salt_random => 1,
	)->as_rfc2307
}

sub set_passphrase {
	my ($self, $username, $passphrase) = @_;
	$self->{update_sth}->execute($self->hash_passphrase($passphrase), $username) or croak $self->{update_sth}->errstr;
}

sub make_reset_hmac {
	my ($self, $username, @data) = @_;
	$self->{hmackey} //= random_bytes 512; # uncoverable condition false
	my $user = $self->get_user($username);
	my $message = join ' ', $username, $user->{passphrase}, @data;
	hmac_sha1_base64 $message, $self->{hmackey};
}

sub mail_body {
	my ($self, $username, $token) = @_;
	my $hours = $self->{token_max_age} / 60 / 60;
	$hours .= $hours == 1 ? ' hour' : ' hours'; # uncoverable branch false
	<<"EOF";
Someone has requested a password reset for your account.

To reset your password, please submit the reset password form on the
website using the following information:

Username: $username
Password: <your new password>
Reset token: $token

The token is valid for $hours.
EOF
}

sub send_reset_email {
	my ($self, $username) = @_;
	my $expire = time + $self->{token_max_age};
	my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
	my $user = $self->get_user($username);
	sendmail (Email::Simple->create(
		header => [
			From    => $self->{mail_from},
			To      => $user->{email},
			Subject => $self->{mail_subject},
		],
		body => $self->mail_body($username, $token),
	));
}

##################################################

sub response {
	my ($self, $code, $body) = @_;
	return [
		$code,
		['Content-Type' => 'text/plain',
		 'Content-Length' => length $body],
		[ $body ],
	];
}

sub reply                 { shift->response(200, $_[0]) }
sub bad_request           { shift->response(400, $_[0]) }
sub internal_server_error { shift->response(500, $_[0]) }

sub unauthorized {
	my ($self) = @_;
	my $body = 'Authorization required';
	return [
		401,
		['Content-Type' => 'text/plain',
		 'Content-Length' => length $body,
		 'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
		[ $body ],
	];
}

##################################################

sub call_register {
	my ($self, $req) = @_;
	my %parms;
	for (qw/username password confirm_password email/) {
		$parms{$_} = $req->param($_);
		return $self->bad_request("Missing parameter $_") unless $parms{$_};
	}

	return $self->bad_request('Username must match ' . $self->{username_regex}) unless $parms{username} =~ $self->{username_regex};
	return $self->bad_request('Username already in use') if $self->get_user($parms{username});
	return $self->bad_request('The two passwords do not match') unless $parms{password} eq $parms{confirm_password};

	$self->create_user($req->parameters);
	return $self->reply('Registered successfully')
}

sub call_passwd {
	my ($self, $req) = @_;
	return $self->unauthorized unless $req->user;
	my %parms;
	for (qw/password new_password confirm_new_password/) {
		$parms{$_} = $req->param($_);
		return $self->bad_request("Missing parameter $_") unless $parms{$_};
	}

	return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password});
	return $self->bad_request('The two passwords do not match') unless $parms{new_password} eq $parms{confirm_new_password};
	$self->set_passphrase($req->user, $parms{new_password});
	return $self->reply('Password changed successfully');
}

sub call_request_reset {
	my ($self, $req) = @_;
	return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from};
	my $username = $req->param('username');
	my $user = $self->get_user($username) or return $self->bad_request('No such user');
	eval {
		$self->send_reset_email($username);
		1
	} or return $self->internal_server_error($@);
	$self->reply('Email sent');
}

sub call_reset {
	my ($self, $req) = @_;
	my %parms;
	for (qw/username new_password confirm_new_password token/) {
		$parms{$_} = $req->param($_);
		return $self->bad_request("Missing parameter $_") unless $parms{$_};
	}

	my $user = $self->get_user($parms{username}) or return $self->bad_request('No such user');
	return $self->bad_request('The two passwords do not match') unless $parms{new_password} eq $parms{confirm_new_password};
	my ($token, $exp) = split /:/, $parms{token};
	my $goodtoken = $self->make_reset_hmac($parms{username}, $exp);
	return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
	return $self->bad_request('Reset token has expired') if time >= $exp;
	$self->set_passphrase($parms{username}, $parms{new_password});
	return $self->reply('Password reset successfully');
}

sub call {
	my ($self, $env) = @_;

	unless ($self->{init_done}) {
		$self->init;
		$self->{init_done} = 1;
	}

	my $auth = $env->{HTTP_AUTHORIZATION};
	if ($auth && $auth =~ /^Basic (.*)$/i) {
		my ($user, $pass) = split /:/, decode_base64($1), 2;
		$env->{REMOTE_USER} = $user if $self->check_passphrase($user, $pass);
	}

	my $req = Plack::Request->new($env);

	if ($req->method eq 'POST') {
		return $self->call_register($req)      if $req->path eq $self->{register_url};
		return $self->call_passwd($req)        if $req->path eq $self->{passwd_url};
		return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url};
		return $self->call_reset($req)         if $req->path eq $self->{reset_url};
	}

	$env->{authcomplex} = $self;
	$self->app->($env);
}

1;
__END__

=head1 NAME

Plack::Middleware::Auth::Complex - Feature-rich authentication system

=head1 SYNOPSIS

  use Plack::Builder;

  builder {
    enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
    sub {
      my ($env) = @_;
      [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
    }
  }

=head1 DESCRIPTION

AuthComplex is an authentication system for Plack applications that
allows user registration, password changing and password reset.

AuthComplex sets REMOTE_USER if the request includes correct basic
authentication and intercepts POST requests to some configurable URLs.
It also sets C<< $env->{authcomplex} >> to itself before passing the
request.

Some options can be controlled by passing a hashref to the
constructor. More customization can be achieved by subclassing this
module.

=head2 Intercepted URLs

Only POST requests are intercepted. Parameters can be either query
parameters or body parameters. Using query parameters is not
recommended. These endpoints return 200 for success, 400 for client
error and 500 for server errors. All parameters are mandatory.

=over

=item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org

This URL creates a new user with the given username, password and
email. The two passwords must match, the user must match
C<username_regex> and the user must not already exist.

=item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw

This URL changes the password of a user. The user must be
authenticated (otherwise the endpoint will return 401).

=item B<POST> /action/request-reset?username=user

This URL requests a password reset token for the given user. The token
will be sent to the user's email address.

A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.

=item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token

This URL performs a password reset.

=back

=head2 Constructor arguments

=over

=item dbi_connect

Arrayref of arguments to pass to DBI->connect. Defaults to
C<['dbi:Pg', '', '']>.

=item post_connect_cb

Callback (coderef) that is called just after connecting to the
database. Used by the testsuite to create the users table.

=item select_user

SQL statement that selects a user by username. Defaults to
C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.

=item update_pass

SQL statement that updates a user's password. Defaults to
C<'UPDATE users SET passphrase = ? WHERE id = ?'>.

=item insert_user

SQL statement that inserts a user. Defaults to
C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.

=item hmackey

HMAC key used for password reset tokens. If not provided it is
generated randomly, in which case reset tokens do not persist across
application restarts.

=item mail_from

From: header of password reset emails. If not provided, password reset
is disabled.

=item mail_subject

The subject of password reset emails. Defaults to
C<'Password reset token'>.

=item realm

Authentication realm. Defaults to C<'restricted area'>.

=item cache_fail

If true, all authentication results are cached. If false, only
successful logins are cached. Defaults to false.

=item cache_max_age

Authentication cache timeout, in seconds. Authentication results are
cached for this number of seconds to avoid expensive hashing. Defaults
to 5 minutes.

=item token_max_age

Password reset token validity, in seconds. Defaults to 1 hour.

=item username_regex

Regular expression that matches valid usernames. Defaults to
C<qr/^\w{2,20}$/as>.

=item register_url

URL for registering. Defaults to C<'/action/register'>.

=item passwd_url

URL for changing your password. Defaults to C<'/action/passwd'>.

=item request_reset_url

URL for requesting a password reset token by email. Defaults to
C<'/action/request-reset'>.

=item reset_url

URL for resetting your password with a reset token. Defaults to
C<'/action/reset'>.

=back

=head2 Methods

=over

=item B<default_opts>

Returns a list of default options for the constructor.

=item B<new>(I<\%opts>)

Creates a new AuthComplex object.

=item B<init>

Called when the first request is received. The default implementation
connects to the database, calls C<post_connect_cb> and prepares the
SQL statements.

=item B<create_user>(I<$parms>)

Inserts a new user into the database. I<$parms> is a
L<Hash::MultiValue> object containing the request parameters.

=item B<get_user>(I<$username>)

Returns a hashref with (at least) the following keys: passphrase (the
RFC2307-formatted passphrase of the user), email (the user's email
address).

=item B<check_passphrase>(I<$username>, I<$passphrase>)

Returns true if the given plaintext passphrase matches the one
obtained from database. Default implementation uses L<Authen::Passphrase>.

=item B<hash_passphrase>(I<$passphrase>)

Returns a RFC2307-formatted hash of the passphrase. Default
implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
of 10 and a random salt.

=item B<set_passphrase>(I<$username>, I<$passphrase>)

Changes a user's passphrase to the given value.

=item B<make_reset_hmac>(I<$username>, [I<@data>])

Returns the HMAC part of the reset token.

=item B<mail_body>(I<$username>, I<$token>)

Returns the body of the password reset email for the given username
and password reset token.

=item B<send_reset_email>(I<$username>)

Generates a new reset token and sends it to the user via email.

=item B<response>(I<$code>, I<$body>)

Helper method. Returns a PSGI response with the given response code
and string body.

=item B<reply>(I<$message>)

Shorthand for C<response(200, $message)>.

=item B<bad_request>(I<$message>)

Shorthand for C<response(400, $message)>.

=item B<internal_server_error>(I<$message>)

Shorthand for C<response(500, $message)>.

=item B<unauthorized>

Returns a 401 Authorization required response.

=item B<call_register>(I<$req>)

Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.

=item B<call_passwd>(I<$req>)

Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.

=item B<call_request_reset>(I<$req>)

Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.

=item B<call_reset>(I<$req>)

Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.

=back

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.20.1 or,
at your option, any later version of Perl 5 you may have available.


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