]>
iEval git - plack-middleware-auth-complex.git/blob - lib/Plack/Middleware/Auth/Complex.pm
1 package Plack
::Middleware
::Auth
::Complex
;
7 our $VERSION = '0.003';
9 use parent qw
/Plack::Middleware/;
12 use Authen
::Passphrase
;
13 use Authen
::Passphrase
::BlowfishCrypt
;
14 use Data
::Entropy qw
/entropy_source/;
15 use Data
::Entropy
::Source
;
16 use Data
::Entropy
::RawSource
::Local
;
17 use Carp qw
/carp croak/;
19 use Digest
::SHA qw
/hmac_sha1_base64 sha256/;
21 use Email
::Sender
::Simple qw
/sendmail/;
22 use MIME
::Base64 qw
/decode_base64/;
24 use Tie
::Hash
::Expire
;
26 sub make_entropy_source
{
27 if (-e
'/dev/urandom') {
28 Data
::Entropy
::Source
->new(
29 Data
::Entropy
::RawSource
::Local
->new('/dev/urandom'),
33 carp
"/dev/urandom not found, using insecure random source\n";
39 dbi_connect
=> ['dbi:Pg:', '', ''],
40 select_user
=> 'SELECT passphrase, email FROM users WHERE id = ?',
41 update_pass
=> 'UPDATE users SET passphrase = ? WHERE id = ?',
42 insert_user
=> 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
43 mail_subject
=> 'Password reset token',
44 realm
=> 'restricted area',
46 cache_max_age
=> 5 * 60,
47 token_max_age
=> 60 * 60,
48 username_regex
=> qr/^\w{2,20}$/as,
49 invalid_username
=> 'Invalid username',
50 register_url
=> '/action/register',
51 passwd_url
=> '/action/passwd',
52 request_reset_url
=> '/action/request-reset',
53 reset_url
=> '/action/reset'
57 my ($class, $opts) = @_;
58 my %self = $class->default_opts;
59 %self = (%self, %$opts);
60 $self{entropy_source
} //= make_entropy_source
;
61 # If the user did not set [use_scrypt], we set it to 1 if scrypt
62 # is available and to 0 otherwise.
63 # If the user set [use_scrypt] to 1, we try to load scrypt and
64 # croak if we fail to do so.
65 unless (exists $self{use_scrypt
}) {
66 my $success = eval 'use Authen::Passphrase::Scrypt';
67 $self{use_scrypt
} = !!$success
69 if ($self{use_scrypt
}) {
70 eval 'use Authen::Passphrase::Scrypt; 1' or croak
"Failed to load Authen::Passphrase::Scrypt: $@\n";
72 my $self = bless \
%self, $class;
78 $self->{dbh
} = DBI
->connect(@
{$self->{dbi_connect
}}) or croak
$DBI::errstr
;
79 $self->{post_connect_cb
}->($self) if $self->{post_connect_cb
}; # uncoverable branch false
80 $self->{insert_sth
} = $self->{dbh
}->prepare($self->{insert_user
}) or croak
$self->{dbh
}->errstr;
81 $self->{select_sth
} = $self->{dbh
}->prepare($self->{select_user
}) or croak
$self->{dbh
}->errstr;
82 $self->{update_sth
} = $self->{dbh
}->prepare($self->{update_pass
}) or croak
$self->{dbh
}->errstr;
86 my ($self, $parms) = @_;
87 my %parms = $parms->flatten;
88 $self->{insert_sth
}->execute($parms{username
}, $self->hash_passphrase($parms{password
}), $parms{email
}) or croak
$self->{insert_sth
}->errstr;
92 my ($self, $user) = @_;
93 $self->{select_sth
}->execute($user) or croak
$self->{select_sth
}->errstr;
94 $self->{select_sth
}->fetchrow_hashref
97 sub check_passphrase
{
98 my ($self, $username, $passphrase) = @_;
99 unless ($self->{cache
}) {
100 ## no critic (ProhibitTies)
101 tie
my %cache, 'Tie::Hash::Expire', {expire_seconds
=> $self->{cache_max_age
}};
102 $self->{cache
} = \
%cache;
104 my $cachekey = sha256
"$username:$passphrase";
105 return $self->{cache
}{$cachekey} if exists $self->{cache
}{$cachekey}; # uncoverable branch true
106 my $user = $self->get_user($username);
107 return 0 unless $user;
109 if ($user->{passphrase
} =~ /^{SCRYPT}/) {
110 croak
"$username has a scrypt password but use_scrypt is false\n" unless $self->{use_scrypt
};
111 $ret = Authen
::Passphrase
::Scrypt
->from_rfc2307($user->{passphrase
})
113 $ret = Authen
::Passphrase
->from_rfc2307($user->{passphrase
});
115 $ret = $ret->match($passphrase);
116 $self->{cache
}{$cachekey} = $ret if $ret || $self->{cache_fail
};
120 sub hash_passphrase
{
121 my ($self, $passphrase) = @_;
122 if ($self->{use_scrypt
}) {
123 Authen
::Passphrase
::Scrypt
->new({
124 passphrase
=> $passphrase,
127 Authen
::Passphrase
::BlowfishCrypt
->new(
129 passphrase
=> $passphrase,
136 my ($self, $username, $passphrase) = @_;
137 $self->{update_sth
}->execute($self->hash_passphrase($passphrase), $username) or croak
$self->{update_sth
}->errstr;
140 sub make_reset_hmac
{
141 my ($self, $username, @data) = @_;
142 $self->{hmackey
} //= $self->{entropy_source
}->get_bits(8 * 512); # uncoverable condition false
143 my $user = $self->get_user($username);
144 my $message = join ' ', $username, $user->{passphrase
}, @data;
145 hmac_sha1_base64
$message, $self->{hmackey
};
149 my ($self, $username, $token) = @_;
150 my $hours = $self->{token_max_age
} / 60 / 60;
151 $hours .= $hours == 1 ?
' hour' : ' hours'; # uncoverable branch false
153 Someone has requested a password reset for your account.
155 To reset your password, please submit the reset password form on the
156 website using the following information:
159 Password: <your new password>
162 The token is valid for $hours.
166 sub send_reset_email
{
167 my ($self, $username) = @_;
168 my $expire = time + $self->{token_max_age
};
169 my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
170 my $user = $self->get_user($username);
171 sendmail
(Email
::Simple
->create(
173 From
=> $self->{mail_from
},
174 To
=> $user->{email
},
175 Subject
=> $self->{mail_subject
},
177 body
=> $self->mail_body($username, $token),
181 ##################################################
184 my ($self, $code, $body) = @_;
187 ['Content-Type' => 'text/plain',
188 'Content-Length' => length $body],
193 sub reply
{ shift->response(200, $_[0]) }
194 sub bad_request
{ shift->response(400, $_[0]) }
195 sub internal_server_error
{ shift->response(500, $_[0]) }
199 my $body = 'Authorization required';
202 ['Content-Type' => 'text/plain',
203 'Content-Length' => length $body,
204 'WWW-Authenticate' => 'Basic realm="' . $self->{realm
} . '"' ],
209 ##################################################
212 my ($self, $req) = @_;
214 for (qw
/username password confirm_password email/) {
215 $parms{$_} = $req->param($_);
216 return $self->bad_request("Missing parameter $_") unless $parms{$_};
219 return $self->bad_request($self->{invalid_username
}) unless $parms{username
} =~ $self->{username_regex
};
220 return $self->bad_request('Username already in use') if $self->get_user($parms{username
});
221 return $self->bad_request('The two passwords do not match') unless $parms{password
} eq $parms{confirm_password
};
223 $self->create_user($req->parameters);
224 return $self->reply('Registered successfully')
228 my ($self, $req) = @_;
229 return $self->unauthorized unless $req->user;
231 for (qw
/password new_password confirm_new_password/) {
232 $parms{$_} = $req->param($_);
233 return $self->bad_request("Missing parameter $_") unless $parms{$_};
236 return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password
});
237 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
238 $self->set_passphrase($req->user, $parms{new_password
});
239 return $self->reply('Password changed successfully');
242 sub call_request_reset
{
243 my ($self, $req) = @_;
244 return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from
};
245 my $username = $req->param('username');
246 my $user = $self->get_user($username) or return $self->bad_request('No such user');
248 $self->send_reset_email($username);
250 } or return $self->internal_server_error($@
);
251 $self->reply('Email sent');
255 my ($self, $req) = @_;
257 for (qw
/username new_password confirm_new_password token/) {
258 $parms{$_} = $req->param($_);
259 return $self->bad_request("Missing parameter $_") unless $parms{$_};
262 my $user = $self->get_user($parms{username
}) or return $self->bad_request('No such user');
263 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
264 my ($token, $exp) = split /:/, $parms{token
};
265 my $goodtoken = $self->make_reset_hmac($parms{username
}, $exp);
266 return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
267 return $self->bad_request('Reset token has expired') if time >= $exp;
268 $self->set_passphrase($parms{username
}, $parms{new_password
});
269 return $self->reply('Password reset successfully');
273 my ($self, $env) = @_;
275 unless ($self->{init_done
}) {
277 $self->{init_done
} = 1;
280 my $auth = $env->{HTTP_AUTHORIZATION
};
281 if ($auth && $auth =~ /^Basic (.*)$/i) {
282 my ($user, $pass) = split /:/, decode_base64
($1), 2;
283 $env->{REMOTE_USER
} = $user if $self->check_passphrase($user, $pass);
286 my $req = Plack
::Request
->new($env);
288 if ($req->method eq 'POST') {
289 return $self->call_register($req) if $req->path eq $self->{register_url
};
290 return $self->call_passwd($req) if $req->path eq $self->{passwd_url
};
291 return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url
};
292 return $self->call_reset($req) if $req->path eq $self->{reset_url
};
295 $env->{authcomplex
} = $self;
304 Plack::Middleware::Auth::Complex - Feature-rich authentication system
311 enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
314 [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
320 AuthComplex is an authentication system for Plack applications that
321 allows user registration, password changing and password reset.
323 AuthComplex sets REMOTE_USER if the request includes correct basic
324 authentication and intercepts POST requests to some configurable URLs.
325 It also sets C<< $env->{authcomplex} >> to itself before passing the
328 Some options can be controlled by passing a hashref to the
329 constructor. More customization can be achieved by subclassing this
332 =head2 Intercepted URLs
334 Only POST requests are intercepted. Parameters can be either query
335 parameters or body parameters. Using query parameters is not
336 recommended. These endpoints return 200 for success, 400 for client
337 error and 500 for server errors. All parameters are mandatory.
341 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
343 This URL creates a new user with the given username, password and
344 email. The two passwords must match, the user must match
345 C<username_regex> and the user must not already exist.
347 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
349 This URL changes the password of a user. The user must be
350 authenticated (otherwise the endpoint will return 401).
352 =item B<POST> /action/request-reset?username=user
354 This URL requests a password reset token for the given user. The token
355 will be sent to the user's email address.
357 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
359 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
361 This URL performs a password reset.
365 =head2 Constructor arguments
371 Arrayref of arguments to pass to DBI->connect. Defaults to
372 C<['dbi:Pg', '', '']>.
376 C<Data::Entropy::Source> object to get random numbers from. By default
377 uses F</dev/urandom> via C<Data::Entropy::RawSource::Local> if
378 possible, or the default entropy source otherwise. A warning is
379 printed if the default entropy source is used, to supress it set this
380 argument to the default entropy source.
384 Boolean determining whether to use the scrypt algorithm via the
385 C<Authen::Passphrase::Scrypt> module.
387 If true, the default implementation of C<hash_passphrase> uses scrypt
388 and C<check_passphrase> accepts scrypt passphrases (in addition to
389 passphrases supported by C<Authen::Passphrase>).
391 If false, the default implementation of C<hash_passphrase> uses bcrypt
392 and C<check_passphrase> only accepts passphrases supported by
393 C<Authen::Passphrase>.
395 The default value is true if C<Authen::Passphrase::Scrypt> is
396 installed, false otherwise.
398 =item post_connect_cb
400 Callback (coderef) that is called just after connecting to the
401 database. Used by the testsuite to create the users table.
405 SQL statement that selects a user by username. Defaults to
406 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
410 SQL statement that updates a user's password. Defaults to
411 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
415 SQL statement that inserts a user. Defaults to
416 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
420 HMAC key used for password reset tokens. If not provided it is
421 generated randomly, in which case reset tokens do not persist across
422 application restarts.
426 From: header of password reset emails. If not provided, password reset
431 The subject of password reset emails. Defaults to
432 C<'Password reset token'>.
436 Authentication realm. Defaults to C<'restricted area'>.
440 If true, all authentication results are cached. If false, only
441 successful logins are cached. Defaults to false.
445 Authentication cache timeout, in seconds. Authentication results are
446 cached for this number of seconds to avoid expensive hashing. Defaults
451 Password reset token validity, in seconds. Defaults to 1 hour.
455 Regular expression that matches valid usernames. Defaults to
458 =item invalid_username
460 Error message returned when the username does not match
461 username_regex. Defaults to C<'Invalid username'>
465 URL for registering. Defaults to C<'/action/register'>.
469 URL for changing your password. Defaults to C<'/action/passwd'>.
471 =item request_reset_url
473 URL for requesting a password reset token by email. Defaults to
474 C<'/action/request-reset'>.
478 URL for resetting your password with a reset token. Defaults to
487 =item B<default_opts>
489 Returns a list of default options for the constructor.
491 =item B<new>(I<\%opts>)
493 Creates a new AuthComplex object.
497 Called when the first request is received. The default implementation
498 connects to the database, calls C<post_connect_cb> and prepares the
501 =item B<create_user>(I<$parms>)
503 Inserts a new user into the database. I<$parms> is a
504 L<Hash::MultiValue> object containing the request parameters.
506 =item B<get_user>(I<$username>)
508 Returns a hashref with (at least) the following keys: passphrase (the
509 RFC2307-formatted passphrase of the user), email (the user's email
512 =item B<check_passphrase>(I<$username>, I<$passphrase>)
514 Returns true if the given plaintext passphrase matches the one
515 obtained from database. Default implementation uses
516 L<Authen::Passphrase> (and L<Authen::Passphrase::Scrypt> if
517 C<use_scrypt> is true).
519 =item B<hash_passphrase>(I<$passphrase>)
521 Returns a RFC2307-formatted hash of the passphrase.
523 If C<use_scrypt> is true, default implementation uses
524 L<Authen::Passphrase::Scrypt> with default parameters.
526 If C<use_scrypt> is false, default implementation uses
527 L<Authen::Passphrase::BlowfishCrypt> with a cost of 10 and a random
530 =item B<set_passphrase>(I<$username>, I<$passphrase>)
532 Changes a user's passphrase to the given value.
534 =item B<make_reset_hmac>(I<$username>, [I<@data>])
536 Returns the HMAC part of the reset token.
538 =item B<mail_body>(I<$username>, I<$token>)
540 Returns the body of the password reset email for the given username
541 and password reset token.
543 =item B<send_reset_email>(I<$username>)
545 Generates a new reset token and sends it to the user via email.
547 =item B<response>(I<$code>, I<$body>)
549 Helper method. Returns a PSGI response with the given response code
552 =item B<reply>(I<$message>)
554 Shorthand for C<response(200, $message)>.
556 =item B<bad_request>(I<$message>)
558 Shorthand for C<response(400, $message)>.
560 =item B<internal_server_error>(I<$message>)
562 Shorthand for C<response(500, $message)>.
564 =item B<unauthorized>
566 Returns a 401 Authorization required response.
568 =item B<call_register>(I<$req>)
570 Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
572 =item B<call_passwd>(I<$req>)
574 Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
576 =item B<call_request_reset>(I<$req>)
578 Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
580 =item B<call_reset>(I<$req>)
582 Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
588 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
590 =head1 COPYRIGHT AND LICENSE
592 Copyright (C) 2015-2017 by Marius Gavrilescu
594 This library is free software; you can redistribute it and/or modify
595 it under the same terms as Perl itself, either Perl version 5.20.1 or,
596 at your option, any later version of Perl 5 you may have available.
This page took 0.085512 seconds and 4 git commands to generate.