[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.000_001';
$VERSION = eval $VERSION;  # see L<perlmodstyle>

use parent qw/Plack::Middleware/;

use Authen::Passphrase;
use Authen::Passphrase::BlowfishCrypt;
use Bytes::Random::Secure qw/random_bytes/;
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}$/a,
	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 die $DBI::errstr;
	$self->{post_connect_cb}->($self) if $self->{post_connect_cb};
	$self->{insert_sth} = $self->{dbh}->prepare($self->{insert_user}) or die $self->{dbh}->errstr;
	$self->{select_sth} = $self->{dbh}->prepare($self->{select_user}) or die $self->{dbh}->errstr;
	$self->{update_sth} = $self->{dbh}->prepare($self->{update_pass}) or die $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})
}

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

sub check_passphrase {
	my ($self, $username, $passphrase) = @_;
	unless ($self->{cache}) {
		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};
	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)
}

sub make_reset_hmac {
	my ($self, $username, @data) = @_;
	$self->{hmackey} //= random_bytes 512;
	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';
	<<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');
	my $ok = 0;
	eval {
		$self->send_reset_email($username);
		$ok = 1;
	};
	return $self->reply('Email sent') if $ok;
	return $self->internal_server_error($@);
}

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}$/a>.

=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
12aa0bc6 MG	1	package Plack::Middleware::Auth::Complex;
	2
	3	use 5.014000;
	4	use strict;
	5	use warnings;
	6
	7	our $VERSION = '0.000_001';
	8	$VERSION = eval $VERSION; # see L<perlmodstyle>
	9
	10	use parent qw/Plack::Middleware/;
	11
	12	use Authen::Passphrase;
	13	use Authen::Passphrase::BlowfishCrypt;
	14	use Bytes::Random::Secure qw/random_bytes/;
	15	use DBI;
4c1b8033	16	use Digest::SHA qw/hmac_sha1_base64 sha256/;
12aa0bc6 MG	17	use Email::Simple;
	18	use Email::Sender::Simple qw/sendmail/;
	19	use MIME::Base64 qw/decode_base64/;
	20	use Plack::Request;
4c1b8033	21	use Tie::Hash::Expire;
12aa0bc6 MG	22
	23	sub default_opts {(
	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',
4c1b8033 MG	30	cache_fail => 0,
4c1b8033 MG	31	cache_max_age => 5 * 60,
fe1dfcf1	32	token_max_age => 60 * 60,
12aa0bc6	33	username_regex => qr/^\w{2,20}$/a,
388ed281 MG	34	register_url => '/action/register',
	35	passwd_url => '/action/passwd',
	36	request_reset_url => '/action/request-reset',
	37	reset_url => '/action/reset'
12aa0bc6 MG	38	)}
	39
	40	sub new {
	41	my ($class, $opts) = @_;
	42	my %self = $class->default_opts;
	43	%self = (%self, %$opts);
	44	my $self = bless \%self, $class;
	45	$self->init;
	46	$self
	47	}
	48
	49	sub init {
	50	my ($self) = @_;
	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;
	56	}
	57
8637972b MG	58	sub create_user {
	59	my ($self, $parms) = @_;
	60	my %parms = $parms->flatten;
	61	$self->{insert_sth}->execute($parms{username}, $self->hash_passphrase($parms{password}), $parms{email})
	62	}
	63
