Add (optional) scrypt support

diff --git a/Makefile.PL b/Makefile.PL
index 94058df80c5108348de8bf44dd95e6c95193d26b..7261cbe034379e9da6790f80d0f0e03687f529da 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -28,6 +28,9 @@ WriteMakefile(
        },
        META_MERGE         => {
                dynamic_config => 0,
        },
        META_MERGE         => {
                dynamic_config => 0,

+               recommends     => {
+                       qw/Authen::Passphrase::Scrypt 0/,
+               },

                resources      => {
                        repository => 'https://git.ieval.ro/?p=plack-middleware-auth-complex.git',
                }
                resources      => {
                        repository => 'https://git.ieval.ro/?p=plack-middleware-auth-complex.git',
                }

diff --git a/authcomplex-passwd b/authcomplex-passwd
index febbe057827a8d640b01f0c36637fb37f64446d3..69374e8dd30dc62646b318a99f944dfce2c01162 100755 (executable)
--- a/authcomplex-passwd
+++ b/authcomplex-passwd
@@ -56,6 +56,8 @@ authcomplex-passwd - change user password
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

+B<NOTE: This script does not support scrypt passphrases.>
+

 The authcomplex-passwd script changes the password for an user.
 Takes one mandatory argument, the user whose password should be changed.
 
 The authcomplex-passwd script changes the password for an user.
 Takes one mandatory argument, the user whose password should be changed.
 

diff --git a/lib/Plack/Middleware/Auth/Complex.pm b/lib/Plack/Middleware/Auth/Complex.pm
index 59d9bc3b8df46972f6fb2d59c5afc081e09fc880..d4b5e4b997d218c76cb584f514da5ee5e3ff733e 100644 (file)
--- a/lib/Plack/Middleware/Auth/Complex.pm
+++ b/lib/Plack/Middleware/Auth/Complex.pm
@@ -58,6 +58,17 @@ sub new {
        my %self = $class->default_opts;
        %self = (%self, %$opts);
        $self{entropy_source} //= make_entropy_source;
        my %self = $class->default_opts;
        %self = (%self, %$opts);
        $self{entropy_source} //= make_entropy_source;

+       # If the user did not set [use_scrypt], we set it to 1 if scrypt
+       # is available and to 0 otherwise.
+       # If the user set [use_scrypt] to 1, we try to load scrypt and
+       # croak if we fail to do so.
+       unless (exists $self{use_scrypt}) {
+               my $success = eval 'use Authen::Passphrase::Scrypt';
+               $self{use_scrypt} = !!$success
+       }
+       if ($self{use_scrypt}) {
+               eval 'use Authen::Passphrase::Scrypt; 1' or croak "Failed to load Authen::Passphrase::Scrypt: $@\n";
+       }

        my $self = bless \%self, $class;
        $self
 }
        my $self = bless \%self, $class;
        $self
 }


@@ -94,18 +105,31 @@ sub check_passphrase {
        return $self->{cache}{$cachekey} if exists $self->{cache}{$cachekey}; # uncoverable branch true
        my $user = $self->get_user($username);
        return 0 unless $user;
        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);
