[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->init;
	$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) = @_;
	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 at the end of the constructor. 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</register> endpoint. I<$req> is a Plack::Request object.

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

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

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

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

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

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