12aa0bc6 MG	64	sub get_user {
	65	my ($self, $user) = @_;
	66	$self->{select_sth}->execute($user) or die $self->{sth}->errstr;
	67	$self->{select_sth}->fetchrow_hashref
	68	}
	69
	70	sub check_passphrase {
	71	my ($self, $username, $passphrase) = @_;
4c1b8033 MG	72	unless ($self->{cache}) {
	73	tie my %cache, 'Tie::Hash::Expire', {expire_seconds => $self->{cache_max_age}};
	74	$self->{cache} = \%cache;
	75	}
	76	my $cachekey = sha256 "$username:$passphrase";
	77	return $self->{cache}{$cachekey} if exists $self->{cache}{$cachekey};
12aa0bc6 MG	78	my $user = $self->get_user($username);
12aa0bc6 MG	79	return 0 unless $user;
4c1b8033 MG	80	my $ret = Authen::Passphrase->from_rfc2307($user->{passphrase})->match($passphrase);
	81	$self->{cache}{$cachekey} = $ret if $ret \|\| $self->{cache_fail};
	82	$ret
12aa0bc6 MG	83	}
	84
	85	sub hash_passphrase {
	86	my ($self, $passphrase) = @_;
	87	Authen::Passphrase::BlowfishCrypt->new(
	88	cost => 10,
	89	passphrase => $passphrase,
	90	salt_random => 1,
	91	)->as_rfc2307
	92	}
	93
	94	sub set_passphrase {
	95	my ($self, $username, $passphrase) = @_;
	96	$self->{update_sth}->execute($self->hash_passphrase($passphrase), $username)
	97	}
	98
	99	sub make_reset_hmac {
	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};
	105	}
	106
	107	sub mail_body {
	108	my ($self, $username, $token) = @_;
	109	my $hours = $self->{token_max_age} / 60 / 60;
	110	$hours .= $hours == 1 ? ' hour' : ' hours';
	111	<<EOF;
	112	Someone has requested a password reset for your account.
	113
	114	To reset your password, please submit the reset password form on the
	115	website using the following information:
	116
	117	Username: $username
	118	Password: <your new password>
	119	Reset token: $token
	120
	121	The token is valid for $hours.
	122	EOF
	123	}
	124
	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(
	131	header => [
	132	From => $self->{mail_from},
	133	To => $user->{email},
876ab8b5	134	Subject => $self->{mail_subject},
12aa0bc6 MG	135	],
	136	body => $self->mail_body($username, $token),
	137	));
	138	}
	139
	140	##################################################
	141
	142	sub response {
	143	my ($self, $code, $body) = @_;
	144	return [
	145	$code,
	146	['Content-Type' => 'text/plain',
	147	'Content-Length' => length $body],
	148	[ $body ],
	149	];
	150	}
	151
	152	sub reply { shift->response(200, $_[0]) }
	153	sub bad_request { shift->response(400, $_[0]) }
	154	sub internal_server_error { shift->response(500, $_[0]) }
	155
	156	sub unauthorized {
	157	my ($self) = @_;
	158	my $body = 'Authorization required';
	159	return [
	160	401,
	161	['Content-Type' => 'text/plain',
	162	'Content-Length' => length $body,
	163	'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
	164	[ $body ],
	165	];
	166	}
	167
	168	##################################################
	169
	170	sub call_register {
	171	my ($self, $req) = @_;
	172	my %parms;
	173	for (qw/username password confirm_password email/) {
	174	$parms{$_} = $req->param($_);
	175	return $self->bad_request("Missing parameter $_") unless $parms{$_};
	176	}
	177
	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};
8637972b MG	181
8637972b MG	182	$self->create_user($req->parameters);
12aa0bc6 MG	183	return $self->reply('Registered successfully')
	184	}
	185
	186	sub call_passwd {
	187	my ($self, $req) = @_;
	188	return $self->unauthorized unless $req->user;
	189	my %parms;
	190	for (qw/password new_password confirm_new_password/) {
	191	$parms{$_} = $req->param($_);
	192	return $self->bad_request("Missing parameter $_") unless $parms{$_};
	193	}
	194
	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');
	199	}
	200
	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');
	206	my $ok = 0;
	207	eval {
	208	$self->send_reset_email($username);
	209	$ok = 1;
	210	};
	211	return $self->reply('Email sent') if $ok;
	212	return $self->internal_server_error($@);
	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.
a27e5239	280	It also sets C<< $env->{authcomplex} >> to itself before passing the
12aa0bc6 MG	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
388ed281	296	=item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
12aa0bc6 MG	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
388ed281	302	=item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
12aa0bc6 MG	303
	304	This URL changes the password of a user. The user must be
	305	authenticated (otherwise the endpoint will return 401).
	306
388ed281	307	=item B<POST> /action/request-reset?username=user
12aa0bc6 MG	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
388ed281	314	=item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
12aa0bc6 MG	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
4c1b8033 MG	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
12aa0bc6 MG	380	=item token_max_age
12aa0bc6 MG	381
fe1dfcf1	382	Password reset token validity, in seconds. Defaults to 1 hour.
12aa0bc6 MG	383
	384	=item username_regex
	385
	386	Regular expression that matches valid usernames. Defaults to
	387	C<qr/^\w{2,20}$/a>.
	388
	389	=item register_url
	390
388ed281	391	URL for registering. Defaults to C<'/action/register'>.
12aa0bc6 MG	392
	393	=item passwd_url
	394
388ed281	395	URL for changing your password. Defaults to C<'/action/passwd'>.
12aa0bc6 MG	396
	397	=item request_reset_url
	398
	399	URL for requesting a password reset token by email. Defaults to
388ed281	400	C<'/action/request-reset'>.
12aa0bc6 MG	401
	402	=item reset_url
	403
	404	URL for resetting your password with a reset token. Defaults to
388ed281	405	C<'/action/reset'>.
12aa0bc6 MG	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
8637972b MG	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
12aa0bc6 MG	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