[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,
	invalid_username  => 'Invalid username',
	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($self->{invalid_username}) 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 invalid_username

Error message returned when the username does not match
username_regex. Defaults to C<'Invalid username'>

=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,
cd19b1b4	35	invalid_username => 'Invalid username',
388ed281 MG	36	register_url => '/action/register',
	37	passwd_url => '/action/passwd',
	38	request_reset_url => '/action/request-reset',
	39	reset_url => '/action/reset'
12aa0bc6 MG	40	)}
	41
	42	sub new {
	43	my ($class, $opts) = @_;
	44	my %self = $class->default_opts;
	45	%self = (%self, %$opts);
	46	my $self = bless \%self, $class;
12aa0bc6 MG	47	$self
	48	}
	49
	50	sub init {
	51	my ($self) = @_;
1f7bfc27	52	$self->{dbh} = DBI->connect(@{$self->{dbi_connect}}) or croak $DBI::errstr;
9d9f4067	53	$self->{post_connect_cb}->($self) if $self->{post_connect_cb}; # uncoverable branch false
1f7bfc27 MG	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;
12aa0bc6 MG	57	}
12aa0bc6 MG	58
8637972b MG	59	sub create_user {
	60	my ($self, $parms) = @_;
	61	my %parms = $parms->flatten;
6af8d6cc	62	$self->{insert_sth}->execute($parms{username}, $self->hash_passphrase($parms{password}), $parms{email}) or croak $self->{insert_sth}->errstr;
8637972b MG	63	}
8637972b MG	64
12aa0bc6 MG	65	sub get_user {
12aa0bc6 MG	66	my ($self, $user) = @_;
6af8d6cc	67	$self->{select_sth}->execute($user) or croak $self->{select_sth}->errstr;
12aa0bc6 MG	68	$self->{select_sth}->fetchrow_hashref
	69	}
	70
	71	sub check_passphrase {
	72	my ($self, $username, $passphrase) = @_;
4c1b8033	73	unless ($self->{cache}) {
1f7bfc27	74	## no critic (ProhibitTies)
4c1b8033 MG	75	tie my %cache, 'Tie::Hash::Expire', {expire_seconds => $self->{cache_max_age}};
	76	$self->{cache} = \%cache;
	77	}
	78	my $cachekey = sha256 "$username:$passphrase";
9d9f4067	79	return $self->{cache}{$cachekey} if exists $self->{cache}{$cachekey}; # uncoverable branch true
12aa0bc6 MG	80	my $user = $self->get_user($username);
12aa0bc6 MG	81	return 0 unless $user;
4c1b8033 MG	82	my $ret = Authen::Passphrase->from_rfc2307($user->{passphrase})->match($passphrase);
	83	$self->{cache}{$cachekey} = $ret if $ret \|\| $self->{cache_fail};
	84	$ret
12aa0bc6 MG	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) = @_;
6af8d6cc	98	$self->{update_sth}->execute($self->hash_passphrase($passphrase), $username) or croak $self->{update_sth}->errstr;
12aa0bc6 MG	99	}
	100
	101	sub make_reset_hmac {
	102	my ($self, $username, @data) = @_;
9d9f4067	103	$self->{hmackey} //= random_bytes 512; # uncoverable condition false
12aa0bc6 MG	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;
9d9f4067	112	$hours .= $hours == 1 ? ' hour' : ' hours'; # uncoverable branch false
1f7bfc27	113	<<"EOF";
12aa0bc6 MG	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},
876ab8b5	136	Subject => $self->{mail_subject},
12aa0bc6 MG	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
cd19b1b4	180	return $self->bad_request($self->{invalid_username}) unless $parms{username} =~ $self->{username_regex};
12aa0bc6 MG	181	return $self->bad_request('Username already in use') if $self->get_user($parms{username});
12aa0bc6 MG	182	return $self->bad_request('The two passwords do not match') unless $parms{password} eq $parms{confirm_password};
8637972b MG	183
8637972b MG	184	$self->create_user($req->parameters);
12aa0bc6 MG	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');
12aa0bc6 MG	208	eval {
12aa0bc6 MG	209	$self->send_reset_email($username);
1f7bfc27 MG	210	1
	211	} or return $self->internal_server_error($@);
	212	$self->reply('Email sent');
12aa0bc6 MG	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};
1f7bfc27	225	my ($token, $exp) = split /:/, $parms{token};
12aa0bc6 MG	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) = @_;
d332726d MG	235
	236	unless ($self->{init_done}) {
	237	$self->init;
	238	$self->{init_done} = 1;
	239	}
	240
