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.002';
   8
   9 use parent qw/Plack::Middleware/;
  10 use re '/s';
  11
  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/;
  18 use DBI;
  19 use Digest::SHA qw/hmac_sha1_base64 sha256/;
  20 use Email::Simple;
  21 use Email::Sender::Simple qw/sendmail/;
  22 use MIME::Base64 qw/decode_base64/;
  23 use Plack::Request;
  24 use Tie::Hash::Expire;
  25
  26 sub make_entropy_source {
  27         if (-e '/dev/urandom') {
  28                 Data::Entropy::Source->new(
  29                         Data::Entropy::RawSource::Local->new('/dev/urandom'),
  30                         'sysread'
  31                 )
  32         } else {
  33                 carp "/dev/urandom not found, using insecure random source\n";
  34                 entropy_source
  35         }
  36 }
  37
  38 sub default_opts {(
  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',
  45         cache_fail        => 0,
  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'
  54 )}
  55
  56 sub new {
  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
  68         }
  69         if ($self{use_scrypt}) {
  70                 eval 'use Authen::Passphrase::Scrypt; 1' or croak "Failed to load Authen::Passphrase::Scrypt: $@\n";
  71         }
  72         my $self = bless \%self, $class;
  73         $self
  74 }
  75
  76 sub init {
  77         my ($self) = @_;
  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;
  83 }
  84
  85 sub create_user {
  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;
  89 }
  90
  91 sub get_user {
  92         my ($self, $user) = @_;
  93         $self->{select_sth}->execute($user) or croak $self->{select_sth}->errstr;
  94         $self->{select_sth}->fetchrow_hashref
  95 }
  96
  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;
 103         }
 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;
 108         my $ret;
 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})
 112         } else {
 113                 $ret = Authen::Passphrase->from_rfc2307($user->{passphrase});
 114         }
 115         $ret = $ret->match($passphrase);
 116         $self->{cache}{$cachekey} = $ret if $ret || $self->{cache_fail};
 117         $ret
 118 }
 119
 120 sub hash_passphrase {
 121         my ($self, $passphrase) = @_;
 122         if ($self->{use_scrypt}) {
 123                 Authen::Passphrase::Scrypt->new({
 124                         passphrase => $passphrase,
 125                 })->as_rfc2307
 126         } else {
 127                 Authen::Passphrase::BlowfishCrypt->new(
 128                         cost => 10,
 129                         passphrase => $passphrase,
 130                         salt_random => 1,
 131                 )->as_rfc2307
 132         }
 133 }
 134
 135 sub set_passphrase {
 136         my ($self, $username, $passphrase) = @_;
 137         $self->{update_sth}->execute($self->hash_passphrase($passphrase), $username) or croak $self->{update_sth}->errstr;
 138 }
 139
 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};
 146 }
 147
 148 sub mail_body {
 149         my ($self, $username, $token) = @_;
 150         my $hours = $self->{token_max_age} / 60 / 60;
 151         $hours .= $hours == 1 ? ' hour' : ' hours'; # uncoverable branch false
 152         <<"EOF";
 153 Someone has requested a password reset for your account.
 154
 155 To reset your password, please submit the reset password form on the
 156 website using the following information:
 157
 158 Username: $username
 159 Password: <your new password>
 160 Reset token: $token
 161
 162 The token is valid for $hours.
 163 EOF
 164 }
 165
 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(
 172                 header => [
 173                         From    => $self->{mail_from},
 174                         To      => $user->{email},
 175                         Subject => $self->{mail_subject},
 176                 ],
 177                 body => $self->mail_body($username, $token),
 178         ));
 179 }
 180
 181 ##################################################
 182
 183 sub response {
 184         my ($self, $code, $body) = @_;
 185         return [
 186                 $code,
 187                 ['Content-Type' => 'text/plain',
 188                  'Content-Length' => length $body],
 189                 [ $body ],
 190         ];
 191 }
 192
 193 sub reply                 { shift->response(200, $_[0]) }
 194 sub bad_request           { shift->response(400, $_[0]) }
 195 sub internal_server_error { shift->response(500, $_[0]) }
 196
 197 sub unauthorized {
 198         my ($self) = @_;
 199         my $body = 'Authorization required';
 200         return [
 201                 401,
 202                 ['Content-Type' => 'text/plain',
 203                  'Content-Length' => length $body,
 204                  'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
 205                 [ $body ],
 206         ];
 207 }
 208
 209 ##################################################
 210
 211 sub call_register {
 212         my ($self, $req) = @_;
 213         my %parms;
 214         for (qw/username password confirm_password email/) {
 215                 $parms{$_} = $req->param($_);
 216                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 217         }
 218
 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};
 222
 223         $self->create_user($req->parameters);
 224         return $self->reply('Registered successfully')
 225 }
 226
 227 sub call_passwd {
 228         my ($self, $req) = @_;
 229         return $self->unauthorized unless $req->user;
 230         my %parms;
 231         for (qw/password new_password confirm_new_password/) {
 232                 $parms{$_} = $req->param($_);
 233                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 234         }
 235
 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');
 240 }
 241
 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');
 247         eval {
 248                 $self->send_reset_email($username);
 249                 1
 250         } or return $self->internal_server_error($@);
 251         $self->reply('Email sent');
 252 }
 253
 254 sub call_reset {
 255         my ($self, $req) = @_;
 256         my %parms;
 257         for (qw/username new_password confirm_new_password token/) {
 258                 $parms{$_} = $req->param($_);
 259                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 260         }
 261
 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');
 270 }
 271
 272 sub call {
 273         my ($self, $env) = @_;
 274
 275         unless ($self->{init_done}) {
 276                 $self->init;
 277                 $self->{init_done} = 1;
 278         }
 279
 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);
 284         }
 285
 286         my $req = Plack::Request->new($env);
 287
 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};
 293         }
 294
 295         $env->{authcomplex} = $self;
 296         $self->app->($env);
 297 }
 298
 299 1;
 300 __END__
 301
 302 =head1 NAME
 303
 304 Plack::Middleware::Auth::Complex - Feature-rich authentication system
 305
 306 =head1 SYNOPSIS
 307
 308   use Plack::Builder;
 309
 310   builder {
 311     enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
 312     sub {
 313       my ($env) = @_;
 314       [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
 315     }
 316   }
 317
 318 =head1 DESCRIPTION
 319
 320 AuthComplex is an authentication system for Plack applications that
 321 allows user registration, password changing and password reset.
 322
 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
 326 request.
 327
 328 Some options can be controlled by passing a hashref to the
 329 constructor. More customization can be achieved by subclassing this
 330 module.
 331
 332 =head2 Intercepted URLs
 333
 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.
 338
 339 =over
 340
 341 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
 342
 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.
 346
 347 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
 348
 349 This URL changes the password of a user. The user must be
 350 authenticated (otherwise the endpoint will return 401).
 351
 352 =item B<POST> /action/request-reset?username=user
 353
 354 This URL requests a password reset token for the given user. The token
 355 will be sent to the user's email address.
 356
 357 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
 358
 359 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
 360
 361 This URL performs a password reset.
 362
 363 =back
 364
 365 =head2 Constructor arguments
 366
 367 =over
 368
 369 =item dbi_connect
 370
 371 Arrayref of arguments to pass to DBI->connect. Defaults to
 372 C<['dbi:Pg', '', '']>.
 373
 374 =item entropy_source
 375
 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.
 381
 382 =item use_scrypt
 383
 384 Boolean determining whether to use the scrypt algorithm via the
 385 C<Authen::Passphrase::Scrypt> module.
 386
 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>).
 390
 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>.
 394
 395 The default value is true if C<Authen::Passphrase::Scrypt> is
 396 installed, false otherwise.
 397
 398 =item post_connect_cb
 399
 400 Callback (coderef) that is called just after connecting to the
 401 database. Used by the testsuite to create the users table.
 402
 403 =item select_user
 404
 405 SQL statement that selects a user by username. Defaults to
 406 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
 407
 408 =item update_pass
 409
 410 SQL statement that updates a user's password. Defaults to
 411 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
 412
 413 =item insert_user
 414
 415 SQL statement that inserts a user. Defaults to
 416 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
 417
 418 =item hmackey
 419
 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.
 423
 424 =item mail_from
 425
 426 From: header of password reset emails. If not provided, password reset
 427 is disabled.
 428
 429 =item mail_subject
 430
 431 The subject of password reset emails. Defaults to
 432 C<'Password reset token'>.
 433
 434 =item realm
 435
 436 Authentication realm. Defaults to C<'restricted area'>.
 437
 438 =item cache_fail
 439
 440 If true, all authentication results are cached. If false, only
 441 successful logins are cached. Defaults to false.
 442
 443 =item cache_max_age
 444
 445 Authentication cache timeout, in seconds. Authentication results are
 446 cached for this number of seconds to avoid expensive hashing. Defaults
 447 to 5 minutes.
 448
 449 =item token_max_age
 450
 451 Password reset token validity, in seconds. Defaults to 1 hour.
 452
 453 =item username_regex
 454
 455 Regular expression that matches valid usernames. Defaults to
 456 C<qr/^\w{2,20}$/as>.
 457
 458 =item invalid_username
 459
 460 Error message returned when the username does not match
 461 username_regex. Defaults to C<'Invalid username'>
 462
 463 =item register_url
 464
 465 URL for registering. Defaults to C<'/action/register'>.
 466
 467 =item passwd_url
 468
 469 URL for changing your password. Defaults to C<'/action/passwd'>.
 470
 471 =item request_reset_url
 472
 473 URL for requesting a password reset token by email. Defaults to
 474 C<'/action/request-reset'>.
 475
 476 =item reset_url
 477
 478 URL for resetting your password with a reset token. Defaults to
 479 C<'/action/reset'>.
 480
 481 =back
 482
 483 =head2 Methods
 484
 485 =over
 486
 487 =item B<default_opts>
 488
 489 Returns a list of default options for the constructor.
 490
 491 =item B<new>(I<\%opts>)
 492
 493 Creates a new AuthComplex object.
 494
 495 =item B<init>
 496
 497 Called when the first request is received. The default implementation
 498 connects to the database, calls C<post_connect_cb> and prepares the
 499 SQL statements.
 500
 501 =item B<create_user>(I<$parms>)
 502
 503 Inserts a new user into the database. I<$parms> is a
 504 L<Hash::MultiValue> object containing the request parameters.
 505
 506 =item B<get_user>(I<$username>)
 507
 508 Returns a hashref with (at least) the following keys: passphrase (the
 509 RFC2307-formatted passphrase of the user), email (the user's email
 510 address).
 511
 512 =item B<check_passphrase>(I<$username>, I<$passphrase>)
 513
 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).
 518
 519 =item B<hash_passphrase>(I<$passphrase>)
 520
 521 Returns a RFC2307-formatted hash of the passphrase.
 522
 523 If C<use_scrypt> is true, default implementation uses
 524 L<Authen::Passphrase::Scrypt> with default parameters.
 525
 526 If C<use_scrypt> is false, default implementation uses
 527 L<Authen::Passphrase::BlowfishCrypt> with a cost of 10 and a random
 528 salt.
 529
 530 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 531
 532 Changes a user's passphrase to the given value.
 533
 534 =item B<make_reset_hmac>(I<$username>, [I<@data>])
 535
 536 Returns the HMAC part of the reset token.
 537
 538 =item B<mail_body>(I<$username>, I<$token>)
 539
 540 Returns the body of the password reset email for the given username
 541 and password reset token.
 542
 543 =item B<send_reset_email>(I<$username>)
 544
 545 Generates a new reset token and sends it to the user via email.
 546
 547 =item B<response>(I<$code>, I<$body>)
 548
 549 Helper method. Returns a PSGI response with the given response code
 550 and string body.
 551
 552 =item B<reply>(I<$message>)
 553
 554 Shorthand for C<response(200, $message)>.
 555
 556 =item B<bad_request>(I<$message>)
 557
 558 Shorthand for C<response(400, $message)>.
 559
 560 =item B<internal_server_error>(I<$message>)
 561
 562 Shorthand for C<response(500, $message)>.
 563
 564 =item B<unauthorized>
 565
 566 Returns a 401 Authorization required response.
 567
 568 =item B<call_register>(I<$req>)
 569
 570 Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
 571
 572 =item B<call_passwd>(I<$req>)
 573
 574 Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
 575
 576 =item B<call_request_reset>(I<$req>)
 577
 578 Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
 579
 580 =item B<call_reset>(I<$req>)
 581
 582 Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
 583
 584 =back
 585
 586 =head1 AUTHOR
 587
 588 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 589
 590 =head1 COPYRIGHT AND LICENSE
 591
 592 Copyright (C) 2015-2017 by Marius Gavrilescu
 593
 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.
 597
 598
 599 =cut