Fix ordering in perl subscription_list

[blerg.git] / aux / cgi / recovery.cgi

diff --git a/aux/cgi/recovery.cgi b/aux/cgi/recovery.cgi
index 6d6f3a1..f63175a 100755 (executable)
--- a/aux/cgi/recovery.cgi
+++ b/aux/cgi/recovery.cgi
@@ -1,7 +1,10 @@
 #!/usr/bin/perl
 use CGI::Fast qw/:cgi/;
-use Digest::SHA qw/hmac_sha256_base64/;
+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;
 
@@ -37,31 +40,31 @@ sub generate_reset_url {
     my $expiry = time + $validity;
     my $counter = Blerg::Database::auth_get_counter($username)
         or return undef;
-    my $data = "$username;$expiry;$counter";
+    my $data = "$username:$expiry:$counter";
         
     # HMAC-SHA256 it
-    my $hmac = hmac_sha256_base64($data, $hmac_key);
+    my $hmac = encode_base64url(hmac_sha256($data, $hmac_key));
 
-    return Blerg::Database::BASEURL . "#/recovery/$data;$hmac";
+    return Blerg::Database::BASEURL . "#/recovery/$data:$hmac";
 }
 
 sub validate_reset_data {
     my ($data) = @_;
     my ($payload, $hmac);
 
-    if ($data =~ /^(.*);([^;]+)$/) {
+    if ($data =~ /^(.*):([^:]+)$/) {
         $payload = $1;
         $hmac = $2;
     } else {
         return undef;
     }
 
-    my $computed_hmac = hmac_sha256_base64($payload, $hmac_key);
+    my $computed_hmac = encode_base64url(hmac_sha256($payload, $hmac_key));
     if ($hmac ne $computed_hmac) {
         return undef;
     }
 
-    my ($username, $expiry, $counter) = split(';', $payload);
+    my ($username, $expiry, $counter) = split(':', $payload);
     if (time > $expiry
         || $counter != Blerg::Database::auth_get_counter($username)) {
         return undef;
@@ -93,9 +96,56 @@ while (my $q = new CGI::Fast) {
             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
-            # generate reset message
-            # send mail
+            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');