404 Not Found

#!/usr/bin/perl
use CGI::Fast qw/:cgi/;
use Digest::SHA qw/hmac_sha256/;
use MIME::Base64 qw/encode_base64url decode_base64url/;
use Blerg::Database;
use Mail::Message;
use JSON;
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_email_verify_url {
    my ($username, $email) = @_;

    # generate verification data
    my $expiry = time + 900;
    my $email_b64 = encode_base64url($email);
    my $data = "$username:$email_b64:$expiry";
        
    # HMAC-SHA256 it
    my $hmac = encode_base64url(hmac_sha256($data, $hmac_key));

    return Blerg::Database::BASEURL . "#/email-verify/$data:$hmac";
}

sub validate_email_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, $email, $expiry) = split(':', $payload);
    $email = decode_base64url($email);
    if (time > $expiry) {
        return undef;
    }

    return ($username, $email);
}

sub validate_authentication {
    my ($q) = @_;

    my $auth = $q->cookie('auth');
    if (!defined $auth) {
        return undef;
    }
    my ($username, $token) = split('/', $auth);
    if (Blerg::Database::auth_check_token($username, $token)) {
        return $username;
    }

    return undef;
}

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

    given ($cmd) {
        when ('register') {
            my $username = validate_authentication($q);
            if (!defined $username) {
                print_403;
                next REQUEST;
            }

            print header(-type => 'application/json');
            my $email = $q->param('email');
            if (!defined $email) {
                say '{"status": "failure"}';
                next REQUEST;
            }

            my $url = generate_email_verify_url($username, $email);
            Mail::Message->build(
                From => Mail::Address->new('BlergBot', 'noreply@blerg.cc'),
                To => $email,
                Subject => 'Blërg Email Verification',
                Mail::Message::Field->new('Content-Type', 'text/plain', 'charset="utf8"'),
                data => <<EMAIL
To verify this email address, please click or copy/paste the following link
into your web browser.

$url

If you received this email by mistake, just ignore it.

- Blërg!
EMAIL
            )->send;

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

            my ($username, $email) = validate_email_data($q->param('data'));

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

            my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
            open CONF, '>', $email_conf_path;
            print CONF $email;
            close CONF;

            say '{"status": "success"}';
        }
        when ('status') {
            my $username = validate_authentication($q);
            if (!defined $username) {
                print_403;
                next REQUEST;
            }

            my $email = undef;
            my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
            if (-f $email_conf_path) {
                open CONF, $email_conf_path;
                $email = <CONF>;
                close CONF;
            }

            say header(-type => 'application/json'),
                JSON->new->utf8->encode({email => $email});
        }
        when ('cancel') {
            my $username = validate_authentication($q);
            if (!defined $username) {
                print_403;
                next REQUEST;
            }

            print header(-type => 'application/json');

            my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
            if (unlink $email_conf_path) {
                say '{"status": "success"}';
            } else {
                say '{"status": "failure"}';
            }
        }
        default {
            print_404;
        }
    }
}