1 package Plack
::Middleware
::Auth
::Complex
;
7 our $VERSION = '0.000_001';
8 $VERSION = eval $VERSION; # see L<perlmodstyle>
10 use parent qw
/Plack::Middleware/;
12 use Authen
::Passphrase
;
13 use Authen
::Passphrase
::BlowfishCrypt
;
14 use Bytes
::Random
::Secure qw
/random_bytes/;
16 use Digest
::SHA qw
/hmac_sha1_base64 sha256/;
18 use Email
::Sender
::Simple qw
/sendmail/;
19 use MIME
::Base64 qw
/decode_base64/;
21 use Tie
::Hash
::Expire
;
24 dbi_connect
=> ['dbi:Pg:', '', ''],
25 select_user
=> 'SELECT passphrase, email FROM users WHERE id = ?',
26 update_pass
=> 'UPDATE users SET passphrase = ? WHERE id = ?',
27 insert_user
=> 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
28 mail_subject
=> 'Password reset token',
29 realm
=> 'restricted area',
31 cache_max_age
=> 5 * 60,
32 token_max_age
=> 60 * 60 * 24,
33 username_regex
=> qr/^\w{2,20}$/a,
34 register_url
=> '/action/register',
35 passwd_url
=> '/action/passwd',
36 request_reset_url
=> '/action/request-reset',
37 reset_url
=> '/action/reset'
41 my ($class, $opts) = @_;
42 my %self = $class->default_opts;
43 %self = (%self, %$opts);
44 my $self = bless \
%self, $class;
51 $self->{dbh
} = DBI
->connect(@
{$self->{dbi_connect
}}) or die $DBI::errstr
;
52 $self->{post_connect_cb
}->($self) if $self->{post_connect_cb
};
53 $self->{insert_sth
} = $self->{dbh
}->prepare($self->{insert_user
}) or die $self->{dbh
}->errstr;
54 $self->{select_sth
} = $self->{dbh
}->prepare($self->{select_user
}) or die $self->{dbh
}->errstr;
55 $self->{update_sth
} = $self->{dbh
}->prepare($self->{update_pass
}) or die $self->{dbh
}->errstr;
59 my ($self, $user) = @_;
60 $self->{select_sth
}->execute($user) or die $self->{sth
}->errstr;
61 $self->{select_sth
}->fetchrow_hashref
64 sub check_passphrase
{
65 my ($self, $username, $passphrase) = @_;
66 unless ($self->{cache
}) {
67 tie
my %cache, 'Tie::Hash::Expire', {expire_seconds
=> $self->{cache_max_age
}};
68 $self->{cache
} = \
%cache;
70 my $cachekey = sha256
"$username:$passphrase";
71 return $self->{cache
}{$cachekey} if exists $self->{cache
}{$cachekey};
72 my $user = $self->get_user($username);
73 return 0 unless $user;
74 my $ret = Authen
::Passphrase
->from_rfc2307($user->{passphrase
})->match($passphrase);
75 $self->{cache
}{$cachekey} = $ret if $ret || $self->{cache_fail
};
80 my ($self, $passphrase) = @_;
81 Authen
::Passphrase
::BlowfishCrypt
->new(
83 passphrase
=> $passphrase,
89 my ($self, $username, $passphrase) = @_;
90 $self->{update_sth
}->execute($self->hash_passphrase($passphrase), $username)
94 my ($self, $username, @data) = @_;
95 $self->{hmackey
} //= random_bytes
512;
96 my $user = $self->get_user($username);
97 my $message = join ' ', $username, $user->{passphrase
}, @data;
98 hmac_sha1_base64
$message, $self->{hmackey
};
102 my ($self, $username, $token) = @_;
103 my $hours = $self->{token_max_age
} / 60 / 60;
104 $hours .= $hours == 1 ?
' hour' : ' hours';
106 Someone has requested a password reset for your account.
108 To reset your password, please submit the reset password form on the
109 website using the following information:
112 Password: <your new password>
115 The token is valid for $hours.
119 sub send_reset_email
{
120 my ($self, $username) = @_;
121 my $expire = time + $self->{token_max_age
};
122 my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
123 my $user = $self->get_user($username);
124 sendmail
(Email
::Simple
->create(
126 From
=> $self->{mail_from
},
127 To
=> $user->{email
},
128 Subject
=> $user->{mail_subject
},
130 body
=> $self->mail_body($username, $token),
134 ##################################################
137 my ($self, $code, $body) = @_;
140 ['Content-Type' => 'text/plain',
141 'Content-Length' => length $body],
146 sub reply
{ shift->response(200, $_[0]) }
147 sub bad_request
{ shift->response(400, $_[0]) }
148 sub internal_server_error
{ shift->response(500, $_[0]) }
152 my $body = 'Authorization required';
155 ['Content-Type' => 'text/plain',
156 'Content-Length' => length $body,
157 'WWW-Authenticate' => 'Basic realm="' . $self->{realm
} . '"' ],
162 ##################################################
165 my ($self, $req) = @_;
167 for (qw
/username password confirm_password email/) {
168 $parms{$_} = $req->param($_);
169 return $self->bad_request("Missing parameter $_") unless $parms{$_};
172 return $self->bad_request('Username must match ' . $self->{username_regex
}) unless $parms{username
} =~ /$self->{username_regex}/;
173 return $self->bad_request('Username already in use') if $self->get_user($parms{username
});
174 return $self->bad_request('The two passwords do not match') unless $parms{password
} eq $parms{confirm_password
};
175 $self->{insert_sth
}->execute($parms{username
}, $self->hash_passphrase($parms{password
}), $parms{email
});
176 return $self->reply('Registered successfully')
180 my ($self, $req) = @_;
181 return $self->unauthorized unless $req->user;
183 for (qw
/password new_password confirm_new_password/) {
184 $parms{$_} = $req->param($_);
185 return $self->bad_request("Missing parameter $_") unless $parms{$_};
188 return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password
});
189 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
190 $self->set_passphrase($req->user, $parms{new_password
});
191 return $self->reply('Password changed successfully');
194 sub call_request_reset
{
195 my ($self, $req) = @_;
196 return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from
};
197 my $username = $req->param('username');
198 my $user = $self->get_user($username) or return $self->bad_request('No such user');
201 $self->send_reset_email($username);
204 return $self->reply('Email sent') if $ok;
205 return $self->internal_server_error($@
);
209 my ($self, $req) = @_;
211 for (qw
/username new_password confirm_new_password token/) {
212 $parms{$_} = $req->param($_);
213 return $self->bad_request("Missing parameter $_") unless $parms{$_};
216 my $user = $self->get_user($parms{username
}) or return $self->bad_request('No such user');
217 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
218 my ($token, $exp) = split ':', $parms{token
};
219 my $goodtoken = $self->make_reset_hmac($parms{username
}, $exp);
220 return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
221 return $self->bad_request('Reset token has expired') if time >= $exp;
222 $self->set_passphrase($parms{username
}, $parms{new_password
});
223 return $self->reply('Password reset successfully');
227 my ($self, $env) = @_;
228 my $auth = $env->{HTTP_AUTHORIZATION
};
229 if ($auth && $auth =~ /^Basic (.*)$/i) {
230 my ($user, $pass) = split /:/, decode_base64
($1), 2;
231 $env->{REMOTE_USER
} = $user if $self->check_passphrase($user, $pass);
234 my $req = Plack
::Request
->new($env);
236 if ($req->method eq 'POST') {
237 return $self->call_register($req) if $req->path eq $self->{register_url
};
238 return $self->call_passwd($req) if $req->path eq $self->{passwd_url
};
239 return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url
};
240 return $self->call_reset($req) if $req->path eq $self->{reset_url
};
243 $env->{authcomplex
} = $self;
252 Plack::Middleware::Auth::Complex - Feature-rich authentication system
259 enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
262 [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
268 AuthComplex is an authentication system for Plack applications that
269 allows user registration, password changing and password reset.
271 AuthComplex sets REMOTE_USER if the request includes correct basic
272 authentication and intercepts POST requests to some configurable URLs.
273 It also sets C<$env->{authcomplex}> to itself before passing the
276 Some options can be controlled by passing a hashref to the
277 constructor. More customization can be achieved by subclassing this
280 =head2 Intercepted URLs
282 Only POST requests are intercepted. Parameters can be either query
283 parameters or body parameters. Using query parameters is not
284 recommended. These endpoints return 200 for success, 400 for client
285 error and 500 for server errors. All parameters are mandatory.
289 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
291 This URL creates a new user with the given username, password and
292 email. The two passwords must match, the user must match
293 C<username_regex> and the user must not already exist.
295 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
297 This URL changes the password of a user. The user must be
298 authenticated (otherwise the endpoint will return 401).
300 =item B<POST> /action/request-reset?username=user
302 This URL requests a password reset token for the given user. The token
303 will be sent to the user's email address.
305 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
307 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
309 This URL performs a password reset.
313 =head2 Constructor arguments
319 Arrayref of arguments to pass to DBI->connect. Defaults to
320 C<['dbi:Pg', '', '']>.
322 =item post_connect_cb
324 Callback (coderef) that is called just after connecting to the
325 database. Used by the testsuite to create the users table.
329 SQL statement that selects a user by username. Defaults to
330 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
334 SQL statement that updates a user's password. Defaults to
335 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
339 SQL statement that inserts a user. Defaults to
340 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
344 HMAC key used for password reset tokens. If not provided it is
345 generated randomly, in which case reset tokens do not persist across
346 application restarts.
350 From: header of password reset emails. If not provided, password reset
355 The subject of password reset emails. Defaults to
356 C<'Password reset token'>.
360 Authentication realm. Defaults to C<'restricted area'>.
364 If true, all authentication results are cached. If false, only
365 successful logins are cached. Defaults to false.
369 Authentication cache timeout, in seconds. Authentication results are
370 cached for this number of seconds to avoid expensive hashing. Defaults
375 Password reset token validity, in seconds. Defaults to 24 hours.
379 Regular expression that matches valid usernames. Defaults to
384 URL for registering. Defaults to C<'/action/register'>.
388 URL for changing your password. Defaults to C<'/action/passwd'>.
390 =item request_reset_url
392 URL for requesting a password reset token by email. Defaults to
393 C<'/action/request-reset'>.
397 URL for resetting your password with a reset token. Defaults to
406 =item B<default_opts>
408 Returns a list of default options for the constructor.
410 =item B<new>(I<\%opts>)
412 Creates a new AuthComplex object.
416 Called at the end of the constructor. The default implementation
417 connects to the database, calls C<post_connect_cb> and prepares the
420 =item B<get_user>(I<$username>)
422 Returns a hashref with (at least) the following keys: passphrase (the
423 RFC2307-formatted passphrase of the user), email (the user's email
426 =item B<check_passphrase>(I<$username>, I<$passphrase>)
428 Returns true if the given plaintext passphrase matches the one
429 obtained from database. Default implementation uses L<Authen::Passphrase>.
431 =item B<hash_passphrase>(I<$passphrase>)
433 Returns a RFC2307-formatted hash of the passphrase. Default
434 implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
435 of 10 and a random salt.
437 =item B<set_passphrase>(I<$username>, I<$passphrase>)
439 Changes a user's passphrase to the given value.
441 =item B<make_reset_hmac>(I<$username>, [I<@data>])
443 Returns the HMAC part of the reset token.
445 =item B<mail_body>(I<$username>, I<$token>)
447 Returns the body of the password reset email for the given username
448 and password reset token.
450 =item B<send_reset_email>(I<$username>)
452 Generates a new reset token and sends it to the user via email.
454 =item B<response>(I<$code>, I<$body>)
456 Helper method. Returns a PSGI response with the given response code
459 =item B<reply>(I<$message>)
461 Shorthand for C<response(200, $message)>.
463 =item B<bad_request>(I<$message>)
465 Shorthand for C<response(400, $message)>.
467 =item B<internal_server_error>(I<$message>)
469 Shorthand for C<response(500, $message)>.
471 =item B<unauthorized>
473 Returns a 401 Authorization required response.
475 =item B<call_register>(I<$req>)
477 Handles the C</register> endpoint. I<$req> is a Plack::Request object.
479 =item B<call_passwd>(I<$req>)
481 Handles the C</passwd> endpoint. I<$req> is a Plack::Request object.
483 =item B<call_request_reset>(I<$req>)
485 Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object.
487 =item B<call_reset>(I<$req>)
489 Handles the C</reset> endpoint. I<$req> is a Plack::Request object.
495 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
497 =head1 COPYRIGHT AND LICENSE
499 Copyright (C) 2015 by Marius Gavrilescu
501 This library is free software; you can redistribute it and/or modify
502 it under the same terms as Perl itself, either Perl version 5.20.1 or,
503 at your option, any later version of Perl 5 you may have available.
This page took 0.052 seconds and 5 git commands to generate.