This repository has been archived on 2022-07-19. You can view files and clone it, but cannot push or open issues or pull requests.
dotplan-online/server.pl

665 lines
22 KiB
Perl
Raw Normal View History

2020-07-16 20:48:53 -05:00
#!/usr/bin/env perl
use utf8;
use strict;
use warnings;
use open qw(:std :utf8);
######################
# Server Configuration
######################
2020-07-17 21:36:12 -05:00
my $server_port = $ENV{'PORT'} || 4227;
2020-07-18 15:23:29 -05:00
my $pid_file = $ENV{'PID_FILE'} || './data/dotplan.pid';
my $log_file = $ENV{'LOG_FILE'} || './data/dotplan.log';
my $database = $ENV{'DATABASE'} || './data/users.db';
my $plan_dir = $ENV{'PLAN_DIR'} || './data/plans';
2020-07-17 21:36:12 -05:00
my $sendmail = $ENV{'SENDMAIL'} || '/usr/bin/sendmail';
my $pw_token_expiration_minutes = $ENV{'PW_TOKEN_EXPIRATION_MINUTES'} || 10;
my $auth_token_default_expiration_minutes = $ENV{'AUTH_TOKEN_DEFAULT_EXPIRATION_MINUTES'} || 5;
my $minimum_password_length = $ENV{'MINIMUM_PASSWORD_LENGTH'} || 8;
my $minimum_email_length = $ENV{'MINIMUM_EMAIL_LENGTH'} || 6;
my $maximum_email_length = $ENV{'MAXIMUM_EMAIL_LENGTH'} || 120;
my $maximum_plan_length = $ENV{'MAXIMUM_PLAN_LENGTH'} || 4096;
my $maximum_signature_length = $ENV{'MAXIMUM_SIGNATURE_LENGTH'} || 1024;
my $maximum_pubkey_length = $ENV{'MAXIMUM_PUBKEY_LENGTH'} || 5125;
2020-07-17 21:36:12 -05:00
my $hostname = $ENV{'HOSTNAME'};
my $localdomains = {};
if (defined $ENV{'LOCAL_DOMAINS'}) {
$localdomains->{$_}++ for (split(/,/, $ENV{'LOCAL_DOMAINS'}));
}
2020-07-16 20:48:53 -05:00
#########################################
# dotplan.online Reference Implementation
#########################################
{
package DotplanApi;
use base qw(HTTP::Server::Simple::CGI);
2020-07-18 15:23:29 -05:00
sub net_server { 'Net::Server::Fork' }
2020-07-16 23:55:59 -05:00
2020-07-17 21:36:12 -05:00
# Caching DNS resolver
{
package Net::DNS::Resolver;
my %cache;
sub query {
my $self = shift;
$cache{"@_"} ||= $self->SUPER::query(@_);
}
}
2020-07-18 15:23:29 -05:00
use IPC::Run;
2020-07-17 21:36:12 -05:00
use DBI;
use File::Temp qw(tempfile);
2020-07-17 21:36:12 -05:00
use Fcntl qw(:flock);
use Net::DNS::Resolver;
use Crypt::Eksblowfish::Bcrypt qw(bcrypt_hash en_base64);
use MIME::Base64 qw(decode_base64);
2020-07-16 20:48:53 -05:00
use POSIX qw(strftime);
use JSON qw(encode_json decode_json);
2020-07-17 21:36:12 -05:00
use URI::Escape qw(uri_escape);
2020-07-16 20:48:53 -05:00
use HTML::Entities qw(encode_entities);
2020-07-17 21:36:12 -05:00
use String::ShellQuote qw(shell_quote);
2020-07-16 20:48:53 -05:00
###############
# Common Errors
###############
my $not_found = encode_json({error => 'Not found.'});
my $not_implemented = encode_json({error => 'Not implemented yet.'});
2020-07-16 23:55:59 -05:00
my $not_allowed = encode_json({error => 'HTTP method not supported.'});
2020-07-17 21:36:12 -05:00
my $not_authorized = encode_json({error => 'Not authorized.'});
2020-07-16 23:55:59 -05:00
my $resp_header = {
200 => 'OK',
2020-07-17 21:36:12 -05:00
301 => 'Moved Permanently',
308 => 'Permanent Redirect',
400 => 'Bad Request',
401 => 'Unauthorized',
2020-07-16 23:55:59 -05:00
404 => 'Not Found',
2020-07-17 21:36:12 -05:00
405 => 'Method Not Allowed',
429 => 'Too Many Requests',
2020-07-16 23:55:59 -05:00
501 => 'Not Implemented',
2020-07-17 21:36:12 -05:00
500 => 'Internal Server Error'
2020-07-16 23:55:59 -05:00
};
2020-07-16 20:48:53 -05:00
#################
# Request Routing
#################
sub handle_request {
my ($self, $cgi) = @_;
2020-07-17 21:36:12 -05:00
# assign a random request id for anonymous logging
my $req_id = util_req_id();
$cgi->param('request_id', $req_id);
2020-07-16 20:48:53 -05:00
my $path = $cgi->path_info();
my $method = $cgi->request_method();
2020-07-17 21:36:12 -05:00
my $host = $cgi->http('X-Forwarded-For') || $cgi->remote_addr();
eval {
util_log("REQ $req_id $method $path");
if ($method eq 'GET') {
if ($path =~ /^\/users\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
validate_email($1, $cgi);
} elsif ($path =~ /^\/token$/) {
get_token($cgi);
} elsif ($path =~ /^\/users\/([^\/]{$minimum_email_length,$maximum_email_length})\/pwtoken$/) {
get_pwtoken($1, $cgi);
} elsif ($path =~ /^\/plan\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
get_plan($1, $cgi);
} else {
print_response($cgi, 404, $not_found);
}
} elsif ($method eq 'POST') {
if ($path =~ /^\/users\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
create_user($1, $cgi);
} elsif ($path =~ /^\/verify\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
verify_plan($1, $cgi);
} else {
print_response($cgi, 404, $not_found);
}
} elsif ($method eq 'PUT') {
if ($path =~ /^\/users\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
update_password($1, $cgi);
} elsif ($path =~ /^\/plan\/([^\/]{$minimum_email_length,$maximum_email_length})$/) {
update_plan($1, $cgi);
} else {
print_response($cgi, 404, $not_found);
}
} elsif ($method eq 'DELETE') {
if ($path =~ /^\/token$/) {
delete_token($cgi);
} else {
print_response($cgi, 404, $not_found);
}
2020-07-16 20:48:53 -05:00
} else {
2020-07-17 21:36:12 -05:00
print_response($cgi, 405, $not_allowed);
2020-07-16 20:48:53 -05:00
}
2020-07-17 21:36:12 -05:00
};
if ($@) {
print_json_response($cgi, 500, {error => 'An unexpected error occurred.'});
util_log("ERR $req_id $@");
2020-07-16 20:48:53 -05:00
}
}
##################
# Response Handler
##################
sub print_response {
2020-07-17 21:36:12 -05:00
my ($cgi, $code, $body, $type, $redirect) = @_;
my $req_id = $cgi->param('request_id');
my $path = $cgi->path_info();
my $method = $cgi->request_method();
my $host = $cgi->http('X-Forwarded-For') || $cgi->remote_addr();
util_log("RES($code) $req_id $method $path");
2020-07-16 23:55:59 -05:00
my $header = $resp_header->{$code};
2020-07-16 20:48:53 -05:00
if (!defined $type) {
$type = 'application/json';
}
my $length = length($body);
my $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()));
2020-07-17 21:36:12 -05:00
my $redirect_header = '';
if (defined $redirect) {
$redirect_header = "\nLocation: $redirect";
}
2020-07-16 20:48:53 -05:00
print <<EOF;
2020-07-17 21:36:12 -05:00
HTTP/1.1 $code $header
2020-07-16 20:48:53 -05:00
Server: DotplanApi
Date: $date
Content-Type: $type
2020-07-17 21:36:12 -05:00
Content-Length: $length$redirect_header
2020-07-16 20:48:53 -05:00
EOF
print "\n$body";
}
2020-07-17 21:36:12 -05:00
sub print_json_response {
my ($cgi, $code, $data) = @_;
print_response($cgi, $code, encode_json($data));
}
sub print_html_response {
# TODO: external template
my ($cgi, $code, $content) = @_;
print_response($cgi, $code, <<EOF
<!doctype html>
<html lang='en'>
<head>
<title>Dotplan Online</title>
<meta charset='utf-8'>
</head>
<body>
<p>$content</p>
</body>
</html>
EOF
, 'text/html');
}
2020-07-16 20:48:53 -05:00
####################
# API Implementation
####################
2020-07-16 23:55:59 -05:00
##### POST /users/{email}
2020-07-17 21:36:12 -05:00
sub create_user {
my ($email, $cgi) = @_;
if ($email !~ /^[^\@]+\@[^\@\.]+\.[^\@]+$/) {
print_json_response($cgi, 400, {error => 'Only email addresses of the form {local}@{domain.tld} are supported.'});
} else {
my $user = util_get_user($email);
if (defined $user && $user->{'verified'}) {
print_json_response($cgi, 400, {error => 'User already exists.'});
2020-07-18 15:23:29 -05:00
} elsif (defined $user && defined $user->{'pw_token_expires'} && $user->{'pw_token_expires'} >= time) {
2020-07-17 21:36:12 -05:00
print_json_response($cgi, 429, {error => "Please wait up to $pw_token_expiration_minutes minutes and try again."});
} else {
my $password = util_json_body($cgi)->{'password'};
if (!defined $password || length($password) < $minimum_password_length) {
print_json_response($cgi, 400, {error => "Password must be at least $minimum_password_length characters long."});
} else {
my $query = (defined $user)
? "UPDATE users SET password=?, pw_token=?, pw_token_expires=datetime('now', '+$pw_token_expiration_minutes minutes') WHERE email=?"
: "INSERT INTO users (password, pw_token, pw_token_expires, email) values (?, ?, datetime('now', '+$pw_token_expiration_minutes minutes'), ?)";
my $crypted = util_bcrypt($password);
2020-07-18 15:23:29 -05:00
my $sth = util_get_dbh()->prepare($query);
2020-07-17 21:36:12 -05:00
$sth->execute($crypted, util_token(), $email);
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
2020-07-17 21:36:12 -05:00
# TODO: send email
print_json_response($cgi, 200, {email => $email});
}
}
}
}
2020-07-16 23:55:59 -05:00
##### GET /users/{email}?token={token}
2020-07-17 21:36:12 -05:00
sub validate_email {
my ($email, $cgi) = @_;
my $token = $cgi->param('token');
if (!defined $token) {
2020-07-18 15:23:29 -05:00
print_html_response($cgi, 400, 'No token found in request.');
2020-07-17 21:36:12 -05:00
} else {
my $user = util_get_user($email);
if (!defined $user || $user->{'verified'}) {
2020-07-18 15:23:29 -05:00
print_html_response($cgi, 404, 'User not found.');
2020-07-17 21:36:12 -05:00
} elsif ($user->{'pw_token'} ne $token) {
2020-07-18 15:23:29 -05:00
print_html_response($cgi, 400, 'Bad or expired token.');
2020-07-17 21:36:12 -05:00
} else {
my $sth = util_get_dbh()->prepare('UPDATE users SET verified=1, pw_token=null, pw_token_expires=null WHERE email=?');
$sth->execute($email);
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
print_html_response($cgi, 200, 'Your email address has been verified.');
2020-07-17 21:36:12 -05:00
}
}
}
2020-07-16 23:55:59 -05:00
2020-07-17 21:36:12 -05:00
##### GET /token
sub get_token {
my $cgi = shift;
my $user = util_get_authenticated($cgi);
if (!defined $user) {
print_response($cgi, 401, $not_authorized);
} else {
my $sth = util_get_dbh()->prepare("UPDATE users SET token=?, token_expires=datetime('now', ?) WHERE email=?");
my $token = util_token();
my $expires = $cgi->param('expires');
my $minutes = $auth_token_default_expiration_minutes;
if ($expires =~ /^\d+$/) {
$minutes = int($expires);
if ($minutes <= 0) {
$minutes = $auth_token_default_expiration_minutes;
}
}
$sth->execute($token, "+$minutes minutes", $user->{'email'});
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
2020-07-17 21:36:12 -05:00
print_json_response($cgi, 200, {token => $token});
}
}
2020-07-16 23:55:59 -05:00
2020-07-17 21:36:12 -05:00
##### DELETE /token
sub delete_token {
my $cgi = shift;
my $user = util_get_authenticated($cgi);
if (!defined $user) {
print_response($cgi, 401, $not_authorized);
} else {
my $sth = util_get_dbh()->prepare('UPDATE users SET token=null, token_expires=null WHERE email=?');
$sth->execute($user->{'email'});
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
2020-07-17 21:36:12 -05:00
print_json_response($cgi, 200, {success => 1});
}
}
2020-07-16 23:55:59 -05:00
##### GET /users/{email}/pwtoken
2020-07-17 21:36:12 -05:00
sub get_pwtoken {
my ($email, $cgi) = @_;
my $user = util_get_user($email);
if (!defined $user || !$user->{'verified'}) {
print_html_response($cgi, 404, 'User not found.');
} elsif (defined $user->{'pw_token_expires'} && $user->{'pw_token_expires'} >= time) {
print_html_response($cgi, 429, "Please wait up to $pw_token_expiration_minutes minutes and try again.");
} else {
my $token = util_token();
my $sth = util_get_dbh()->prepare("UPDATE users SET pw_token=?, pw_token_expires=datetime('now', '+10 minutes') WHERE email=?");
$sth->execute($token, $email);
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
2020-07-17 21:36:12 -05:00
# TODO: send email
print_html_response($cgi, 200, 'Check your email and follow the instructions to change your password.');
}
}
2020-07-16 23:55:59 -05:00
##### PUT /users/{email}
2020-07-17 21:36:12 -05:00
sub update_password {
my ($email, $cgi) = @_;
my $user = util_get_user($email);
if (!defined $user || !$user->{'verified'}) {
print_response($cgi, 404, $not_found);
} else {
my $body = util_json_body($cgi);
my $password = $body->{'password'};
my $pwtoken = $body->{'pwtoken'};
if (!defined $pwtoken || !defined $user->{'pw_token'} || !defined $user->{'pw_token_expires'} || $pwtoken ne $user->{'pw_token'} || $user->{'pw_token_expires'} < time) {
print_json_response($cgi, 400, {error => 'Bad or expired token.'});
} elsif (!defined $password || length($password) < $minimum_password_length) {
print_json_response($cgi, 400, {error => "Password must be at least $minimum_password_length characters long."});
} else {
my $crypted = util_bcrypt($password);
2020-07-18 15:23:29 -05:00
my $sth = util_get_dbh()->prepare('UPDATE users SET password=?, pw_token=null, pw_token_expires=null, token=null, token_expires=null WHERE email=?');
2020-07-17 21:36:12 -05:00
$sth->execute($crypted, $email);
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
2020-07-17 21:36:12 -05:00
print_json_response($cgi, 200, {success => 1});
}
}
}
2020-07-16 23:55:59 -05:00
##### PUT /plan/{email}
2020-07-17 21:36:12 -05:00
sub update_plan {
my ($email, $cgi) = @_;
my $user = util_get_user($email);
if (!defined $user || !$user->{'verified'}) {
print_response($cgi, 404, $not_found);
} else {
my $body = util_json_body($cgi);
my $plan = $body->{'plan'};
my $signature = $body->{'signature'};
my $token = $body->{'auth'};
if (!defined $user->{'token'} || !defined $user->{'token_expires'} || !defined $token || $token ne $user->{'token'} || $user->{'token_expires'} < time) {
print_response($cgi, 401, $not_authorized);
} elsif (length($plan) > $maximum_plan_length) {
print_json_response($cgi, 400, {error => "Plan exceeds maximum length of $maximum_plan_length."});
} elsif (length($signature) > $maximum_signature_length) {
print_json_response($cgi, 400, {error => "Signature exceeds maximum length of $maximum_signature_length."});
} else {
util_save_plan($email, $plan, $signature);
print_json_response($cgi, 200, {success => 1});
}
}
}
2020-07-16 23:55:59 -05:00
2020-07-16 20:48:53 -05:00
##### GET /plan/{email}
sub get_plan {
my ($email, $cgi) = @_;
2020-07-18 15:23:29 -05:00
my $format = util_get_response_format($cgi);
2020-07-16 23:55:59 -05:00
my $plan = util_get_plan($email);
2020-07-16 20:48:53 -05:00
2020-07-17 21:36:12 -05:00
if (defined $plan && defined $plan->{'redirect'}) {
# found external plan service, redirect request
print_response($cgi, 301, encode_json({location => $plan->{'redirect'}}), 'application/json', $plan->{'redirect'});
} elsif (defined $plan) {
# found local plan, render response
2020-07-16 23:55:59 -05:00
my $body;
2020-07-18 15:23:29 -05:00
if ($format eq 'application/json') {
2020-07-16 23:55:59 -05:00
$body = encode_json($plan);
2020-07-18 15:23:29 -05:00
} elsif ($format eq 'text/html') {
2020-07-16 23:55:59 -05:00
$body = encode_entities($plan->{'plan'});
2020-07-17 21:36:12 -05:00
$body =~ s/\n/<br>\n/g;
2020-07-16 23:55:59 -05:00
} else {
$body = $plan->{'plan'};
}
2020-07-17 21:36:12 -05:00
print_response($cgi, 200, $body, $format);
2020-07-16 20:48:53 -05:00
} else {
2020-07-18 15:23:29 -05:00
if ($format eq 'application/json') {
print_response($cgi, 404, $not_found);
} elsif ($format eq 'text/html') {
print_html_response($cgi, 404, 'No plan found.');
} else {
print_response($cgi, 404, '', 'text/plain');
}
2020-07-16 20:48:53 -05:00
}
}
2020-07-16 23:55:59 -05:00
##### POST /verify/{email}
sub verify_plan {
my ($email, $cgi) = @_;
my $plan = util_get_plan($email);
if (defined $plan && defined $plan->{'redirect'}) {
# found external plan service, redirect request
print_response($cgi, 308, encode_json({location => $plan->{'redirect'}}), 'application/json', $plan->{'redirect'});
} elsif (defined $plan) {
2020-07-18 15:23:29 -05:00
my $pubkey = util_json_body($cgi)->{'pubkey'};
if (!defined $pubkey || !defined $plan->{'signature'}) {
print_json_response($cgi, 200, {verified => 0});
} elsif (length($pubkey) > $maximum_pubkey_length) {
print_json_response($cgi, 400, {error => "Pubkey exceeds maximum length of $maximum_pubkey_length."});
} else {
my ($keyfh, $keyfile) = tempfile('tmpXXXXXX', TMPDIR => 1);
print $keyfh $pubkey;
close($keyfh);
my $basename = "$plan_dir/" . shell_quote($email);
2020-07-18 15:23:29 -05:00
if(
(IPC::Run::run ['gpg2', '--dearmor'], '<', $keyfile, '>', "$keyfile.gpg", '2>>', '/dev/null') &&
(IPC::Run::run ['gpg2', '--no-default-keyring', '--keyring', "$keyfile.gpg", '--verify', "$basename.asc", "$basename.plan"], '>', '/dev/null', '2>>', '/dev/null')
) {
print_json_response($cgi, 200, {
plan => $plan->{'plan'},
verified => 1
});
2020-07-18 15:23:29 -05:00
} else {
print_json_response($cgi, 200, {verified => 0});
}
}
} else {
print_response($cgi, 404, $not_found);
}
}
2020-07-16 20:48:53 -05:00
2020-07-16 23:55:59 -05:00
###################
# Utility Functions
###################
2020-07-16 20:48:53 -05:00
2020-07-17 21:36:12 -05:00
# get a database connection
my $_dbh = undef;
sub util_get_dbh {
if (!defined $_dbh) {
$_dbh = DBI->connect("DBI:SQLite:dbname=$database", '', '', { RaiseError => 1 }) or die $DBI::errstr;
}
return $_dbh;
}
# print a line to the log
my $_log = undef;
sub util_log {
my $msg = shift;
my $timestamp = strftime("%Y-%m-%d %H:%M:%S", localtime(time()));
if (!defined $_log) {
open($_log, '>>', $log_file);
binmode($_log, ':unix');
}
print $_log "$timestamp $msg\n";
}
2020-07-18 15:23:29 -05:00
sub util_get_response_format {
my $cgi = shift;
my $accept = $cgi->http('Accept');
my $format = lc($cgi->param('format') || $cgi->http('Accept'));
if ($format eq 'json' || $format eq 'application/json') {
return 'application/json';
} elsif ($format eq 'html' || $format eq 'text/html') {
return 'text/html';
}
return 'text/plain';
}
2020-07-17 21:36:12 -05:00
# encrypt a password with a provided or random salt
sub util_bcrypt {
my ($password, $salt) = @_;
if (!defined $salt) {
$salt = util_salt();
}
my $hash = bcrypt_hash({
key_nul => 1,
cost => 8,
salt => $salt
}, $password);
return join('-', $salt, en_base64($hash));
}
# verify a plaintext password against a password hash
sub util_verify_password {
my ($password, $crypted) = @_;
my ($salt) = split(/-/, $crypted);
my $check = util_bcrypt($password, $salt);
return $check eq $crypted;
}
# generate a random salt for bcrypt
sub util_salt {
my $itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
my $salt = '';
$salt .= substr($itoa64,int(rand(64)),1) while length($salt) < 16;
return $salt;
}
# validate authorization header and return user from the database
sub util_get_authenticated {
my $cgi = shift;
my $encoded = $cgi->http('Authorization');
if (!defined $encoded || $encoded !~ /^Basic (\S+)/) {
return undef;
}
$encoded =~ s/^Basic //;
my $auth = undef;
eval {
$auth = decode_base64($encoded);
};
if ($@ || !defined $auth) {
return undef;
}
my ($email, $password) = split(/:/, $auth, 2);
if (!defined $email || !defined $password) {
return undef;
}
my $user = util_get_user($email);
if (!defined $user || !$user->{'verified'}) {
return undef;
}
return util_verify_password($password, $user->{'password'})
? $user
: undef;
}
# generate an authorization token
sub util_token {
my $itoa62 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
my $token = '';
$token .= substr($itoa62,int(rand(62)),1) while length($token) < 24;
return $token;
}
# generate a random request id
sub util_req_id {
my $itoa36 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
my $id = '';
$id .= substr($itoa36,int(rand(36)),1) while length($id) < 8;
return $id;
}
# get a user from the database by email
sub util_get_user {
my $email = shift;
my $sth = util_get_dbh()->prepare("SELECT email, password, token, strftime('%s', token_expires) AS token_expires, pw_token, strftime('%s', pw_token_expires) AS pw_token_expires, verified, strftime('%s', created) AS created, strftime('%s', updated) AS updated FROM users WHERE email=?");
$sth->execute($email);
2020-07-18 15:23:29 -05:00
die $sth->errstr if $sth->err;
my $user = $sth->fetchrow_hashref;
return (keys %$user > 0) ? $user : undef;
2020-07-17 21:36:12 -05:00
}
# save a plan by email
my $_plancache = {};
sub util_save_plan {
my ($email, $plan, $signature) = @_;
my $basename = "$plan_dir/" . shell_quote($email);
if (defined $plan) {
open(my $plan_file, '>', "$basename.plan");
flock($plan_file, LOCK_EX);
print $plan_file $plan;
close($plan_file);
} elsif (-f "$basename.plan") {
unlink "$basename.plan";
}
if (defined $plan && defined $signature) {
2020-07-18 15:23:29 -05:00
open(my $sig_file, '>', "$basename.asc");
2020-07-17 21:36:12 -05:00
flock($sig_file, LOCK_EX);
2020-07-18 15:23:29 -05:00
print $sig_file $signature;
2020-07-17 21:36:12 -05:00
close($sig_file);
2020-07-18 15:23:29 -05:00
} elsif (-f "$basename.asc") {
unlink "$basename.asc";
2020-07-17 21:36:12 -05:00
}
# invalidate cache
delete $_plancache->{$email} if $_plancache->{$email};
}
# read a plan from cache or disk
sub util_read_plan {
my $email = shift;
if (!defined $_plancache->{$email}) {
my $basename = "$plan_dir/" . shell_quote($email);
if (-f "$basename.plan") {
my $details = {};
open(my $plan_file, '<', "$basename.plan");
flock($plan_file, LOCK_SH);
local $/;
$details->{'plan'} = <$plan_file>;
close($plan_file);
2020-07-18 15:23:29 -05:00
if (-f "$basename.asc") {
open(my $sig_file, '<', "$basename.asc");
2020-07-17 21:36:12 -05:00
flock($sig_file, LOCK_SH);
local $/;
$details->{'signature'} = <$sig_file>;
close($sig_file);
}
$_plancache->{$email} = $details;
}
}
return $_plancache->{$email};
}
# retrieve a plan by email
my $_dns = new Net::DNS::Resolver();
2020-07-16 23:55:59 -05:00
sub util_get_plan {
my $email = shift;
2020-07-17 21:36:12 -05:00
my ($local, $domain) = split(/\@/, $email, 2);
if (!$localdomains->{$domain}) {
my $reply = $_dns->query("_dotplan._tcp.$domain", 'SRV');
if (defined $reply && $reply->answer > 0) {
my @answer = $reply->answer;
my ($pri, $wgt, $port, $svchost) = split(/\s+/, $answer[0]->rdstring, 4);
$svchost =~ s/\.$//;
my $encoded = uri_escape($email);
if ($hostname ne $svchost) {
return {
redirect => $port == 80
? "http://$svchost/$encoded"
: $port == 443
? "https://$svchost/$encoded"
: "https://$svchost:$port/$encoded"
};
} else {
return util_read_plan($email);
}
} else {
return util_read_plan($email);
}
} else {
return util_read_plan($email);
}
}
# decode json post data to an object
sub util_json_body {
my $cgi = shift;
my $json = $cgi->param('POSTDATA') || $cgi->param('PUTDATA');
return decode_json($json);
}
2020-07-16 20:48:53 -05:00
}
# only supports one optional argument -d to daemonize
2020-07-18 15:23:29 -05:00
my $daemonize = $ARGV[0] eq '-d' if @ARGV == 1;
2020-07-17 21:36:12 -05:00
# start server and fork process as current user
my ($user, $passwd, $uid, $gid) = getpwuid $<;
my $group = getgrgid $gid;
if ($daemonize) {
DotplanApi->new($server_port)->background(
pid_file => $pid_file,
user => $user,
group => $group
);
} else {
DotplanApi->new($server_port)->run(
pid_file => $pid_file,
user => $user,
group => $group
);
}