#!/usr/bin/perl
use strict;
use CGI::Fast;
use Template;
use Text::Textile;
use HTML::Entities;
use POSIX;
use constant {
CRLF => "\x0D\x0A",
};
my %config = (
include => '/home/aphrael/htdocs/inc',
data => '/home/aphrael/htdocs/',
);
my $tmpl = Template->new(
INCLUDE_PATH => $config{include},
ANYCASE => 1,
INTERPOLATE => 1,
);
my $textile = Text::Textile->new(
flavor => 'html',
charset => 'utf-8',
);
sub strftime {
my ($format, $time) = @_;
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
return POSIX::strftime($format, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
}
sub error {
my ($error) = @_;
print $error;
}
while (my $cgi = CGI::Fast->new()) {
my $page = $cgi->param('page');
my $env = $cgi->param('env');
my $source = $cgi->param('source');
my ($text, $title, $content);
my $src;
if (!defined($page) && !defined($source) && !defined($env)) {
$page = 'news';
} elsif (!defined($page) && defined($source)) {
$page = $cgi->param('source');
$src = 1;
} elsif (!defined($page) && defined($env)) {
$page = 'env';
}
if (defined($page)) {
$page =~ s/(?:\.\.|~)/./; # prevent path-based exploits.
print "Content-Type: text/html; charset=UTF-8".CRLF.CRLF;
if ($page eq 'env') {
$title = "Environment Variables";
$content = "<table>\n";
foreach my $i (keys %ENV) {
$content .= "<tr><td>$i</td><td>$ENV{$i}</td></tr>\n";
}
$content .= "</table>\n";
$tmpl->process('base.tmpl', { title => $title, content => $content, lastmod => strftime('%F', time) }) or error($tmpl->error);
} elsif ($src) {
open SRC, '<', "$config{data}/$page" or error("Cannot open $page: $!");
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat(SRC);
local $/;
$text = <SRC>;
close SRC;
$text =~ s/\t/ /g;
$text = encode_entities($text, qq{<>&'"});
$text = "<pre>".$text."</pre>";
$title = $page;
$tmpl->process('base.tmpl', { title => $title, content => $text, lastmod => strftime("%F", $mtime) } ) or error($tmpl->error);
} else {
open TEXT, '<', "$config{data}/$page.textile" or error("Cannot open $page.textile: $!");
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat(TEXT);
$title = <TEXT>;
local $/;
$text = <TEXT>;
close TEXT;
$title =~ s/^title: //;
$content = $textile->process($text);
$tmpl->process('base.tmpl', { title => $title, content => $content, lastmod => strftime('%F', $mtime) } ) or error($tmpl->error);
}
}
}