404 Not Found

#!/usr/bin/perl
use CGI::Fast qw/:cgi/;
use Digest::SHA qw/hmac_sha256/;
use MIME::Base64 qw/encode_base64url/;
use Blerg::Database;
use Mail::Message;
use Time::HiRes qw/sleep/;
use strict;
use v5.10;

my $hmac_key;
open HMAC_KEY, "$ENV{BLERG_HOME}/etc/hmac_key"
    or die "Could not open $ENV{BLERG_HOME}/etc/hmac_key";
read(HMAC_KEY, $hmac_key, 256);
close HMAC_KEY;

sub print_404 {
    print header(-type => 'text/html',
                 -status => '404 Not Found');
    print <<DOC;
<!DOCTYPE html>
<h1>404 Not Found</h1>
DOC
}

sub print_403 {
    print header(-type => 'text/html',
                 -status => '403 Forbidden');
    print <<DOC;
<!DOCTYPE html>
<h1>403 Forbidden</h1>
Please log in first.
DOC
}

sub generate_reset_url {
    my ($username, $validity) = @_;

    # generate reset data
    my $expiry = time + $validity;
    my $counter = Blerg::Database::auth_get_counter($username)
        or return undef;
    my $data = "$username:$expiry:$counter";
        
    # HMAC-SHA256 it
    my $hmac = encode_base64url(hmac_sha256($data, $hmac_key));

    return Blerg::Database::BASEURL . "#/recovery/$data:$hmac";
}

sub validate_reset_data {
    my ($data) = @_;
    my ($payload, $hmac);

    if ($data =~ /^(.*):([^:]+)$/) {
        $payload = $1;
        $hmac = $2;
    } else {
        return undef;
    }

    my $computed_hmac = encode_base64url(hmac_sha256($payload, $hmac_key));
    if ($hmac ne $computed_hmac) {
        return undef;
    }

    my ($username, $expiry, $counter) = split(':', $payload);
    if (time > $expiry
        || $counter != Blerg::Database::auth_get_counter($username)) {
        return undef;
    }

    return $username;
}

REQUEST:
while (my $q = new CGI::Fast) {
    my (undef, $cmd, $args) = split '/', $ENV{PATH_INFO}, 3;

    given ($cmd) {
        when ('new') {
            # determine that authentication is valid.
            my $auth = $q->cookie('auth');
            if (!defined $auth) {
                print_403;
                next REQUEST;
            }
            my ($username, $token) = split('/', $auth);
            if (!Blerg::Database::auth_check_token($username, $token)) {
                print_403;
                next REQUEST;
            }

            my $validity = 365 * 86400;     # One year
            print header(-type => 'text/plain');
            print generate_reset_url($username, $validity);
        }
        when ('mail') {
            print header(-type => 'application/json');

            if (!(defined $q->param('username') and defined $q->param('email'))) {
                say '{"status": "failed"}';
                next REQUEST;
            }

            # Sleep for a bit to scramble the timing
            sleep(rand(1.0) + 1);

            # From here on, we report success so as not to leak user information
            my $username = $q->param('username');
            if (!Blerg::Database::exists($username)) {
                say '{"status": "success"}';
                next REQUEST;
            }

            # check that the user has a validated mail address
            my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
            my $email;
            if (!open EMAIL, $email_conf_path) {
                say '{"status": "success"}';
                next REQUEST;
            }
            $email = <EMAIL>;
            close EMAIL;

            if ($q->param('email') ne $email) {
                say '{"status": "success"}';
                next REQUEST;
            }

            my $url = generate_reset_url($username, 900);
            Mail::Message->build(
                From => Mail::Address->new('BlergBot', 'noreply@blerg.cc'),
                To => $email,
                Subject => 'Blërg Password Recovery',
                Mail::Message::Field->new('Content-Type', 'text/plain', 'charset="utf8"'),
                data => <<EMAIL
Here's a 15-minute recovery link to reset your password.

$url

If you didn't request a password reset, please ignore this email.

- Blërg!
EMAIL
            )->send;

            say '{"status": "success"}';
        }
        when ('validate') {
            print header(-type => 'application/json');

            my $username = validate_reset_data($q->param('data'));

            if (!defined $username) {
                say '{"status": "failure"}';
                next REQUEST;
            }

            my $password = $q->param('password');
            if (Blerg::Database::auth_set_password($username, $password)) {
                say '{"status": "success"}';
            } else {
                say '{"status": "failure"}';
            }
        }
        default {
            print_404;
        }
    }
}