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/;
  17 use Email::Simple;
  18 use Email::Sender::Simple qw/sendmail/;
  19 use MIME::Base64 qw/decode_base64/;
  20 use Plack::Request;
  21
  22 sub default_opts {(
  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',
  34         reset_url         => '/reset'
  35 )}
  36
  37 sub new {
  38         my ($class, $opts) = @_;
  39         my %self = $class->default_opts;
  40         %self = (%self, %$opts);
  41         my $self = bless \%self, $class;
  42         $self->init;
  43         $self
  44 }
  45
  46 sub init {
  47         my ($self) = @_;
  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;
  53 }
  54
  55 sub get_user {
  56         my ($self, $user) = @_;
  57         $self->{select_sth}->execute($user) or die $self->{sth}->errstr;
  58         $self->{select_sth}->fetchrow_hashref
  59 }
  60
  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)
  66 }
  67
  68 sub hash_passphrase {
  69         my ($self, $passphrase) = @_;
  70         Authen::Passphrase::BlowfishCrypt->new(
  71                 cost => 10,
  72                 passphrase => $passphrase,
  73                 salt_random => 1,
  74         )->as_rfc2307
  75 }
  76
  77 sub set_passphrase {
  78         my ($self, $username, $passphrase) = @_;
  79         $self->{update_sth}->execute($self->hash_passphrase($passphrase), $username)
  80 }
  81
  82 sub make_reset_hmac {
  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};
  88 }
  89
  90 sub mail_body {
  91         my ($self, $username, $token) = @_;
  92         my $hours = $self->{token_max_age} / 60 / 60;
  93         $hours .= $hours == 1 ? ' hour' : ' hours';
  94         <<EOF;
  95 Someone has requested a password reset for your account.
  96
  97 To reset your password, please submit the reset password form on the
  98 website using the following information:
  99
 100 Username: $username
 101 Password: <your new password>
 102 Reset token: $token
 103
 104 The token is valid for $hours.
 105 EOF
 106 }
 107
 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(
 114                 header => [
 115                         From    => $self->{mail_from},
 116                         To      => $user->{email},
 117                         Subject => $user->{mail_subject},
 118                 ],
 119                 body => $self->mail_body($username, $token),
 120         ));
 121 }
 122
 123 ##################################################
 124
 125 sub response {
 126         my ($self, $code, $body) = @_;
 127         return [
 128                 $code,
 129                 ['Content-Type' => 'text/plain',
 130                  'Content-Length' => length $body],
 131                 [ $body ],
 132         ];
 133 }
 134
 135 sub reply                 { shift->response(200, $_[0]) }
 136 sub bad_request           { shift->response(400, $_[0]) }
 137 sub internal_server_error { shift->response(500, $_[0]) }
 138
 139 sub unauthorized {
 140         my ($self) = @_;
 141         my $body = 'Authorization required';
 142         return [
 143                 401,
 144                 ['Content-Type' => 'text/plain',
 145                  'Content-Length' => length $body,
 146                  'WWW-Authenticate' => 'Basic realm="' . $self->{realm} . '"' ],
 147                 [ $body ],
 148         ];
 149 }
 150
 151 ##################################################
 152
 153 sub call_register {
 154         my ($self, $req) = @_;
 155         my %parms;
 156         for (qw/username password confirm_password email/) {
 157                 $parms{$_} = $req->param($_);
 158                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 159         }
 160
 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')
 166 }
 167
 168 sub call_passwd {
 169         my ($self, $req) = @_;
 170         return $self->unauthorized unless $req->user;
 171         my %parms;
 172         for (qw/password new_password confirm_new_password/) {
 173                 $parms{$_} = $req->param($_);
 174                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 175         }
 176
 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');
 181 }
 182
 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');
 188         my $ok = 0;
 189         eval {
 190                 $self->send_reset_email($username);
 191                 $ok = 1;
 192         };
 193         return $self->reply('Email sent') if $ok;
 194         return $self->internal_server_error($@);
 195 }
 196
 197 sub call_reset {
 198         my ($self, $req) = @_;
 199         my %parms;
 200         for (qw/username new_password confirm_new_password token/) {
 201                 $parms{$_} = $req->param($_);
 202                 return $self->bad_request("Missing parameter $_") unless $parms{$_};
 203         }
 204
 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');
 213 }
 214
 215 sub call {
 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);
 221         }
 222
 223         my $req = Plack::Request->new($env);
 224
 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};
 230         }
 231
 232         $env->{authcomplex} = $self;
 233         $self->app->($env);
 234 }
 235
 236 1;
 237 __END__
 238
 239 =head1 NAME
 240
 241 Plack::Middleware::Auth::Complex - Feature-rich authentication system
 242
 243 =head1 SYNOPSIS
 244
 245   use Plack::Builder;
 246
 247   builder {
 248     enable 'Auth::Complex', dbi_connect => ['dbi:Pg:dbname=mydb', '', ''], mail_from => 'nobody@example.org';
 249     sub {
 250       my ($env) = @_;
 251       [200, [], ['Hello ' . ($env->{REMOTE_USER} // 'unregistered user')]]
 252     }
 253   }
 254
 255 =head1 DESCRIPTION
 256
 257 AuthComplex is an authentication system for Plack applications that
 258 allows user registration, password changing and password reset.
 259
 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
 263 request.
 264
 265 Some options can be controlled by passing a hashref to the
 266 constructor. More customization can be achieved by subclassing this
 267 module.
 268
 269 =head2 Intercepted URLs
 270
 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.
 275
 276 =over
 277
 278 =item B<POST> /register?username=user&password=pw&confirm_password=pw&email=user@example.org
 279
 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.
 283
 284 =item B<POST> /passwd?password=oldpw&new_password=newpw&confirm_new_password=newpw
 285
 286 This URL changes the password of a user. The user must be
 287 authenticated (otherwise the endpoint will return 401).
 288
 289 =item B<POST> /request-reset?username=user
 290
 291 This URL requests a password reset token for the given user. The token
 292 will be sent to the user's email address.
 293
 294 A reset token in the default implementation is C<< base64(HMAC-SHA1("$username $passphrase $expiration_unix_time")) . ":$expiration_user_time" >>.
 295
 296 =item B<POST> /reset?username=user&new_password=pw&confirm_new_password=pw&token=token
 297
 298 This URL performs a password reset.
 299
 300 =back
 301
 302 =head2 Constructor arguments
 303
 304 =over
 305
 306 =item dbi_connect
 307
 308 Arrayref of arguments to pass to DBI->connect. Defaults to
 309 C<['dbi:Pg', '', '']>.
 310
 311 =item post_connect_cb
 312
 313 Callback (coderef) that is called just after connecting to the
 314 database. Used by the testsuite to create the users table.
 315
 316 =item select_user
 317
 318 SQL statement that selects a user by username. Defaults to
 319 C<'SELECT id, passphrase, email FROM users WHERE id = ?'>.
 320
 321 =item update_pass
 322
 323 SQL statement that updates a user's password. Defaults to
 324 C<'UPDATE users SET passphrase = ? WHERE id = ?'>.
 325
 326 =item insert_user
 327
 328 SQL statement that inserts a user. Defaults to
 329 C<'INSERT INTO users (id, passphrase, email) VALUES (?,?,?)'>.
 330
 331 =item hmackey
 332
 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.
 336
 337 =item mail_from
 338
 339 From: header of password reset emails. If not provided, password reset
 340 is disabled.
 341
 342 =item mail_subject
 343
 344 The subject of password reset emails. Defaults to
 345 C<'Password reset token'>.
 346
 347 =item realm
 348
 349 Authentication realm. Defaults to C<'restricted area'>.
 350
 351 =item token_max_age
 352
 353 Password reset token validity, in seconds. Defaults to 24 hours.
 354
 355 =item username_regex
 356
 357 Regular expression that matches valid usernames. Defaults to
 358 C<qr/^\w{2,20}$/a>.
 359
 360 =item register_url
 361
 362 URL for registering. Defaults to C<'/register'>.
 363
 364 =item passwd_url
 365
 366 URL for changing your password. Defaults to C<'/passwd'>.
 367
 368 =item request_reset_url
 369
 370 URL for requesting a password reset token by email. Defaults to
 371 C<'/request-reset'>.
 372
 373 =item reset_url
 374
 375 URL for resetting your password with a reset token. Defaults to
 376 C<'/reset'>.
 377
 378 =back
 379
 380 =head2 Methods
 381
 382 =over
 383
 384 =item B<default_opts>
 385
 386 Returns a list of default options for the constructor.
 387
 388 =item B<new>(I<\%opts>)
 389
 390 Creates a new AuthComplex object.
 391
 392 =item B<init>
 393
 394 Called at the end of the constructor. The default implementation
 395 connects to the database, calls C<post_connect_cb> and prepares the
 396 SQL statements.
 397
 398 =item B<get_user>(I<$username>)
 399
 400 Returns a hashref with (at least) the following keys: passphrase (the
 401 RFC2307-formatted passphrase of the user), email (the user's email
 402 address).
 403
 404 =item B<check_passphrase>(I<$username>, I<$passphrase>)
 405
 406 Returns true if the given plaintext passphrase matches the one
 407 obtained from database. Default implementation uses L<Authen::Passphrase>.
 408
 409 =item B<hash_passphrase>(I<$passphrase>)
 410
 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.
 414
 415 =item B<set_passphrase>(I<$username>, I<$passphrase>)
 416
 417 Changes a user's passphrase to the given value.
 418
 419 =item B<make_reset_hmac>(I<$username>, [I<@data>])
 420
 421 Returns the HMAC part of the reset token.
 422
 423 =item B<mail_body>(I<$username>, I<$token>)
 424
 425 Returns the body of the password reset email for the given username
 426 and password reset token.
 427
 428 =item B<send_reset_email>(I<$username>)
 429
 430 Generates a new reset token and sends it to the user via email.
 431
 432 =item B<response>(I<$code>, I<$body>)
 433
 434 Helper method. Returns a PSGI response with the given response code
 435 and string body.
 436
 437 =item B<reply>(I<$message>)
 438
 439 Shorthand for C<response(200, $message)>.
 440
 441 =item B<bad_request>(I<$message>)
 442
 443 Shorthand for C<response(400, $message)>.
 444
 445 =item B<internal_server_error>(I<$message>)
 446
 447 Shorthand for C<response(500, $message)>.
 448
 449 =item B<unauthorized>
 450
 451 Returns a 401 Authorization required response.
 452
 453 =item B<call_register>(I<$req>)
 454
 455 Handles the C</register> endpoint. I<$req> is a Plack::Request object.
 456
 457 =item B<call_passwd>(I<$req>)
 458
 459 Handles the C</passwd> endpoint. I<$req> is a Plack::Request object.
 460
 461 =item B<call_request_reset>(I<$req>)
 462
 463 Handles the C</request-reset> endpoint. I<$req> is a Plack::Request object.
 464
 465 =item B<call_reset>(I<$req>)
 466
 467 Handles the C</reset> endpoint. I<$req> is a Plack::Request object.
 468
 469 =back
 470
 471 =head1 AUTHOR
 472
 473 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 474
 475 =head1 COPYRIGHT AND LICENSE
 476
 477 Copyright (C) 2015 by Marius Gavrilescu
 478
 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.
 482
 483
 484 =cut