Make Account Center only usable when logged in
[blerg.git] / 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 }