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