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 strict;
   8 use v5.10;
   9
  10 my $hmac_key;
  11 open HMAC_KEY, "$ENV{BLERG_HOME}/etc/hmac_key"
  12     or die "Could not open $ENV{BLERG_HOME}/etc/hmac_key";
  13 read(HMAC_KEY, $hmac_key, 256);
  14 close HMAC_KEY;
  15
  16 sub print_404 {
  17     print header(-type => 'text/html',
  18                  -status => '404 Not Found');
  19     print <<DOC;
  20 <!DOCTYPE html>
  21 <h1>404 Not Found</h1>
  22 DOC
  23 }
  24
  25 sub print_403 {
  26     print header(-type => 'text/html',
  27                  -status => '403 Forbidden');
  28     print <<DOC;
  29 <!DOCTYPE html>
  30 <h1>403 Forbidden</h1>
  31 Please log in first.
  32 DOC
  33 }
  34
  35 sub generate_email_verify_url {
  36     my ($username, $email) = @_;
  37
  38     # generate verification data
  39     my $expiry = time + 900;
  40     my $data = "$username;" . uri_escape($email) . ";$expiry";
  41
  42     # HMAC-SHA256 it
  43     my $hmac = hmac_sha256_base64($data, $hmac_key);
  44
  45     return Blerg::Database::BASEURL . "#/account/email-verify/$data;$hmac";
  46 }
  47
  48 sub validate_email_data {
  49     my ($data) = @_;
  50     my ($payload, $hmac);
  51
  52     if ($data =~ /^(.*);([^;]+)$/) {
  53         $payload = $1;
  54         $hmac = $2;
  55     } else {
  56         return undef;
  57     }
  58
  59     my $computed_hmac = hmac_sha256_base64($payload, $hmac_key);
  60     if ($hmac ne $computed_hmac) {
  61         return undef;
  62     }
  63
  64     my ($username, $email, $expiry) = split(';', $payload);
  65     $email = uri_unescape($email);
  66     if (time > $expiry) {
  67         return undef;
  68     }
  69
  70     return ($username, $email);
  71 }
  72
  73 sub validate_authentication {
  74     my ($q) = @_;
  75
  76     my $auth = $q->cookie('auth');
  77     if (!defined $auth) {
  78         return undef;
  79     }
  80     my ($username, $token) = split('/', $auth);
  81     if (Blerg::Database::auth_check_token($username, $token)) {
  82         return $username;
  83     }
  84
  85     return undef;
  86 }
  87
  88 REQUEST:
  89 while (my $q = new CGI::Fast) {
  90     my (undef, $cmd, $args) = split '/', $ENV{PATH_INFO}, 3;
  91
  92     given ($cmd) {
  93         when ('register') {
  94             my $username = validate_authentication($q);
  95             if (!defined $username) {
  96                 print_403;
  97                 next REQUEST;
  98             }
  99
 100             print header(-type => 'application/json');
 101             my $email = $q->param('email');
 102             if (!defined $email) {
 103                 say '{"status": "failure"}';
 104                 next REQUEST;
 105             }
 106
 107             my $url = generate_email_verify_url($username, $email);
 108             Mail::Message->build(
 109                 From => Mail::Address->new('BlergBot', 'noreply@blerg.cc'),
 110                 To => $email,
 111                 Subject => 'Blërg Email Verification',
 112                 Mail::Message::Field->new('Content-Type', 'text/plain', 'charset="utf8"'),
 113                 data => <<EMAIL
 114 To verify this email address, please click or copy/paste the following link
 115 into your web browser.
 116
 117 $url
 118
 119 If you received this email by mistake, just ignore it.
 120
 121 - Blërg!
 122 EMAIL
 123             )->send;
 124
 125             say '{"status": "success"}';
 126         }
 127         when ('verify') {
 128             print header(-type => 'application/json');
 129
 130             my ($username, $email) = validate_email_data($q->param('data'));
 131
 132             if (!defined $username) {
 133                 say '{"status": "failure"}';
 134                 next REQUEST;
 135             }
 136
 137             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 138             open CONF, '>', $email_conf_path;
 139             print CONF $email;
 140             close CONF;
 141
 142             say '{"status": "success"}';
 143         }
 144         when ('cancel') {
 145             my $username = validate_authentication($q);
 146             if (!defined $username) {
 147                 print_403;
 148                 next REQUEST;
 149             }
 150
 151             print header(-type => 'application/json');
 152
 153             my $email_conf_path = Blerg::Database::configuration->{data_path} . "/$username/email";
 154             if (unlink $email_conf_path) {
 155                 say '{"status": "success"}';
 156             } else {
 157                 say '{"status": "failure"}';
 158             }
 159         }
 160         default {
 161             print_404;
 162         }
 163     }
 164 }