aux/cgi/email.cgi

   1 #!/usr/bin/perl
   2 use CGI::Fast qw/:cgi/;
   3 use Digest::SHA qw/hmac_sha256_base64/;
   4 use Blerg::Database;
   5 use URI::Escape;
   6 use Mail::Message;
   7 use JSON;
   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_email_verify_url {
  37     my ($username, $email) = @_;
  38
  39     # generate verification data
  40     my $expiry = time + 900;
  41     my $data = "$username;" . uri_escape($email) . ";$expiry";
  42
  43     # HMAC-SHA256 it
  44     my $hmac = hmac_sha256_base64($data, $hmac_key);
  45
  46     return Blerg::Database::BASEURL . "#/account/email-verify/$data;$hmac";
  47 }
  48
  49 sub validate_email_data {
  50     my ($data) = @_;
  51     my ($payload, $hmac);
  52
  53     if ($data =~ /^(.*);([^;]+)$/) {
  54         $payload = $1;
  55         $hmac = $2;
  56     } else {
  57         return undef;
  58     }
  59
  60     my $computed_hmac = hmac_sha256_base64($payload, $hmac_key);
  61     if ($hmac ne $computed_hmac) {
  62         return undef;
  63     }
  64
  65     my ($username, $email, $expiry) = split(';', $payload);
  66     $email = uri_unescape($email);
  67     if (time > $expiry) {
  68         return undef;
  69     }
  70
  71     return ($username, $email);
  72 }
  73
  74 sub validate_authentication {
  75     my ($q) = @_;
  76
  77     my $auth = $q->cookie('auth');
  78     if (!defined $auth) {
  79         return undef;
  80     }
  81     my ($username, $token) = split('/', $auth);
  82     if (Blerg::Database::auth_check_token($username, $token)) {
  83         return $username;
  84     }
  85
  86     return undef;
  87 }
  88
  89 REQUEST:
  90 while (my $q = new CGI::Fast) {
  91     my (undef, $cmd, $args) = split '/', $ENV{PATH_INFO}, 3;
  92
  93     given ($cmd) {
  94         when ('register') {
  95             my $username = validate_authentication($q);
  96             if (!defined $username) {
  97                 print_403;
  98                 next REQUEST;
  99             }
 100
 101             print header(-type => 'application/json');
 102             my $email = $q->param('email');
 103             if (!defined $email) {
 104                 say '{"status": "failure"}';
 105                 next REQUEST;
 106             }
 107
 108             my $url = generate_email_verify_url($username, $email);
 109             Mail::Message->build(
 110                 From => Mail::Address->new('BlergBot', 'noreply@blerg.cc'),
 111                 To => $email,
 112                 Subject => 'Blërg Email Verification',
 113                 Mail::Message::Field->new('Content-Type', 'text/plain', 'charset="utf8"'),
 114                 data => <<EMAIL
 115 To verify this email address, please click or copy/paste the following link
 116 into your web browser.
 117
 118 $url
 119
 120 If you received this email by mistake, just ignore it.
 121
 122 - Blërg!
 123 EMAIL
 124             )->send;
 125
 126             say '{"status": "success"}';
 127         }
 128         when ('verify') {
 129             print header(-type => 'application/json');
 130
 131             my ($username, $email) = validate_email_data($q->param('data'));
 132
 133             if (!defined $username) {
 134                 say '{"status": "failure"}';
 135                 next REQUEST;
 136             }
 137
 138             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 139             open CONF, '>', $email_conf_path;
 140             print CONF $email;
 141             close CONF;
 142
 143             say '{"status": "success"}';
 144         }
 145         when ('status') {
 146             my $username = validate_authentication($q);
 147             if (!defined $username) {
 148                 print_403;
 149                 next REQUEST;
 150             }
 151
 152             my $email = undef;
 153             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 154             if (-f $email_conf_path) {
 155                 open CONF, $email_conf_path;
 156                 $email = <CONF>;
 157                 close CONF;
 158             }
 159
 160             say header(-type => 'application/json'),
 161                 JSON->new->utf8->encode({email => $email});
 162         }
 163         when ('cancel') {
 164             my $username = validate_authentication($q);
 165             if (!defined $username) {
 166                 print_403;
 167                 next REQUEST;
 168             }
 169
 170             print header(-type => 'application/json');
 171
 172             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 173             if (unlink $email_conf_path) {
 174                 say '{"status": "success"}';
 175             } else {
 176                 say '{"status": "failure"}';
 177             }
 178         }
 179         default {
 180             print_404;
 181         }
 182     }
 183 }