/aux/cgi/recovery.cgi
#!/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;
}
}
}