]>
iEval git - plack-middleware-auth-complex.git/blob - Complex.pm
59d9bc3b8df46972f6fb2d59c5afc081e09fc880
1 package Plack
::Middleware
::Auth
::Complex
;
7 our $VERSION = '0.002';
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 my $self = bless \
%self, $class;
67 $self->{dbh
} = DBI
->connect(@
{$self->{dbi_connect
}}) or croak
$DBI::errstr
;
68 $self->{post_connect_cb
}->($self) if $self->{post_connect_cb
}; # uncoverable branch false
69 $self->{insert_sth
} = $self->{dbh
}->prepare($self->{insert_user
}) or croak
$self->{dbh
}->errstr;
70 $self->{select_sth
} = $self->{dbh
}->prepare($self->{select_user
}) or croak
$self->{dbh
}->errstr;
71 $self->{update_sth
} = $self->{dbh
}->prepare($self->{update_pass
}) or croak
$self->{dbh
}->errstr;
75 my ($self, $parms) = @_;
76 my %parms = $parms->flatten;
77 $self->{insert_sth
}->execute($parms{username
}, $self->hash_passphrase($parms{password
}), $parms{email
}) or croak
$self->{insert_sth
}->errstr;
81 my ($self, $user) = @_;
82 $self->{select_sth
}->execute($user) or croak
$self->{select_sth
}->errstr;
83 $self->{select_sth
}->fetchrow_hashref
86 sub check_passphrase
{
87 my ($self, $username, $passphrase) = @_;
88 unless ($self->{cache
}) {
89 ## no critic (ProhibitTies)
90 tie
my %cache, 'Tie::Hash::Expire', {expire_seconds
=> $self->{cache_max_age
}};
91 $self->{cache
} = \
%cache;
93 my $cachekey = sha256
"$username:$passphrase";
94 return $self->{cache
}{$cachekey} if exists $self->{cache
}{$cachekey}; # uncoverable branch true
95 my $user = $self->get_user($username);
96 return 0 unless $user;
97 my $ret = Authen
::Passphrase
->from_rfc2307($user->{passphrase
})->match($passphrase);
98 $self->{cache
}{$cachekey} = $ret if $ret || $self->{cache_fail
};
102 sub hash_passphrase
{
103 my ($self, $passphrase) = @_;
104 Authen
::Passphrase
::BlowfishCrypt
->new(
106 passphrase
=> $passphrase,
112 my ($self, $username, $passphrase) = @_;
113 $self->{update_sth
}->execute($self->hash_passphrase($passphrase), $username) or croak
$self->{update_sth
}->errstr;
116 sub make_reset_hmac
{
117 my ($self, $username, @data) = @_;
118 $self->{hmackey
} //= $self->{entropy_source
}->get_bits(8 * 512); # uncoverable condition false
119 my $user = $self->get_user($username);
120 my $message = join ' ', $username, $user->{passphrase
}, @data;
121 hmac_sha1_base64
$message, $self->{hmackey
};
125 my ($self, $username, $token) = @_;
126 my $hours = $self->{token_max_age
} / 60 / 60;
127 $hours .= $hours == 1 ?
' hour' : ' hours'; # uncoverable branch false
129 Someone has requested a password reset for your account.
131 To reset your password, please submit the reset password form on the
132 website using the following information:
135 Password: <your new password>
138 The token is valid for $hours.
142 sub send_reset_email
{
143 my ($self, $username) = @_;
144 my $expire = time + $self->{token_max_age
};
145 my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
146 my $user = $self->get_user($username);
147 sendmail
(Email
::Simple
->create(
149 From
=> $self->{mail_from
},
150 To
=> $user->{email
},
151 Subject
=> $self->{mail_subject
},
153 body
=> $self->mail_body($username, $token),
157 ##################################################
160 my ($self, $code, $body) = @_;
163 ['Content-Type' => 'text/plain',
164 'Content-Length' => length $body],
169 sub reply
{ shift->response(200, $_[0]) }
170 sub bad_request
{ shift->response(400, $_[0]) }
171 sub internal_server_error
{ shift->response(500, $_[0]) }
175 my $body = 'Authorization required';
178 ['Content-Type' => 'text/plain',
179 'Content-Length' => length $body,
180 'WWW-Authenticate' => 'Basic realm="' . $self->{realm
} . '"' ],
185 ##################################################
188 my ($self, $req) = @_;
190 for (qw
/username password confirm_password email/) {
191 $parms{$_} = $req->param($_);
192 return $self->bad_request("Missing parameter $_") unless $parms{$_};
195 return $self->bad_request($self->{invalid_username
}) unless $parms{username
} =~ $self->{username_regex
};
196 return $self->bad_request('Username already in use') if $self->get_user($parms{username
});
197 return $self->bad_request('The two passwords do not match') unless $parms{password
} eq $parms{confirm_password
};
199 $self->create_user($req->parameters);
200 return $self->reply('Registered successfully')
204 my ($self, $req) = @_;
205 return $self->unauthorized unless $req->user;
207 for (qw
/password new_password confirm_new_password/) {
208 $parms{$_} = $req->param($_);
209 return $self->bad_request("Missing parameter $_") unless $parms{$_};
212 return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password
});
213 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
214 $self->set_passphrase($req->user, $parms{new_password
});
215 return $self->reply('Password changed successfully');
218 sub call_request_reset
{
219 my ($self, $req) = @_;
220 return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from
};
221 my $username = $req->param('username');
222 my $user = $self->get_user($username) or return $self->bad_request('No such user');
224 $self->send_reset_email($username);
226 } or return $self->internal_server_error($@
);
227 $self->reply('Email sent');
231 my ($self, $req) = @_;
233 for (qw
/username new_password confirm_new_password token/) {
234 $parms{$_} = $req->param($_);
235 return $self->bad_request("Missing parameter $_") unless $parms{$_};
238 my $user = $self->get_user($parms{username
}) or return $self->bad_request('No such user');
239 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
240 my ($token, $exp) = split /:/, $parms{token
};
241 my $goodtoken = $self->make_reset_hmac($parms{username
}, $exp);
242 return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
243 return $self->bad_request('Reset token has expired') if time >= $exp;
244 $self->set_passphrase($parms{username
}, $parms{new_password
});
245 return $self->reply('Password reset successfully');
249 my ($self, $env) = @_;
251 unless ($self->{init_done
}) {
253 $self->{init_done
} = 1;
256 my $auth = $env->{HTTP_AUTHORIZATION
};
257 if ($auth && $auth =~ /^Basic (.*)$/i) {
258 my ($user, $pass) = split /:/, decode_base64
($1), 2;
259 $env->{REMOTE_USER
} = $user if $self->check_passphrase($user, $pass);
262 my $req = Plack
::Request
->new($env);
264 if ($req->method eq 'POST') {
265 return $self->call_register($req) if $req->path eq $self->{register_url
};
266 return $self->call_passwd($req) if $req->path eq $self->{passwd_url
};
267 return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url
};
268 return $self->call_reset($req) if $req->path eq $self->{reset_url
};
271 $env->{authcomplex
} = $self;
280 Plack::Middleware::Auth::Complex - Feature-rich authentication system
287 enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
290 [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
296 AuthComplex is an authentication system for Plack applications that
297 allows user registration, password changing and password reset.
299 AuthComplex sets REMOTE_USER if the request includes correct basic
300 authentication and intercepts POST requests to some configurable URLs.
301 It also sets C<< $env->{authcomplex} >> to itself before passing the
304 Some options can be controlled by passing a hashref to the
305 constructor. More customization can be achieved by subclassing this
308 =head2 Intercepted URLs
310 Only POST requests are intercepted. Parameters can be either query
311 parameters or body parameters. Using query parameters is not
312 recommended. These endpoints return 200 for success, 400 for client
313 error and 500 for server errors. All parameters are mandatory.
317 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
319 This URL creates a new user with the given username, password and
320 email. The two passwords must match, the user must match
321 C<username_regex> and the user must not already exist.
323 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
325 This URL changes the password of a user. The user must be
326 authenticated (otherwise the endpoint will return 401).
328 =item B<POST> /action/request-reset?username=user
330 This URL requests a password reset token for the given user. The token
331 will be sent to the user's email address.
333 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
335 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
337 This URL performs a password reset.
341 =head2 Constructor arguments
347 Arrayref of arguments to pass to DBI->connect. Defaults to
348 C<['dbi:Pg', '', '']>.
352 C<Data::Entropy::Source> object to get random numbers from. By default
353 uses F</dev/urandom> via C<Data::Entropy::RawSource::Local> if
354 possible, or the default entropy source otherwise. A warning is
355 printed if the default entropy source is used, to supress it set this
356 argument to the default entropy source.
358 =item post_connect_cb
360 Callback (coderef) that is called just after connecting to the
361 database. Used by the testsuite to create the users table.
365 SQL statement that selects a user by username. Defaults to
366 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
370 SQL statement that updates a user's password. Defaults to
371 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
375 SQL statement that inserts a user. Defaults to
376 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
380 HMAC key used for password reset tokens. If not provided it is
381 generated randomly, in which case reset tokens do not persist across
382 application restarts.
386 From: header of password reset emails. If not provided, password reset
391 The subject of password reset emails. Defaults to
392 C<'Password reset token'>.
396 Authentication realm. Defaults to C<'restricted area'>.
400 If true, all authentication results are cached. If false, only
401 successful logins are cached. Defaults to false.
405 Authentication cache timeout, in seconds. Authentication results are
406 cached for this number of seconds to avoid expensive hashing. Defaults
411 Password reset token validity, in seconds. Defaults to 1 hour.
415 Regular expression that matches valid usernames. Defaults to
418 =item invalid_username
420 Error message returned when the username does not match
421 username_regex. Defaults to C<'Invalid username'>
425 URL for registering. Defaults to C<'/action/register'>.
429 URL for changing your password. Defaults to C<'/action/passwd'>.
431 =item request_reset_url
433 URL for requesting a password reset token by email. Defaults to
434 C<'/action/request-reset'>.
438 URL for resetting your password with a reset token. Defaults to
447 =item B<default_opts>
449 Returns a list of default options for the constructor.
451 =item B<new>(I<\%opts>)
453 Creates a new AuthComplex object.
457 Called when the first request is received. The default implementation
458 connects to the database, calls C<post_connect_cb> and prepares the
461 =item B<create_user>(I<$parms>)
463 Inserts a new user into the database. I<$parms> is a
464 L<Hash::MultiValue> object containing the request parameters.
466 =item B<get_user>(I<$username>)
468 Returns a hashref with (at least) the following keys: passphrase (the
469 RFC2307-formatted passphrase of the user), email (the user's email
472 =item B<check_passphrase>(I<$username>, I<$passphrase>)
474 Returns true if the given plaintext passphrase matches the one
475 obtained from database. Default implementation uses L<Authen::Passphrase>.
477 =item B<hash_passphrase>(I<$passphrase>)
479 Returns a RFC2307-formatted hash of the passphrase. Default
480 implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
481 of 10 and a random salt.
483 =item B<set_passphrase>(I<$username>, I<$passphrase>)
485 Changes a user's passphrase to the given value.
487 =item B<make_reset_hmac>(I<$username>, [I<@data>])
489 Returns the HMAC part of the reset token.
491 =item B<mail_body>(I<$username>, I<$token>)
493 Returns the body of the password reset email for the given username
494 and password reset token.
496 =item B<send_reset_email>(I<$username>)
498 Generates a new reset token and sends it to the user via email.
500 =item B<response>(I<$code>, I<$body>)
502 Helper method. Returns a PSGI response with the given response code
505 =item B<reply>(I<$message>)
507 Shorthand for C<response(200, $message)>.
509 =item B<bad_request>(I<$message>)
511 Shorthand for C<response(400, $message)>.
513 =item B<internal_server_error>(I<$message>)
515 Shorthand for C<response(500, $message)>.
517 =item B<unauthorized>
519 Returns a 401 Authorization required response.
521 =item B<call_register>(I<$req>)
523 Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
525 =item B<call_passwd>(I<$req>)
527 Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
529 =item B<call_request_reset>(I<$req>)
531 Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
533 =item B<call_reset>(I<$req>)
535 Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
541 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
543 =head1 COPYRIGHT AND LICENSE
545 Copyright (C) 2015-2017 by Marius Gavrilescu
547 This library is free software; you can redistribute it and/or modify
548 it under the same terms as Perl itself, either Perl version 5.20.1 or,
549 at your option, any later version of Perl 5 you may have available.
This page took 0.084963 seconds and 3 git commands to generate.