From 12aa0bc64ec5cbecd0cce89d1144deb0c66bbd61 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sun, 1 Mar 2015 01:20:21 +0200 Subject: [PATCH] Initial commit --- Changes | 4 + MANIFEST | 6 + Makefile.PL | 32 ++ README | 39 +++ lib/Plack/Middleware/Auth/Complex.pm | 484 +++++++++++++++++++++++++++ t/Plack-Middleware-Auth-Complex.t | 85 +++++ 6 files changed, 650 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/Plack/Middleware/Auth/Complex.pm create mode 100644 t/Plack-Middleware-Auth-Complex.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..44802dd --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension Plack::Middleware::Auth::Complex. + +0.000_001 2015-03-01T01:20+02:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..3a3a84a --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/Plack-Middleware-Auth-Complex.t +lib/Plack/Middleware/Auth/Complex.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3d96b1a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,32 @@ +use 5.014000; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Plack::Middleware::Auth::Complex', + VERSION_FROM => 'lib/Plack/Middleware/Auth/Complex.pm', + ABSTRACT_FROM => 'lib/Plack/Middleware/Auth/Complex.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + BUILD_REQUIRES => { + qw/DBD::SQLite 0 + HTTP::Request::Common 0 + Plack::Test 0/, + }, + PREREQ_PM => { + qw/Authen::Passphrase 0 + Authen::Passphrase::BlowfishCrypt 0 + Bytes::Random::Secure 0 + DBI 0 + Email::Simple 0 + Email::Sender::Simple 0 + Plack::Request 0/, + }, + META_MERGE => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=plack-middleware-auth-complex.git', + } + } +); diff --git a/README b/README new file mode 100644 index 0000000..338c74f --- /dev/null +++ b/README @@ -0,0 +1,39 @@ +Plack-Middleware-Auth-Complex version 0.000_001 +=============================================== + +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. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Authen::Passphrase +* Bytes::Random::Secure +* DBI + DBD::SQLite +* Email::Simple +* Plack + +COPYRIGHT AND LICENCE + +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. + + diff --git a/lib/Plack/Middleware/Auth/Complex.pm b/lib/Plack/Middleware/Auth/Complex.pm new file mode 100644 index 0000000..0f6759d --- /dev/null +++ b/lib/Plack/Middleware/Auth/Complex.pm @@ -0,0 +1,484 @@ +package Plack::Middleware::Auth::Complex; + +use 5.014000; +use strict; +use warnings; + +our $VERSION = '0.000_001'; +$VERSION = eval $VERSION; # see L + +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/; +use Email::Simple; +use Email::Sender::Simple qw/sendmail/; +use MIME::Base64 qw/decode_base64/; +use Plack::Request; + +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', + token_max_age => 60 * 60 * 24, + username_regex => qr/^\w{2,20}$/a, + register_url => '/register', + passwd_url => '/passwd', + request_reset_url => '/request-reset', + reset_url => '/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 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) = @_; + my $user = $self->get_user($username); + return 0 unless $user; + Authen::Passphrase->from_rfc2307($user->{passphrase})->match($passphrase) +} + +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'; + < +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 => $user->{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->{insert_sth}->execute($parms{username}, $self->hash_passphrase($parms{password}), $parms{email}); + 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 /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 and the user must not already exist. + +=item B /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 /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 /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 token_max_age + +Password reset token validity, in seconds. Defaults to 24 hours. + +=item username_regex + +Regular expression that matches valid usernames. Defaults to +C. + +=item register_url + +URL for registering. Defaults to C<'/register'>. + +=item passwd_url + +URL for changing your password. Defaults to C<'/passwd'>. + +=item request_reset_url + +URL for requesting a password reset token by email. Defaults to +C<'/request-reset'>. + +=item reset_url + +URL for resetting your password with a reset token. Defaults to +C<'/reset'>. + +=back + +=head2 Methods + +=over + +=item B + +Returns a list of default options for the constructor. + +=item B(I<\%opts>) + +Creates a new AuthComplex object. + +=item B + +Called at the end of the constructor. The default implementation +connects to the database, calls C and prepares the +SQL statements. + +=item B(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(I<$username>, I<$passphrase>) + +Returns true if the given plaintext passphrase matches the one +obtained from database. Default implementation uses L. + +=item B(I<$passphrase>) + +Returns a RFC2307-formatted hash of the passphrase. Default +implementation uses L with a cost +of 10 and a random salt. + +=item B(I<$username>, I<$passphrase>) + +Changes a user's passphrase to the given value. + +=item B(I<$username>, [I<@data>]) + +Returns the HMAC part of the reset token. + +=item B(I<$username>, I<$token>) + +Returns the body of the password reset email for the given username +and password reset token. + +=item B(I<$username>) + +Generates a new reset token and sends it to the user via email. + +=item B(I<$code>, I<$body>) + +Helper method. Returns a PSGI response with the given response code +and string body. + +=item B(I<$message>) + +Shorthand for C. + +=item B(I<$message>) + +Shorthand for C. + +=item B(I<$message>) + +Shorthand for C. + +=item B + +Returns a 401 Authorization required response. + +=item B(I<$req>) + +Handles the C endpoint. I<$req> is a Plack::Request object. + +=item B(I<$req>) + +Handles the C endpoint. I<$req> is a Plack::Request object. + +=item B(I<$req>) + +Handles the C endpoint. I<$req> is a Plack::Request object. + +=item B(I<$req>) + +Handles the C endpoint. I<$req> is a Plack::Request object. + +=back + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=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 diff --git a/t/Plack-Middleware-Auth-Complex.t b/t/Plack-Middleware-Auth-Complex.t new file mode 100644 index 0000000..956ee67 --- /dev/null +++ b/t/Plack-Middleware-Auth-Complex.t @@ -0,0 +1,85 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 59; +BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' } +BEGIN { use_ok('Plack::Middleware::Auth::Complex') }; + +use HTTP::Request::Common; +use MIME::Base64 qw/encode_base64/; +use Plack::Test; + +sub app { + my ($env) = shift; + [200, [], [$env->{REMOTE_USER} || 'Anon']] +} + +my $auth; + +sub set_auth { + my ($user, $pass) = @_; + $auth = 'Basic ' . encode_base64 "$user:$pass" +} + +sub is_http { + my ($resp, $code, $body, $name) = @_; + is $resp->code, $code, "$name - code"; + is $resp->content, $body, "$name - body"; +} + +my $create_table = 'CREATE TABLE users (id TEXT PRIMARY KEY, passphrase TEXT, email TEXT)'; +my $ac = Plack::Middleware::Auth::Complex->new({ + dbi_connect => ['dbi:SQLite:dbname=:memory:'], + post_connect_cb => sub { shift->{dbh}->do($create_table) }, +}); + +my $app = $ac->wrap(\&app); +my @register_args = (username => 'user', password => 'password', confirm_password => 'password', email => 'user@example.org'); +my @passwd_args = (password => 'password', new_password => 'newpassword', confirm_new_password => 'newpassword'); +my @reset_args = (username => 'user', new_password => 'password', confirm_new_password => 'password', token => '???:???'); + +test_psgi $app, sub { + my ($cb) = @_; + is_http $cb->(GET '/'), 200, 'Anon', 'GET /'; + is_http $cb->(POST '/'), 200, 'Anon', 'POST /'; + is_http $cb->(GET '/register'), 200, 'Anon', 'GET /register'; + set_auth 'user', 'password'; + is_http $cb->(GET '/', Authorization => $auth), 200, 'Anon', 'GET / with bad user/pass'; + is_http $cb->(POST '/register'), 400, 'Missing parameter username', 'POST /register with no parameters'; + is_http $cb->(POST '/register', [@register_args, username => '???'] ), 400, 'Username must match (?^a:^\w{2,20}$)', 'POST /register with bad username'; + is_http $cb->(POST '/register', [@register_args, password => '???'] ), 400, 'The two passwords do not match', 'POST /register with different passwords'; + is_http $cb->(POST '/register', \@register_args), 200, 'Registered successfully', 'POST /register with correct parameters', + is_http $cb->(POST '/register', \@register_args), 400, 'Username already in use', 'POST /register with existing user', + is_http $cb->(GET '/', Authorization => $auth), 200, 'user', 'GET / with correct user/pass'; + + is_http $cb->(POST '/passwd'), 401, 'Authorization required', 'POST /passwd without authorization'; + is_http $cb->(POST '/passwd', Authorization => $auth), 400, 'Missing parameter password', 'POST /passwd with no parameters'; + is_http $cb->(POST '/passwd', [@passwd_args, password => '???'], Authorization => $auth), 400, 'Incorrect password', 'POST /passwd with incorrect old password'; + is_http $cb->(POST '/passwd', [@passwd_args, new_password => '???'], Authorization => $auth), 400, 'The two passwords do not match', 'POST /passwd with different new passwords'; + is_http $cb->(POST '/passwd', \@passwd_args, Authorization => $auth), 200, 'Password changed successfully', 'POST /passwd with correct parameters'; + is_http $cb->(GET '/', Authorization => $auth), 200, 'Anon', 'GET / with bad user/pass'; + set_auth 'user', 'newpassword'; + is_http $cb->(GET '/', Authorization => $auth), 200, 'user', 'GET / with correct user/pass'; + + is_http $cb->(POST '/request-reset'), 500, 'Password resets are disabled', 'POST /request-reset with password resets disabled'; + $ac->{mail_from} = 'nobody '; + is_http $cb->(POST '/request-reset'), 400, 'No such user', 'POST /request-reset with no username'; + is_http $cb->(POST '/request-reset', [username => '???']), 400, 'No such user', 'POST /request-reset with inexistent username'; + is_http $cb->(POST '/request-reset', [username => 'user']), 200, 'Email sent', 'POST /request-reset with correct user'; + + my ($mail) = Email::Sender::Simple->default_transport->deliveries; + my ($token) = $mail->{email}->get_body =~ /token: (.*)$/m; + chomp $token; # Remove final \n + chop $token; # Remove final \r + + is_http $cb->(POST '/reset'), 400, 'Missing parameter username', 'POST /reset with no parameters'; + is_http $cb->(POST '/reset', [@reset_args, username => '???']), 400, 'No such user', 'POST /reset with inexistent username'; + is_http $cb->(POST '/reset', [@reset_args, new_password => '???']), 400, 'The two passwords do not match', 'POST /reset with different passwords'; + is_http $cb->(POST '/reset', \@reset_args), 400, 'Bad reset token', 'POST /reset with bad token'; + is_http $cb->(POST '/reset', [@reset_args, token => $ac->make_reset_hmac('user', 0) . ':0']), 400, 'Reset token has expired', 'POST /reset with expired token'; + is_http $cb->(POST '/reset', [@reset_args, token => $token]), 200, 'Password reset successfully', 'POST /reset with correct token'; + is_http $cb->(GET '/', Authorization => $auth), 200, 'Anon', 'GET / with bad user/pass'; + set_auth 'user', 'password'; + is_http $cb->(GET '/', Authorization => $auth), 200, 'user', 'GET / with correct user/pass'; +} -- 2.30.2