[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</action/register> endpoint. I<$req> is a Plack::Request object.

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

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

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

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

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

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

=back

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by Marius Gavrilescu

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


=cut
Commit	Line	Data
12aa0bc6 MG	1	package Plack::Middleware::Auth::Complex;
	2
	3	use 5.014000;
	4	use strict;
	5	use warnings;
	6
51912257	7	our $VERSION = '0.001';
12aa0bc6 MG	8
12aa0bc6 MG	9	use parent qw/Plack::Middleware/;
1f7bfc27	10	use re '/s';
12aa0bc6 MG	11
	12	use Authen::Passphrase;
	13	use Authen::Passphrase::BlowfishCrypt;
	14	use Bytes::Random::Secure qw/random_bytes/;
1f7bfc27	15	use Carp qw/croak/;
12aa0bc6	16	use DBI;
4c1b8033	17	use Digest::SHA qw/hmac_sha1_base64 sha256/;
12aa0bc6 MG	18	use Email::Simple;
	19	use Email::Sender::Simple qw/sendmail/;
	20	use MIME::Base64 qw/decode_base64/;
	21	use Plack::Request;
4c1b8033	22	use Tie::Hash::Expire;
12aa0bc6 MG	23
	24	sub default_opts {(
	25	dbi_connect => ['dbi:Pg:', '', ''],
	26	select_user => 'SELECT passphrase, email FROM users WHERE id = ?',
	27	update_pass => 'UPDATE users SET passphrase = ? WHERE id = ?',
	28	insert_user => 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
	29	mail_subject => 'Password reset token',
	30	realm => 'restricted area',
4c1b8033 MG	31	cache_fail => 0,
4c1b8033 MG	32	cache_max_age => 5 * 60,
fe1dfcf1	33	token_max_age => 60 * 60,
1f7bfc27	34	username_regex => qr/^\w{2,20}$/as,
388ed281 MG	35	register_url => '/action/register',
	36	passwd_url => '/action/passwd',
	37	request_reset_url => '/action/request-reset',
	38	reset_url => '/action/reset'
12aa0bc6 MG	39	)}
	40
	41	sub new {
	42	my ($class, $opts) = @_;
	43	my %self = $class->default_opts;
	44	%self = (%self, %$opts);
	45	my $self = bless \%self, $class;
	46	$self->init;
	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
1f7bfc27	180	return $self->bad_request('Username must match ' . $self->{username_regex}) 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) = @_;
	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
1f7bfc27	387	C<qr/^\w{2,20}$/as>.
12aa0bc6 MG	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
f8d502f0	489	Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	490
	491	=item B<call_passwd>(I<$req>)
	492
f8d502f0	493	Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	494
	495	=item B<call_request_reset>(I<$req>)
	496
f8d502f0	497	Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	498
	499	=item B<call_reset>(I<$req>)
	500
f8d502f0	501	Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
12aa0bc6 MG	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