+       my $ret;
+       if ($user->{passphrase} =~ /^{SCRYPT}/) {
+               croak "$username has a scrypt password but use_scrypt is false\n" unless $self->{use_scrypt};
+               $ret = Authen::Passphrase::Scrypt->from_rfc2307($user->{passphrase})
+       } else {
+               $ret = Authen::Passphrase->from_rfc2307($user->{passphrase});
+       }
+       $ret = $ret->match($passphrase);

        $self->{cache}{$cachekey} = $ret if $ret || $self->{cache_fail};
        $ret
 }
 
 sub hash_passphrase {
        my ($self, $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
+       if ($self->{use_scrypt}) {
+               Authen::Passphrase::Scrypt->new({
+                       passphrase => $passphrase,
+               })->as_rfc2307
+       } else {
+               Authen::Passphrase::BlowfishCrypt->new(
+                       cost => 10,
+                       passphrase => $passphrase,
+                       salt_random => 1,
+               )->as_rfc2307
+       }

 }
 
 sub set_passphrase {
 }
 
 sub set_passphrase {


@@ -355,6 +379,22 @@ possible, or the default entropy source otherwise. A warning is
 printed if the default entropy source is used, to supress it set this
 argument to the default entropy source.
 
 printed if the default entropy source is used, to supress it set this
 argument to the default entropy source.
 

+=item use_scrypt
+
+Boolean determining whether to use the scrypt algorithm via the
+C<Authen::Passphrase::Scrypt> module.
+
+If true, the default implementation of C<hash_passphrase> uses scrypt
+and C<check_passphrase> accepts scrypt passphrases (in addition to
+passphrases supported by C<Authen::Passphrase>).
+
+If false, the default implementation of C<hash_passphrase> uses bcrypt
+and C<check_passphrase> only accepts passphrases supported by
+C<Authen::Passphrase>.
+
+The default value is true if C<Authen::Passphrase::Scrypt> is
+installed, false otherwise.
+

 =item post_connect_cb
 
 Callback (coderef) that is called just after connecting to the
 =item post_connect_cb
 
 Callback (coderef) that is called just after connecting to the


@@ -472,13 +512,20 @@ address).
 =item B<check_passphrase>(I<$username>, I<$passphrase>)
 
 Returns true if the given plaintext passphrase matches the one
 =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>.
+obtained from database. Default implementation uses
+L<Authen::Passphrase> (and L<Authen::Passphrase::Scrypt> if
+C<use_scrypt> is true).

 
 =item B<hash_passphrase>(I<$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.
+Returns a RFC2307-formatted hash of the passphrase.
+
+If C<use_scrypt> is true, default implementation uses
+L<Authen::Passphrase::Scrypt> with default parameters.
+
+If C<use_scrypt> is false, default implementation uses
+L<Authen::Passphrase::BlowfishCrypt> with a cost of 10 and a random
+salt.

 
 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 
 
 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 

diff --git a/t/Plack-Middleware-Auth-Complex.t b/t/Plack-Middleware-Auth-Complex.t
index 72de5723e6c1db4605066a2992abef11093e3d8d..0a92f360aba46b66c0c8cf9dc54d07c8bbda26f5 100644 (file)
--- a/t/Plack-Middleware-Auth-Complex.t
+++ b/t/Plack-Middleware-Auth-Complex.t
@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 

-use Test::More tests => 61;
+use Test::More tests => 121;

 BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' }
 BEGIN { use_ok('Plack::Middleware::Auth::Complex') };
 
 BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' }
 BEGIN { use_ok('Plack::Middleware::Auth::Complex') };
 


@@ -28,64 +28,80 @@ sub is_http {
        is $resp->content, $body, "$name - body";
 }
 
        is $resp->content, $body, "$name - body";
 }
 

+my $has_scrypt = !!eval 'use Authen::Passphrase::Scrypt; 1';
+note "Failed to load Authen::Passphrase::Scrypt: $@" unless $has_scrypt;
+

 my $create_table = 'CREATE TABLE users (id TEXT PRIMARY KEY, passphrase TEXT, email TEXT)';
 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) },
-       register_url      => '/register',
-       passwd_url        => '/passwd',
-       request_reset_url => '/request-reset',
-       reset_url         => '/reset',
-       cache_max_age     => 0,
-});
-
-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 => 'Hello'), 200, 'Anon', 'GET / with invalid Authorization';
-       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, 'Invalid username', '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 <nobody@example.org>';
-       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';
+
+for my $use_scrypt (qw/0 1/) {
+       if ($use_scrypt && !$has_scrypt) {
+         SKIP: {
+                       skip 'Authen::Passphrase::Scrypt not installed', 61
+               }
+               return
+       }
+
+       my $ac = Plack::Middleware::Auth::Complex->new({
+               dbi_connect       => ['dbi:SQLite:dbname=:memory:'],
+               post_connect_cb   => sub { shift->{dbh}->do($create_table) },
+               register_url      => '/register',
+               passwd_url        => '/passwd',
+               request_reset_url => '/request-reset',
+               reset_url         => '/reset',
+               cache_max_age     => 0,
+               use_scrypt        => $use_scrypt,
+       });
+
+       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 => 'Hello'), 200, 'Anon', 'GET / with invalid Authorization';
+               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, 'Invalid username', '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 <nobody@example.org>';
+               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;
+               Email::Sender::Simple->default_transport->clear_deliveries;
+               my ($token) = $mail->{email}->get_body =~ /token: (.*)$/m;
+               chomp $token;                   # Remove final \n
+               chop $token;                    # Remove final \r
+               note "Reset token is $token";
+
+               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';
+       }

 }
 }