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         my $self = bless \%self, $class;
  62         $self
  63 }
  64
  65 sub init {
  66         my ($self) = @_;
  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;
  72 }
  73
  74 sub create_user {
  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;
  78 }
  79
  80 sub get_user {
  81         my ($self, $user) = @_;
  82         $self->{select_sth}->execute($user) or croak $self->{select_sth}->errstr;
  83         $self->{select_sth}->fetchrow_hashref
  84 }
  85
  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;
  92         }
  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};
  99         $ret
 100 }
 101
 102 sub hash_passphrase {
 103         my ($self, $passphrase) = @_;
 104         Authen::Passphrase::BlowfishCrypt->new(
 105                 cost => 10,
 106                 passphrase => $passphrase,
 107                 salt_random => 1,
 108         )->as_rfc2307
 109 }
 110
 111 sub set_passphrase {
 112         my ($self, $username, $passphrase) = @_;
 113         $self->{update_sth}->execute($self->hash_passphrase($passphrase), $username) or croak $self->{update_sth}->errstr;
 114 }
 115
 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};
 122 }
 123
 124 sub mail_body {
 125         my ($self, $username, $token) = @_;
 126         my $hours = $self->{token_max_age} / 60 / 60;
 127         $hours .= $hours == 1 ? ' hour' : ' hours'; # uncoverable branch false
 128         <<"EOF";
 129 Someone has requested a password reset for your account.
 130
 131 To reset your password, please submit the reset password form on the
 132 website using the following information:
 133
 134 Username: $username
 135 Password: <your new password>
 136 Reset token: $token
 137
 138 The token is valid for $hours.
 139 EOF
 140 }
 141
 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(
 148                 header => [
 149                         From    => $self->{mail_from},
 150                         To      => $user->{email},
 151                         Subject => $self->{mail_subject},
 152                 ],
 153                 body => $self->mail_body($username, $token),
 154         ));
 155 }
 156
 157 ##################################################
 158
 159 sub response {
 160         my ($self, $code, $body) = @_;
 161         return [
 162                 $code,
 163                 ['Content-Type' => 'text/plain',
 164                  'Content-Length' => length $body],
 165                 [ $body ],
 166         ];
 167 }
 168
 169 sub reply                 { shift->response(200, $_[0]) }
 170 sub bad_request           { shift->response(400, $_[0]) }
 171 sub internal_server_error { shift->response(500, $_[0]) }
 172
 173 sub unauthorized {
 174         my ($self) = @_;
 175         my $body = 'Authorization required';
 176         return [
 177                 401,
 178                 ['Content-Type' => 'text/plain',
 179                  'Content-Length' => length $body,
 180                  'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
 181                 [ $body ],
 182         ];
 183 }
 184
 185 ##################################################
 186
 187 sub call_register {
 188         my ($self, $req) = @_;
 189         my %parms;
 190         for (qw/username password confirm_password email/) {
 191                 $parms{$_} = $req->param($_);
 192                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 193         }
 194
 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};
 198
 199         $self->create_user($req->parameters);
 200         return $self->reply('Registered successfully')
 201 }
 202
 203 sub call_passwd {
 204         my ($self, $req) = @_;
 205         return $self->unauthorized unless $req->user;
 206         my %parms;
 207         for (qw/password new_password confirm_new_password/) {
 208                 $parms{$_} = $req->param($_);
 209                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 210         }
 211
 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');
 216 }
 217
 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');
 223         eval {
 224                 $self->send_reset_email($username);
 225                 1
 226         } or return $self->internal_server_error($@);
 227         $self->reply('Email sent');
 228 }
 229
 230 sub call_reset {
 231         my ($self, $req) = @_;
 232         my %parms;
 233         for (qw/username new_password confirm_new_password token/) {
 234                 $parms{$_} = $req->param($_);
 235                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 236         }
 237
 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');
 246 }
 247
 248 sub call {
 249         my ($self, $env) = @_;
 250
 251         unless ($self->{init_done}) {
 252                 $self->init;
 253                 $self->{init_done} = 1;
 254         }
 255
 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);
 260         }
 261
 262         my $req = Plack::Request->new($env);
 263
 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};
 269         }
 270
 271         $env->{authcomplex} = $self;
 272         $self->app->($env);
 273 }
 274
 275 1;
 276 __END__
 277
 278 =head1 NAME
 279
 280 Plack::Middleware::Auth::Complex - Feature-rich authentication system
 281
 282 =head1 SYNOPSIS
 283
 284   use Plack::Builder;
 285
 286   builder {
 287     enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
 288     sub {
 289       my ($env) = @_;
 290       [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
 291     }
 292   }
 293
 294 =head1 DESCRIPTION
 295
 296 AuthComplex is an authentication system for Plack applications that
 297 allows user registration, password changing and password reset.
 298
 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
 302 request.
 303
 304 Some options can be controlled by passing a hashref to the
 305 constructor. More customization can be achieved by subclassing this
 306 module.
 307
 308 =head2 Intercepted URLs
 309
 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.
 314
 315 =over
 316
 317 =item B<POST> /action/register?username=user&password=pw&confirm_password=pw&email=user@example.org
 318
 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.
 322
 323 =item B<POST> /action/passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
 324
 325 This URL changes the password of a user. The user must be
 326 authenticated (otherwise the endpoint will return 401).
 327
 328 =item B<POST> /action/request-reset?username=user
 329
 330 This URL requests a password reset token for the given user. The token
 331 will be sent to the user's email address.
 332
 333 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
 334
 335 =item B<POST> /action/reset?username=user&new_password=pw&confirm_new_password=pw&token=token
 336
 337 This URL performs a password reset.
 338
 339 =back
 340
 341 =head2 Constructor arguments
 342
 343 =over
 344
 345 =item dbi_connect
 346
 347 Arrayref of arguments to pass to DBI->connect. Defaults to
 348 C<['dbi:Pg', '', '']>.
 349
 350 =item entropy_source
 351
 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.
 357
 358 =item post_connect_cb
 359
 360 Callback (coderef) that is called just after connecting to the
 361 database. Used by the testsuite to create the users table.
 362
 363 =item select_user
 364
 365 SQL statement that selects a user by username. Defaults to
 366 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
 367
 368 =item update_pass
 369
 370 SQL statement that updates a user's password. Defaults to
 371 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
 372
 373 =item insert_user
 374
 375 SQL statement that inserts a user. Defaults to
 376 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
 377
 378 =item hmackey
 379
 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.
 383
 384 =item mail_from
 385
 386 From: header of password reset emails. If not provided, password reset
 387 is disabled.
 388
 389 =item mail_subject
 390
 391 The subject of password reset emails. Defaults to
 392 C<'Password reset token'>.
 393
 394 =item realm
 395
 396 Authentication realm. Defaults to C<'restricted area'>.
 397
 398 =item cache_fail
 399
 400 If true, all authentication results are cached. If false, only
 401 successful logins are cached. Defaults to false.
 402
 403 =item cache_max_age
 404
 405 Authentication cache timeout, in seconds. Authentication results are
 406 cached for this number of seconds to avoid expensive hashing. Defaults
 407 to 5 minutes.
 408
 409 =item token_max_age
 410
 411 Password reset token validity, in seconds. Defaults to 1 hour.
 412
 413 =item username_regex
 414
 415 Regular expression that matches valid usernames. Defaults to
 416 C<qr/^\w{2,20}$/as>.
 417
 418 =item invalid_username
 419
 420 Error message returned when the username does not match
 421 username_regex. Defaults to C<'Invalid username'>
 422
 423 =item register_url
 424
 425 URL for registering. Defaults to C<'/action/register'>.
 426
 427 =item passwd_url
 428
 429 URL for changing your password. Defaults to C<'/action/passwd'>.
 430
 431 =item request_reset_url
 432
 433 URL for requesting a password reset token by email. Defaults to
 434 C<'/action/request-reset'>.
 435
 436 =item reset_url
 437
 438 URL for resetting your password with a reset token. Defaults to
 439 C<'/action/reset'>.
 440
 441 =back
 442
 443 =head2 Methods
 444
 445 =over
 446
 447 =item B<default_opts>
 448
 449 Returns a list of default options for the constructor.
 450
 451 =item B<new>(I<\%opts>)
 452
 453 Creates a new AuthComplex object.
 454
 455 =item B<init>
 456
 457 Called when the first request is received. The default implementation
 458 connects to the database, calls C<post_connect_cb> and prepares the
 459 SQL statements.
 460
 461 =item B<create_user>(I<$parms>)
 462
 463 Inserts a new user into the database. I<$parms> is a
 464 L<Hash::MultiValue> object containing the request parameters.
 465
 466 =item B<get_user>(I<$username>)
 467
 468 Returns a hashref with (at least) the following keys: passphrase (the
 469 RFC2307-formatted passphrase of the user), email (the user's email
 470 address).
 471
 472 =item B<check_passphrase>(I<$username>, I<$passphrase>)
 473
 474 Returns true if the given plaintext passphrase matches the one
 475 obtained from database. Default implementation uses L<Authen::Passphrase>.
 476
 477 =item B<hash_passphrase>(I<$passphrase>)
 478
 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.
 482
 483 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 484
 485 Changes a user's passphrase to the given value.
 486
 487 =item B<make_reset_hmac>(I<$username>, [I<@data>])
 488
 489 Returns the HMAC part of the reset token.
 490
 491 =item B<mail_body>(I<$username>, I<$token>)
 492
 493 Returns the body of the password reset email for the given username
 494 and password reset token.
 495
 496 =item B<send_reset_email>(I<$username>)
 497
 498 Generates a new reset token and sends it to the user via email.
 499
 500 =item B<response>(I<$code>, I<$body>)
 501
 502 Helper method. Returns a PSGI response with the given response code
 503 and string body.
 504
 505 =item B<reply>(I<$message>)
 506
 507 Shorthand for C<response(200, $message)>.
 508
 509 =item B<bad_request>(I<$message>)
 510
 511 Shorthand for C<response(400, $message)>.
 512
 513 =item B<internal_server_error>(I<$message>)
 514
 515 Shorthand for C<response(500, $message)>.
 516
 517 =item B<unauthorized>
 518
 519 Returns a 401 Authorization required response.
 520
 521 =item B<call_register>(I<$req>)
 522
 523 Handles the C</action/register> endpoint. I<$req> is a Plack::Request object.
 524
 525 =item B<call_passwd>(I<$req>)
 526
 527 Handles the C</action/passwd> endpoint. I<$req> is a Plack::Request object.
 528
 529 =item B<call_request_reset>(I<$req>)
 530
 531 Handles the C</action/request-reset> endpoint. I<$req> is a Plack::Request object.
 532
 533 =item B<call_reset>(I<$req>)
 534
 535 Handles the C</action/reset> endpoint. I<$req> is a Plack::Request object.
 536
 537 =back
 538
 539 =head1 AUTHOR
 540
 541 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 542
 543 =head1 COPYRIGHT AND LICENSE
 544
 545 Copyright (C) 2015-2017 by Marius Gavrilescu
 546
 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.
 550
 551
 552 =cut