141 lines
3.7 KiB
Perl
Executable File
141 lines
3.7 KiB
Perl
Executable File
#!/usr/bin/perl -w -I.
|
|
|
|
use strict;
|
|
use Data::Dumper;
|
|
use HTML::Template;
|
|
use URI::Escape;
|
|
use JSON;
|
|
use RSSTootalizer::User;
|
|
|
|
our %FORM;
|
|
our $CURRENTUSER;
|
|
|
|
our $config = "";
|
|
open CONFIG, "rsstootalizer.conf.json" or die "Cannot open rsstootalizer.conf.json";
|
|
{
|
|
local $/ = undef;
|
|
$config = <CONFIG>;
|
|
}
|
|
close CONFIG;
|
|
$config = decode_json($config);
|
|
|
|
sub Error {{{
|
|
my $errorheadline = shift;
|
|
my $errormessage = shift;
|
|
$errormessage .= "\nStack Trace:\n";
|
|
|
|
my $i=0;
|
|
while ((my @call_details = (caller($i++))) ){
|
|
$errormessage .= $call_details[1].":".$call_details[2]." in function ".$call_details[3]."\n";
|
|
}
|
|
|
|
my $output;
|
|
if ($FORM{"mode"} eq "JSON"){
|
|
$output = HTML::Template->new(filename => "error.json", path => "static/templates", die_on_bad_params=>0);
|
|
print "Content-Type: text/plain;charset=utf8\n\n";
|
|
$errormessage =~ s/\n/\\n/g;
|
|
} else {
|
|
$output = HTML::Template->new(filename => "Error.html", path => "static/templates", die_on_bad_params=>0);
|
|
print "Content-Type: text/html;charset=utf8\n\n";
|
|
}
|
|
$output->param(status => $errorheadline, msg => $errormessage);
|
|
|
|
print $output->output();
|
|
|
|
exit(1);
|
|
}}}
|
|
sub populateAddToFORM {{{
|
|
my $key = shift;
|
|
my $value = shift;
|
|
return unless defined($value);
|
|
$key =~ s/\+/ /g;
|
|
$key = uri_unescape($key);
|
|
$key =~ s/\[\]$//;
|
|
$value =~ s/\+/ /g;
|
|
$value = uri_unescape($value);
|
|
if (exists($FORM{$key}) && $key ne "mode"){
|
|
if (ref($FORM{$key}) ne 'ARRAY'){
|
|
my $x = $FORM{$key};
|
|
delete $FORM{$key};
|
|
@{$FORM{$key}} = ($x);
|
|
}
|
|
push @{$FORM{$key}}, $value;
|
|
} else {
|
|
$FORM{$key} = $value;
|
|
}
|
|
}}}
|
|
sub populateGetFields {{{
|
|
my $tmpStr = "";
|
|
if (defined($ENV{'QUERY_STRING'})){
|
|
$tmpStr = "".$ENV{"QUERY_STRING"};
|
|
}
|
|
my @parts = split(/\&/, $tmpStr);
|
|
foreach my $part (@parts) {
|
|
my ($key, $value) = split(/\=/, $part);
|
|
&populateAddToFORM($key, $value);
|
|
}
|
|
}}}
|
|
sub populatePostFields {{{
|
|
return unless (exists($ENV{"CONTENT_LENGTH"}));
|
|
my $tmpStr;
|
|
read(STDIN, $tmpStr, $ENV{"CONTENT_LENGTH"});
|
|
my @parts = split( /\&/, $tmpStr );
|
|
foreach my $part (@parts) {
|
|
my ($key, $value) = split( /\=/, $part );
|
|
&populateAddToFORM($key, $value);
|
|
}
|
|
}}}
|
|
sub populateCookieFields {{{
|
|
my $tmpStr = "";
|
|
if (defined($ENV{'HTTP_COOKIE'})){
|
|
$tmpStr = "".$ENV{"HTTP_COOKIE"};
|
|
}
|
|
my @parts = split(/;/, $tmpStr);
|
|
foreach my $part (@parts) {
|
|
my ($key, $value) = split(/\=/, $part);
|
|
$key =~ s/^ //;
|
|
&populateAddToFORM($key, $value);
|
|
}
|
|
}}}
|
|
sub CheckCredentials {
|
|
$CURRENTUSER = RSSTootalizer::User->authenticate();
|
|
if ($CURRENTUSER){
|
|
return 1;
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
$FORM{"mode"} = "Login";
|
|
&populateGetFields();
|
|
&populatePostFields();
|
|
&populateCookieFields();
|
|
|
|
# Force Unicode output
|
|
binmode STDERR, ":utf8";
|
|
binmode STDOUT, ":utf8";
|
|
|
|
my $object;
|
|
|
|
# TODO: This is a very bad solution but not as bad as an uncontrolled eval...
|
|
# The @main::modules array holds a list of all permissible values of the $main::FORM{"mode"} variable.
|
|
# If the value is not in this array, the request is not processed and an error is displayed.
|
|
my @modules = ("Login", "Logout", "OAuthLogin", "Dashboard", "Callback", "EditFeed", "About");
|
|
|
|
if (! grep {$_ eq $FORM{mode}} @modules) {
|
|
Error("Validation Error", "$FORM{mode} is not a valid module");
|
|
}
|
|
|
|
my $x = "RSSTootalizer::Website::$FORM{mode}";
|
|
eval "use $x; 1" || Error("Parse Error", "Could not include $x: $@");
|
|
eval { $object=$x->new(); } || Error("Functional Error", "This function is not implemented yet ('".$FORM{mode}."').");
|
|
if ($object->requires_authentication()) { # Mode requires user to be logged in?
|
|
unless (CheckCredentials()) {
|
|
$x = "RSSTootalizer::Website::Login";
|
|
eval "use $x; 1" || Error("Parse Error", "Could not include $x: $@");
|
|
eval { $object=$x->new(); } || Error("Functional Error", "This function is not implemented yet ('".$FORM{mode}."').");
|
|
}
|
|
}
|
|
|
|
$object->render();
|