+#!/usr/bin/perl
+use CGI::Fast qw/:cgi/;
+use Digest::SHA qw/hmac_sha256_base64/;
+use Blerg::Database;
+use URI::Escape;
+use Mail::Message;
+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 $data = "$username;" . uri_escape($email) . ";$expiry";
+
+ # HMAC-SHA256 it
+ my $hmac = hmac_sha256_base64($data, $hmac_key);
+
+ return Blerg::Database::BASEURL . "#/account/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 = hmac_sha256_base64($payload, $hmac_key);
+ if ($hmac ne $computed_hmac) {
+ return undef;
+ }
+
+ my ($username, $email, $expiry) = split(';', $payload);
+ $email = uri_unescape($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 ('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;
+ }
+ }
+}