view.cgi
use strict;
use CGI::Carp qw(fatalsToBrowser);
use HTML::Template;
use Text::Highlight;
my $tmpl_path = "view.tmpl";
my %file_types = (
pl => 'Perl',
pm => 'Perl',
cgi => 'Perl',
tmpl => 'HTML',
);
my $allowed_path = q!^\w[\w\/]+\.(! . join('|', keys %file_types) . q!)$!;
my $base_path = "./";
sub is_allowed_path($) {
my $fpath = shift;
return ($fpath && $fpath =~ /$allowed_path/);
}
sub get_file_type($) {
my $fpath = shift;
my $ftype = undef;
if ($fpath && $fpath =~ /\.([^.]+?)$/) {
my $ext = lc($1);
$ftype = $file_types{$ext} if exists $file_types{$ext};
}
return $ftype;
}
sub load_source_file($$) {
my ($fpath, $ftype) = @_;
open IN, $fpath or return undef;
my $content = join "", <IN>;
close IN;
my $th = Text::Highlight->new(wrapper => "%s");
return $th->highlight($ftype, $content);
}
{
my $tmpl = HTML::Template->new(filename => $tmpl_path);
my $fname = $ENV{'QUERY_STRING'};
my $fpath = "$base_path$fname";
my $ftype = get_file_type($fpath);
if (is_allowed_path($fname) && -r $fpath && $ftype) {
$tmpl->param(
FILENAME => $fname,
FILEPATH => $fpath,
FILETYPE => $ftype,
CODE => load_source_file($fpath, $ftype) || "",
);
}
my $output = $tmpl->output() || "Template Output Error";
print "Content-Type: text/html\n";
print "Content-Length: " . length($output) . "\n\n";
print $output;
}
__END__
view.cgi を開く