0f6759ddb24c1d5eb2e05d97e1b3c06d31a017d5
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/;
18 use Email
::Sender
::Simple qw
/sendmail/;
19 use MIME
::Base64 qw
/decode_base64/;
23 dbi_connect
=> ['dbi:Pg:', '', ''],
24 select_user
=> 'SELECT passphrase, email FROM users WHERE id = ?',
25 update_pass
=> 'UPDATE users SET passphrase = ? WHERE id = ?',
26 insert_user
=> 'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)',
27 mail_subject
=> 'Password reset token',
28 realm
=> 'restricted area',
29 token_max_age
=> 60 * 60 * 24,
30 username_regex
=> qr/^\w{2,20}$/a,
31 register_url
=> '/register',
32 passwd_url
=> '/passwd',
33 request_reset_url
=> '/request-reset',
38 my ($class, $opts) = @_;
39 my %self = $class->default_opts;
40 %self = (%self, %$opts);
41 my $self = bless \
%self, $class;
48 $self->{dbh
} = DBI
->connect(@
{$self->{dbi_connect
}}) or die $DBI::errstr
;
49 $self->{post_connect_cb
}->($self) if $self->{post_connect_cb
};
50 $self->{insert_sth
} = $self->{dbh
}->prepare($self->{insert_user
}) or die $self->{dbh
}->errstr;
51 $self->{select_sth
} = $self->{dbh
}->prepare($self->{select_user
}) or die $self->{dbh
}->errstr;
52 $self->{update_sth
} = $self->{dbh
}->prepare($self->{update_pass
}) or die $self->{dbh
}->errstr;
56 my ($self, $user) = @_;
57 $self->{select_sth
}->execute($user) or die $self->{sth
}->errstr;
58 $self->{select_sth
}->fetchrow_hashref
61 sub check_passphrase
{
62 my ($self, $username, $passphrase) = @_;
63 my $user = $self->get_user($username);
64 return 0 unless $user;
65 Authen
::Passphrase
->from_rfc2307($user->{passphrase
})->match($passphrase)
69 my ($self, $passphrase) = @_;
70 Authen
::Passphrase
::BlowfishCrypt
->new(
72 passphrase
=> $passphrase,
78 my ($self, $username, $passphrase) = @_;
79 $self->{update_sth
}->execute($self->hash_passphrase($passphrase), $username)
83 my ($self, $username, @data) = @_;
84 $self->{hmackey
} //= random_bytes
512;
85 my $user = $self->get_user($username);
86 my $message = join ' ', $username, $user->{passphrase
}, @data;
87 hmac_sha1_base64
$message, $self->{hmackey
};
91 my ($self, $username, $token) = @_;
92 my $hours = $self->{token_max_age
} / 60 / 60;
93 $hours .= $hours == 1 ?
' hour' : ' hours';
95 Someone has requested a password reset for your account.
97 To reset your password, please submit the reset password form on the
98 website using the following information:
101 Password: <your new password>
104 The token is valid for $hours.
108 sub send_reset_email
{
109 my ($self, $username) = @_;
110 my $expire = time + $self->{token_max_age
};
111 my $token = $self->make_reset_hmac($username, $expire) . ":$expire";
112 my $user = $self->get_user($username);
113 sendmail
(Email
::Simple
->create(
115 From
=> $self->{mail_from
},
116 To
=> $user->{email
},
117 Subject
=> $user->{mail_subject
},
119 body
=> $self->mail_body($username, $token),
123 ##################################################
126 my ($self, $code, $body) = @_;
129 ['Content-Type' => 'text/plain',
130 'Content-Length' => length $body],
135 sub reply
{ shift->response(200, $_[0]) }
136 sub bad_request
{ shift->response(400, $_[0]) }
137 sub internal_server_error
{ shift->response(500, $_[0]) }
141 my $body = 'Authorization required';
144 ['Content-Type' => 'text/plain',
145 'Content-Length' => length $body,
146 'WWW-Authenticate' => 'Basic realm="' . $self->{realm
} . '"' ],
151 ##################################################
154 my ($self, $req) = @_;
156 for (qw
/username password confirm_password email/) {
157 $parms{$_} = $req->param($_);
158 return $self->bad_request("Missing parameter $_") unless $parms{$_};
161 return $self->bad_request('Username must match ' . $self->{username_regex
}) unless $parms{username
} =~ /$self->{username_regex}/;
162 return $self->bad_request('Username already in use') if $self->get_user($parms{username
});
163 return $self->bad_request('The two passwords do not match') unless $parms{password
} eq $parms{confirm_password
};
164 $self->{insert_sth
}->execute($parms{username
}, $self->hash_passphrase($parms{password
}), $parms{email
});
165 return $self->reply('Registered successfully')
169 my ($self, $req) = @_;
170 return $self->unauthorized unless $req->user;
172 for (qw
/password new_password confirm_new_password/) {
173 $parms{$_} = $req->param($_);
174 return $self->bad_request("Missing parameter $_") unless $parms{$_};
177 return $self->bad_request('Incorrect password') unless $self->check_passphrase($req->user, $parms{password
});
178 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
179 $self->set_passphrase($req->user, $parms{new_password
});
180 return $self->reply('Password changed successfully');
183 sub call_request_reset
{
184 my ($self, $req) = @_;
185 return $self->internal_server_error('Password resets are disabled') unless $self->{mail_from
};
186 my $username = $req->param('username');
187 my $user = $self->get_user($username) or return $self->bad_request('No such user');
190 $self->send_reset_email($username);
193 return $self->reply('Email sent') if $ok;
194 return $self->internal_server_error($@
);
198 my ($self, $req) = @_;
200 for (qw
/username new_password confirm_new_password token/) {
201 $parms{$_} = $req->param($_);
202 return $self->bad_request("Missing parameter $_") unless $parms{$_};
205 my $user = $self->get_user($parms{username
}) or return $self->bad_request('No such user');
206 return $self->bad_request('The two passwords do not match') unless $parms{new_password
} eq $parms{confirm_new_password
};
207 my ($token, $exp) = split ':', $parms{token
};
208 my $goodtoken = $self->make_reset_hmac($parms{username
}, $exp);
209 return $self->bad_request('Bad reset token') unless $token eq $goodtoken;
210 return $self->bad_request('Reset token has expired') if time >= $exp;
211 $self->set_passphrase($parms{username
}, $parms{new_password
});
212 return $self->reply('Password reset successfully');
216 my ($self, $env) = @_;
217 my $auth = $env->{HTTP_AUTHORIZATION
};
218 if ($auth && $auth =~ /^Basic (.*)$/i) {
219 my ($user, $pass) = split /:/, decode_base64
($1), 2;
220 $env->{REMOTE_USER
} = $user if $self->check_passphrase($user, $pass);
223 my $req = Plack
::Request
->new($env);
225 if ($req->method eq 'POST') {
226 return $self->call_register($req) if $req->path eq $self->{register_url
};
227 return $self->call_passwd($req) if $req->path eq $self->{passwd_url
};
228 return $self->call_request_reset($req) if $req->path eq $self->{request_reset_url
};
229 return $self->call_reset($req) if $req->path eq $self->{reset_url
};
232 $env->{authcomplex
} = $self;
241 Plack::Middleware::Auth::Complex - Feature-rich authentication system
248 enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
251 [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
257 AuthComplex is an authentication system for Plack applications that
258 allows user registration, password changing and password reset.
260 AuthComplex sets REMOTE_USER if the request includes correct basic
261 authentication and intercepts POST requests to some configurable URLs.
262 It also sets C<$env->{authcomplex}> to itself before passing the
265 Some options can be controlled by passing a hashref to the
266 constructor. More customization can be achieved by subclassing this
269 =head2 Intercepted URLs
271 Only POST requests are intercepted. Parameters can be either query
272 parameters or body parameters. Using query parameters is not
273 recommended. These endpoints return 200 for success, 400 for client
274 error and 500 for server errors. All parameters are mandatory.
278 =item B<POST> /register?username=user&password=pw&confirm_password=pw&email=user@example.org
280 This URL creates a new user with the given username, password and
281 email. The two passwords must match, the user must match
282 C<username_regex> and the user must not already exist.
284 =item B<POST> /passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
286 This URL changes the password of a user. The user must be
287 authenticated (otherwise the endpoint will return 401).
289 =item B<POST> /request-reset?username=user
291 This URL requests a password reset token for the given user. The token
292 will be sent to the user's email address.
294 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
296 =item B<POST> /reset?username=user&new_password=pw&confirm_new_password=pw&token=token
298 This URL performs a password reset.
302 =head2 Constructor arguments
308 Arrayref of arguments to pass to DBI->connect. Defaults to
309 C<['dbi:Pg', '', '']>.
311 =item post_connect_cb
313 Callback (coderef) that is called just after connecting to the
314 database. Used by the testsuite to create the users table.
318 SQL statement that selects a user by username. Defaults to
319 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
323 SQL statement that updates a user's password. Defaults to
324 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
328 SQL statement that inserts a user. Defaults to
329 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
333 HMAC key used for password reset tokens. If not provided it is
334 generated randomly, in which case reset tokens do not persist across
335 application restarts.
339 From: header of password reset emails. If not provided, password reset
344 The subject of password reset emails. Defaults to
345 C<'Password reset token'>.
349 Authentication realm. Defaults to C<'restricted area'>.
353 Password reset token validity, in seconds. Defaults to 24 hours.
357 Regular expression that matches valid usernames. Defaults to
362 URL for registering. Defaults to C<'/register'>.
366 URL for changing your password. Defaults to C<'/passwd'>.
368 =item request_reset_url
370 URL for requesting a password reset token by email. Defaults to
375 URL for resetting your password with a reset token. Defaults to
384 =item B<default_opts>
386 Returns a list of default options for the constructor.
388 =item B<new>(I<\%opts>)
390 Creates a new AuthComplex object.
394 Called at the end of the constructor. The default implementation
395 connects to the database, calls C<post_connect_cb> and prepares the
398 =item B<get_user>(I<$username>)
400 Returns a hashref with (at least) the following keys: passphrase (the
401 RFC2307-formatted passphrase of the user), email (the user's email
404 =item B<check_passphrase>(I<$username>, I<$passphrase>)
406 Returns true if the given plaintext passphrase matches the one
407 obtained from database. Default implementation uses L<Authen::Passphrase>.
409 =item B<hash_passphrase>(I<$passphrase>)
411 Returns a RFC2307-formatted hash of the passphrase. Default
412 implementation uses L<Authen::Passphrase::BlowfishCrypt> with a cost
413 of 10 and a random salt.
415 =item B<set_passphrase>(I<$username>, I<$passphrase>)
417 Changes a user's passphrase to the given value.
419 =item B<make_reset_hmac>(I<$username>, [I<@data>])
421 Returns the HMAC part of the reset token.
423 =item B<mail_body>(I<$username>, I<$token>)
425 Returns the body of the password reset email for the given username
426 and password reset token.
428 =item B<send_reset_email>(I<$username>)
430 Generates a new reset token and sends it to the user via email.
432 =item B<response>(I<$code>, I<$body>)
434 Helper method. Returns a PSGI response with the given response code
437 =item B<reply>(I<$message>)
439 Shorthand for C<response(200, $message)>.
441 =item B<bad_request>(I<$message>)
443 Shorthand for C<response(400, $message)>.
445 =item B<internal_server_error>(I<$message>)
447 Shorthand for C<response(500, $message)>.
449 =item B<unauthorized>
451 Returns a 401 Authorization required response.
453 =item B<call_register>(I<$req>)
455 Handles the C</register> endpoint. I<$req> is a Plack::Request object.
457 =item B<call_passwd>(I<$req>)
459 Handles the C</passwd> endpoint. I<$req> is a Plack::Request object.
461 =item B<call_request_reset>(I<$req>)
463 Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object.
465 =item B<call_reset>(I<$req>)
467 Handles the C</reset> endpoint. I<$req> is a Plack::Request object.
473 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
475 =head1 COPYRIGHT AND LICENSE
477 Copyright (C) 2015 by Marius Gavrilescu
479 This library is free software; you can redistribute it and/or modify
480 it under the same terms as Perl itself, either Perl version 5.20.1 or,
481 at your option, any later version of Perl 5 you may have available.
This page took 0.047554 seconds and 3 git commands to generate.