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