aux/cgi/recovery.cgi

   1 #!/usr/bin/perl
   2 use CGI::Fast qw/:cgi/;
   3 use Digest::SHA qw/hmac_sha256/;
   4 use MIME::Base64 qw/encode_base64url/;
   5 use Blerg::Database;
   6 use Mail::Message;
   7 use Time::HiRes qw/sleep/;
   8 use strict;
   9 use v5.10;
  10
  11 my $hmac_key;
  12 open HMAC_KEY, "$ENV{BLERG_HOME}/etc/hmac_key"
  13     or die "Could not open $ENV{BLERG_HOME}/etc/hmac_key";
  14 read(HMAC_KEY, $hmac_key, 256);
  15 close HMAC_KEY;
  16
  17 sub print_404 {
  18     print header(-type => 'text/html',
  19                  -status => '404 Not Found');
  20     print <<DOC;
  21 <!DOCTYPE html>
  22 <h1>404 Not Found</h1>
  23 DOC
  24 }
  25
  26 sub print_403 {
  27     print header(-type => 'text/html',
  28                  -status => '403 Forbidden');
  29     print <<DOC;
  30 <!DOCTYPE html>
  31 <h1>403 Forbidden</h1>
  32 Please log in first.
  33 DOC
  34 }
  35
  36 sub generate_reset_url {
  37     my ($username, $validity) = @_;
  38
  39     # generate reset data
  40     my $expiry = time + $validity;
  41     my $counter = Blerg::Database::auth_get_counter($username)
  42         or return undef;
  43     my $data = "$username:$expiry:$counter";
  44
  45     # HMAC-SHA256 it
  46     my $hmac = encode_base64url(hmac_sha256($data, $hmac_key));
  47
  48     return Blerg::Database::BASEURL . "#/recovery/$data:$hmac";
  49 }
  50
  51 sub validate_reset_data {
  52     my ($data) = @_;
  53     my ($payload, $hmac);
  54
  55     if ($data =~ /^(.*):([^:]+)$/) {
  56         $payload = $1;
  57         $hmac = $2;
  58     } else {
  59         return undef;
  60     }
  61
  62     my $computed_hmac = encode_base64url(hmac_sha256($payload, $hmac_key));
  63     if ($hmac ne $computed_hmac) {
  64         return undef;
  65     }
  66
  67     my ($username, $expiry, $counter) = split(':', $payload);
  68     if (time > $expiry
  69         || $counter != Blerg::Database::auth_get_counter($username)) {
  70         return undef;
  71     }
  72
  73     return $username;
  74 }
  75
  76 REQUEST:
  77 while (my $q = new CGI::Fast) {
  78     my (undef, $cmd, $args) = split '/', $ENV{PATH_INFO}, 3;
  79
  80     given ($cmd) {
  81         when ('new') {
  82             # determine that authentication is valid.
  83             my $auth = $q->cookie('auth');
  84             if (!defined $auth) {
  85                 print_403;
  86                 next REQUEST;
  87             }
  88             my ($username, $token) = split('/', $auth);
  89             if (!Blerg::Database::auth_check_token($username, $token)) {
  90                 print_403;
  91                 next REQUEST;
  92             }
  93
  94             my $validity = 365 * 86400;     # One year
  95             print header(-type => 'text/plain');
  96             print generate_reset_url($username, $validity);
  97         }
  98         when ('mail') {
  99             print header(-type => 'application/json');
 100
 101             if (!(defined $q->param('username') and defined $q->param('email'))) {
 102                 say '{"status": "failed"}';
 103                 next REQUEST;
 104             }
 105
 106             # Sleep for a bit to scramble the timing
 107             sleep(rand(1.0) + 1);
 108
 109             # From here on, we report success so as not to leak user information
 110             my $username = $q->param('username');
 111             if (!Blerg::Database::exists($username)) {
 112                 say '{"status": "success"}';
 113                 next REQUEST;
 114             }
 115
 116             # check that the user has a validated mail address
 117             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 118             my $email;
 119             if (!open EMAIL, $email_conf_path) {
 120                 say '{"status": "success"}';
 121                 next REQUEST;
 122             }
 123             $email = <EMAIL>;
 124             close EMAIL;
 125
 126             if ($q->param('email') ne $email) {
 127                 say '{"status": "success"}';
 128                 next REQUEST;
 129             }
 130
 131             my $url = generate_reset_url($username, 900);
 132             Mail::Message->build(
 133                 From => Mail::Address->new('BlergBot', 'noreply@blerg.cc'),
 134                 To => $email,
 135                 Subject => 'Blërg Password Recovery',
 136                 Mail::Message::Field->new('Content-Type', 'text/plain', 'charset="utf8"'),
 137                 data => <<EMAIL
 138 Here's a 15-minute recovery link to reset your password.
 139
 140 $url
 141
 142 If you didn't request a password reset, please ignore this email.
 143
 144 - Blërg!
 145 EMAIL
 146             )->send;
 147
 148             say '{"status": "success"}';
 149         }
 150         when ('validate') {
 151             print header(-type => 'application/json');
 152
 153             my $username = validate_reset_data($q->param('data'));
 154
 155             if (!defined $username) {
 156                 say '{"status": "failure"}';
 157                 next REQUEST;
 158             }
 159
 160             my $password = $q->param('password');
 161             if (Blerg::Database::auth_set_password($username, $password)) {
 162                 say '{"status": "success"}';
 163             } else {
 164                 say '{"status": "failure"}';
 165             }
 166         }
 167         default {
 168             print_404;
 169         }
 170     }
 171 }