12aa0bc6 MG	241	my $auth = $env->{HTTP_AUTHORIZATION};
	242	if ($auth && $auth =~ /^Basic (.*)$/i) {
	243	my ($user, $pass) = split /:/, decode_base64($1), 2;
	244	$env->{REMOTE_USER} = $user if $self->check_passphrase($user, $pass);
	245	}
	246
	247	my $req = Plack::Request->new($env);
	248
	249	if ($req->method eq 'POST') {
	250	return $self->call_register($req) if $req->path eq $self->{register_url};
	251	return $self->call_passwd($req) if $req->path eq $self->{passwd_url};
	252	return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url};
	253	return $self->call_reset($req) if $req->path eq $self->{reset_url};
	254	}
	255
	256	$env->{authcomplex} = $self;
	257	$self->app->($env);
	258	}
	259
	260	1;
	261	__END__
	262
	263	=head1 NAME
	264
	265	Plack::Middleware::Auth::Complex - Feature-rich authentication system
	266
	267	=head1 SYNOPSIS
	268
	269	use Plack::Builder;
	270
	271	builder {
	272	enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
	273	sub {
	274	my ($env) = @_;
	275	[200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
	276	}
	277	}
	278
	279	=head1 DESCRIPTION
	280
	281	AuthComplex is an authentication system for Plack applications that
	282	allows user registration, password changing and password reset.
	283
	284	AuthComplex sets REMOTE_USER if the request includes correct basic
	285	authentication and intercepts POST requests to some configurable URLs.
a27e5239	286	It also sets C<< $env->{authcomplex} >> to itself before passing the
12aa0bc6 MG	287	request.
	288
	289	Some options can be controlled by passing a hashref to the
	290	constructor. More customization can be achieved by subclassing this
	291	module.
	292
	293	=head2 Intercepted URLs
	294
	295	Only POST requests are intercepted. Parameters can be either query
	296	parameters or body parameters. Using query parameters is not
	297	recommended. These endpoints return 200 for success, 400 for client
	298	error and 500 for server errors. All parameters are mandatory.
	299
	300	=over
	301
388ed281	302	=item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
12aa0bc6 MG	303
	304	This URL creates a new user with the given username, password and
	305	email. The two passwords must match, the user must match
	306	C<username_regex> and the user must not already exist.
	307
388ed281	308	=item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
12aa0bc6 MG	309
	310	This URL changes the password of a user. The user must be
	311	authenticated (otherwise the endpoint will return 401).
	312
388ed281	313	=item B<POST> /action/request-reset?username=user
12aa0bc6 MG	314
	315	This URL requests a password reset token for the given user. The token
	316	will be sent to the user's email address.
	317
	318	A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
	319
388ed281	320	=item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
12aa0bc6 MG	321
	322	This URL performs a password reset.
	323
	324	=back
	325
	326	=head2 Constructor arguments
	327
	328	=over
	329
	330	=item dbi_connect
	331
	332	Arrayref of arguments to pass to DBI->connect. Defaults to
	333	C<['dbi:Pg', '', '']>.
	334
	335	=item post_connect_cb
	336
	337	Callback (coderef) that is called just after connecting to the
	338	database. Used by the testsuite to create the users table.
	339
	340	=item select_user
	341
	342	SQL statement that selects a user by username. Defaults to
	343	C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
	344
	345	=item update_pass
	346
	347	SQL statement that updates a user's password. Defaults to
	348	C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
	349
	350	=item insert_user
	351
	352	SQL statement that inserts a user. Defaults to
	353	C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
	354
	355	=item hmackey
	356
	357	HMAC key used for password reset tokens. If not provided it is
	358	generated randomly, in which case reset tokens do not persist across
	359	application restarts.
	360
	361	=item mail_from
	362
	363	From: header of password reset emails. If not provided, password reset
	364	is disabled.
	365
	366	=item mail_subject
	367
	368	The subject of password reset emails. Defaults to
	369	C<'Password reset token'>.
	370
	371	=item realm
	372
	373	Authentication realm. Defaults to C<'restricted area'>.
	374
4c1b8033 MG	375	=item cache_fail
	376
	377	If true, all authentication results are cached. If false, only
	378	successful logins are cached. Defaults to false.
	379
	380	=item cache_max_age
	381
	382	Authentication cache timeout, in seconds. Authentication results are
	383	cached for this number of seconds to avoid expensive hashing. Defaults
	384	to 5 minutes.
	385
12aa0bc6 MG	386	=item token_max_age
12aa0bc6 MG	387
fe1dfcf1	388	Password reset token validity, in seconds. Defaults to 1 hour.
12aa0bc6 MG	389
	390	=item username_regex
	391
	392	Regular expression that matches valid usernames. Defaults to
1f7bfc27	393	C<qr/^\w{2,20}$/as>.
12aa0bc6	394
cd19b1b4 MG	395	=item invalid_username
	396
	397	Error message returned when the username does not match
	398	username_regex. Defaults to C<'Invalid username'>
	399
12aa0bc6 MG	400	=item register_url
12aa0bc6 MG	401
388ed281	402	URL for registering. Defaults to C<'/action/register'>.
12aa0bc6 MG	403
	404	=item passwd_url
	405
388ed281	406	URL for changing your password. Defaults to C<'/action/passwd'>.
12aa0bc6 MG	407
	408	=item request_reset_url
	409
	410	URL for requesting a password reset token by email. Defaults to
388ed281	411	C<'/action/request-reset'>.
12aa0bc6 MG	412
	413	=item reset_url
	414
	415	URL for resetting your password with a reset token. Defaults to
388ed281	416	C<'/action/reset'>.
12aa0bc6 MG	417
	418	=back
	419
	420	=head2 Methods
	421
	422	=over
	423
	424	=item B<default_opts>
	425
	426	Returns a list of default options for the constructor.
	427
	428	=item B<new>(I<\%opts>)
	429
	430	Creates a new AuthComplex object.
	431
	432	=item B<init>
	433
d332726d	434	Called when the first request is received. The default implementation
12aa0bc6 MG	435	connects to the database, calls C<post_connect_cb> and prepares the
	436	SQL statements.
	437
8637972b MG	438	=item B<create_user>(I<$parms>)
	439
	440	Inserts a new user into the database. I<$parms> is a
	441	L<Hash::MultiValue> object containing the request parameters.
	442
12aa0bc6 MG	443	=item B<get_user>(I<$username>)
	444
	445	Returns a hashref with (at least) the following keys: passphrase (the
	446	RFC2307-formatted passphrase of the user), email (the user's email
	447	address).
	448
	449	=item B<check_passphrase>(I<$username>, I<$passphrase>)
	450
	451	Returns true if the given plaintext passphrase matches the one
	452	obtained from database. Default implementation uses L<Authen::Passphrase>.
	453
	454	=item B<hash_passphrase>(I<$passphrase>)
	455
	456	Returns a RFC2307-formatted hash of the passphrase. Default
	457	implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
	458	of 10 and a random salt.
	459
	460	=item B<set_passphrase>(I<$username>, I<$passphrase>)
	461
	462	Changes a user's passphrase to the given value.
	463
	464	=item B<make_reset_hmac>(I<$username>, [I<@data>])
	465
	466	Returns the HMAC part of the reset token.
	467
	468	=item B<mail_body>(I<$username>, I<$token>)
	469
	470	Returns the body of the password reset email for the given username
	471	and password reset token.
	472
	473	=item B<send_reset_email>(I<$username>)
	474
	475	Generates a new reset token and sends it to the user via email.
	476
	477	=item B<response>(I<$code>, I<$body>)
	478
	479	Helper method. Returns a PSGI response with the given response code
	480	and string body.
	481
	482	=item B<reply>(I<$message>)
	483
	484	Shorthand for C<response(200, $message)>.
	485
	486	=item B<bad_request>(I<$message>)
	487
	488	Shorthand for C<response(400, $message)>.
	489
	490	=item B<internal_server_error>(I<$message>)
	491
	492	Shorthand for C<response(500, $message)>.
	493
	494	=item B<unauthorized>
	495
	496	Returns a 401 Authorization required response.
	497
	498	=item B<call_register>(I<$req>)
	499
f8d502f0	500	Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	501
	502	=item B<call_passwd>(I<$req>)
	503
f8d502f0	504	Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	505
	506	=item B<call_request_reset>(I<$req>)
	507
f8d502f0	508	Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	509
	510	=item B<call_reset>(I<$req>)
	511
f8d502f0	512	Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	513
	514	=back
	515
	516	=head1 AUTHOR
	517
	518	Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
	519
	520	=head1 COPYRIGHT AND LICENSE
	521
	522	Copyright (C) 2015 by Marius Gavrilescu
	523
	524	This library is free software; you can redistribute it and/or modify
	525	it under the same terms as Perl itself, either Perl version 5.20.1 or,
	526	at your option, any later version of Perl 5 you may have available.
	527
	528
	529	=cut