lib/Plack/Middleware/Auth/Complex.pm

   1 package Plack::Middleware::Auth::Complex;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.000_001';
   8 $VERSION = eval $VERSION;  # see L<perlmodstyle>
   9
  10 use parent qw/Plack::Middleware/;
  11
  12 use Authen::Passphrase;
  13 use Authen::Passphrase::BlowfishCrypt;
  14 use Bytes::Random::Secure qw/random_bytes/;
  15 use DBI;
  16 use Digest::SHA qw/hmac_sha1_base64 sha256/;
  17 use Email::Simple;
  18 use Email::Sender::Simple qw/sendmail/;
  19 use MIME::Base64 qw/decode_base64/;
  20 use Plack::Request;
  21 use Tie::Hash::Expire;
  22
  23 sub default_opts {(
  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',
  30         cache_fail        => 0,
  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'
  38 )}
  39
  40 sub new {
  41         my ($class, $opts) = @_;
  42         my %self = $class->default_opts;
  43         %self = (%self, %$opts);
  44         my $self = bless \%self, $class;
  45         $self->init;
  46         $self
  47 }
  48
  49 sub init {
  50         my ($self) = @_;
  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;
  56 }
  57
  58 sub get_user {
  59         my ($self, $user) = @_;
  60         $self->{select_sth}->execute($user) or die $self->{sth}->errstr;
  61         $self->{select_sth}->fetchrow_hashref
  62 }
  63
  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;
  69         }
  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};
  76         $ret
  77 }
  78
  79 sub hash_passphrase {
  80         my ($self, $passphrase) = @_;
  81         Authen::Passphrase::BlowfishCrypt->new(
  82                 cost => 10,
  83                 passphrase => $passphrase,
  84                 salt_random => 1,
  85         )->as_rfc2307
  86 }
  87
  88 sub set_passphrase {
  89         my ($self, $username, $passphrase) = @_;
  90         $self->{update_sth}->execute($self->hash_passphrase($passphrase), $username)
  91 }
  92
  93 sub make_reset_hmac {
  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};
  99 }
 100
 101 sub mail_body {
 102         my ($self, $username, $token) = @_;
 103         my $hours = $self->{token_max_age} / 60 / 60;
 104         $hours .= $hours == 1 ? ' hour' : ' hours';
 105         <<EOF;
 106 Someone has requested a password reset for your account.
 107
 108 To reset your password, please submit the reset password form on the
 109 website using the following information:
 110
 111 Username: $username
 112 Password: <your new password>
 113 Reset token: $token
 114
 115 The token is valid for $hours.
 116 EOF
 117 }
 118
 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(
 125                 header => [
 126                         From    => $self->{mail_from},
 127                         To      => $user->{email},
 128                         Subject => $user->{mail_subject},
 129                 ],
 130                 body => $self->mail_body($username, $token),
 131         ));
 132 }
 133
 134 ##################################################
 135
 136 sub response {
 137         my ($self, $code, $body) = @_;
 138         return [
 139                 $code,
 140                 ['Content-Type' => 'text/plain',
 141                  'Content-Length' => length $body],
 142                 [ $body ],
 143         ];
 144 }
 145
 146 sub reply                 { shift->response(200, $_[0]) }
 147 sub bad_request           { shift->response(400, $_[0]) }
 148 sub internal_server_error { shift->response(500, $_[0]) }
 149
 150 sub unauthorized {
 151         my ($self) = @_;
 152         my $body = 'Authorization required';
 153         return [
 154                 401,
 155                 ['Content-Type' => 'text/plain',
 156                  'Content-Length' => length $body,
 157                  'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
 158                 [ $body ],
 159         ];
 160 }
 161
 162 ##################################################
 163
 164 sub call_register {
 165         my ($self, $req) = @_;
 166         my %parms;
 167         for (qw/username password confirm_password email/) {
 168                 $parms{$_} = $req->param($_);
 169                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 170         }
 171
 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')
 177 }
 178
 179 sub call_passwd {
 180         my ($self, $req) = @_;
 181         return $self->unauthorized unless $req->user;
 182         my %parms;
 183         for (qw/password new_password confirm_new_password/) {
 184                 $parms{$_} = $req->param($_);
 185                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 186         }
 187
 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');
 192 }
 193
 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');
 199         my $ok = 0;
 200         eval {
 201                 $self->send_reset_email($username);
 202                 $ok = 1;
 203         };
 204         return $self->reply('Email sent') if $ok;
 205         return $self->internal_server_error($@);
 206 }
 207
 208 sub call_reset {
 209         my ($self, $req) = @_;
 210         my %parms;
 211         for (qw/username new_password confirm_new_password token/) {
 212                 $parms{$_} = $req->param($_);
 213                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 214         }
 215
 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');
 224 }
 225
 226 sub call {
 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);
 232         }
 233
 234         my $req = Plack::Request->new($env);
 235
 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};
 241         }
 242
 243         $env->{authcomplex} = $self;
 244         $self->app->($env);
 245 }
 246
 247 1;
 248 __END__
 249
 250 =head1 NAME
 251
 252 Plack::Middleware::Auth::Complex - Feature-rich authentication system
 253
 254 =head1 SYNOPSIS
 255
 256   use Plack::Builder;
 257
 258   builder {
 259     enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
 260     sub {
 261       my ($env) = @_;
 262       [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
 263     }
 264   }
 265
 266 =head1 DESCRIPTION
 267
 268 AuthComplex is an authentication system for Plack applications that
 269 allows user registration, password changing and password reset.
 270
 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
 274 request.
 275
 276 Some options can be controlled by passing a hashref to the
 277 constructor. More customization can be achieved by subclassing this
 278 module.
 279
 280 =head2 Intercepted URLs
 281
 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.
 286
 287 =over
 288
 289 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
 290
 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.
 294
 295 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
 296
 297 This URL changes the password of a user. The user must be
 298 authenticated (otherwise the endpoint will return 401).
 299
 300 =item B<POST> /action/request-reset?username=user
 301
 302 This URL requests a password reset token for the given user. The token
 303 will be sent to the user's email address.
 304
 305 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
 306
 307 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
 308
 309 This URL performs a password reset.
 310
 311 =back
 312
 313 =head2 Constructor arguments
 314
 315 =over
 316
 317 =item dbi_connect
 318
 319 Arrayref of arguments to pass to DBI->connect. Defaults to
 320 C<['dbi:Pg', '', '']>.
 321
 322 =item post_connect_cb
 323
 324 Callback (coderef) that is called just after connecting to the
 325 database. Used by the testsuite to create the users table.
 326
 327 =item select_user
 328
 329 SQL statement that selects a user by username. Defaults to
 330 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
 331
 332 =item update_pass
 333
 334 SQL statement that updates a user's password. Defaults to
 335 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
 336
 337 =item insert_user
 338
 339 SQL statement that inserts a user. Defaults to
 340 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
 341
 342 =item hmackey
 343
 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.
 347
 348 =item mail_from
 349
 350 From: header of password reset emails. If not provided, password reset
 351 is disabled.
 352
 353 =item mail_subject
 354
 355 The subject of password reset emails. Defaults to
 356 C<'Password reset token'>.
 357
 358 =item realm
 359
 360 Authentication realm. Defaults to C<'restricted area'>.
 361
 362 =item cache_fail
 363
 364 If true, all authentication results are cached. If false, only
 365 successful logins are cached. Defaults to false.
 366
 367 =item cache_max_age
 368
 369 Authentication cache timeout, in seconds. Authentication results are
 370 cached for this number of seconds to avoid expensive hashing. Defaults
 371 to 5 minutes.
 372
 373 =item token_max_age
 374
 375 Password reset token validity, in seconds. Defaults to 24 hours.
 376
 377 =item username_regex
 378
 379 Regular expression that matches valid usernames. Defaults to
 380 C<qr/^\w{2,20}$/a>.
 381
 382 =item register_url
 383
 384 URL for registering. Defaults to C<'/action/register'>.
 385
 386 =item passwd_url
 387
 388 URL for changing your password. Defaults to C<'/action/passwd'>.
 389
 390 =item request_reset_url
 391
 392 URL for requesting a password reset token by email. Defaults to
 393 C<'/action/request-reset'>.
 394
 395 =item reset_url
 396
 397 URL for resetting your password with a reset token. Defaults to
 398 C<'/action/reset'>.
 399
 400 =back
 401
 402 =head2 Methods
 403
 404 =over
 405
 406 =item B<default_opts>
 407
 408 Returns a list of default options for the constructor.
 409
 410 =item B<new>(I<\%opts>)
 411
 412 Creates a new AuthComplex object.
 413
 414 =item B<init>
 415
 416 Called at the end of the constructor. The default implementation
 417 connects to the database, calls C<post_connect_cb> and prepares the
 418 SQL statements.
 419
 420 =item B<get_user>(I<$username>)
 421
 422 Returns a hashref with (at least) the following keys: passphrase (the
 423 RFC2307-formatted passphrase of the user), email (the user's email
 424 address).
 425
 426 =item B<check_passphrase>(I<$username>, I<$passphrase>)
 427
 428 Returns true if the given plaintext passphrase matches the one
 429 obtained from database. Default implementation uses L<Authen::Passphrase>.
 430
 431 =item B<hash_passphrase>(I<$passphrase>)
 432
 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.
 436
 437 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 438
 439 Changes a user's passphrase to the given value.
 440
 441 =item B<make_reset_hmac>(I<$username>, [I<@data>])
 442
 443 Returns the HMAC part of the reset token.
 444
 445 =item B<mail_body>(I<$username>, I<$token>)
 446
 447 Returns the body of the password reset email for the given username
 448 and password reset token.
 449
 450 =item B<send_reset_email>(I<$username>)
 451
 452 Generates a new reset token and sends it to the user via email.
 453
 454 =item B<response>(I<$code>, I<$body>)
 455
 456 Helper method. Returns a PSGI response with the given response code
 457 and string body.
 458
 459 =item B<reply>(I<$message>)
 460
 461 Shorthand for C<response(200, $message)>.
 462
 463 =item B<bad_request>(I<$message>)
 464
 465 Shorthand for C<response(400, $message)>.
 466
 467 =item B<internal_server_error>(I<$message>)
 468
 469 Shorthand for C<response(500, $message)>.
 470
 471 =item B<unauthorized>
 472
 473 Returns a 401 Authorization required response.
 474
 475 =item B<call_register>(I<$req>)
 476
 477 Handles the C</register> endpoint. I<$req> is a Plack::Request object.
 478
 479 =item B<call_passwd>(I<$req>)
 480
 481 Handles the C</passwd> endpoint. I<$req> is a Plack::Request object.
 482
 483 =item B<call_request_reset>(I<$req>)
 484
 485 Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object.
 486
 487 =item B<call_reset>(I<$req>)
 488
 489 Handles the C</reset> endpoint. I<$req> is a Plack::Request object.
 490
 491 =back
 492
 493 =head1 AUTHOR
 494
 495 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 496
 497 =head1 COPYRIGHT AND LICENSE
 498
 499 Copyright (C) 2015 by Marius Gavrilescu
 500
 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.
 504
 505
 506 =cut