Author: jfs
Date: Sun Apr 17 15:17:06 2016
New Revision: 11108
URL: http://svn.debian.org/wsvn/?sc=1&rev=11108
Log:
- Use CGI.pm instead of the Perl4 code. This makes it easier to run the script
throught the command line and handles all the URL encoding stuff
- Use CGI::Cache to cache the contents of some queries in a temporary location.
Since this module is not package in Debian we need to source it from a
location which is currently /srv/manpages.debian.org/lib
Modified:
man-cgi/man.cgi
Modified: man-cgi/man.cgi
URL: http://svn.debian.org/wsvn/man-cgi/man.cgi?rev=11108&op=diff
==============================================================================
--- man-cgi/man.cgi (original)
+++ man-cgi/man.cgi Sun Apr 17 15:17:06 2016
@@ -40,9 +40,13 @@
# !!! man.cgi is stale perl4 code !!!
############################################################################
+use lib '/srv/manpages.debian.org/lib';
use File::stat;
use Time::localtime;
use Error qw(:try);
+
+use CGI qw/ :standard -debug /;
+use CGI::Cache;
$www{'title'} = 'Debian Hypertext Man Pages';
$www{'home'} = 'http://manpages.debian.org';
@@ -69,7 +73,6 @@
'', '',
'All', '',
'0', '',
-
'1', '1',
'1c', '1',
'1C', '1',
@@ -124,8 +127,9 @@
'n', 'n - New Commands',
);
-$manLocalDir = '/srv/manpages.debian.org/extractor/manpages-dists';
-$manFilesDir = '/srv/manpages.debian.org/extractor/manpages-files';
+$baseDir = '/srv/manpages.debian.org';
+$manLocalDir = $baseDir.'/extractor/manpages-dists';
+$manFilesDir = $baseDir.'/extractor/manpages-files';
#$manPathDefault = 'Debian Sid';
# DEFAULT manual pages - review for each release
$manPathDefault = 'Debian 8 jessie';
@@ -285,17 +289,52 @@
$webmasterDesc = 'the service administrator';
#$manstat = 'http://www.de.freebsd.org/de/stat/man';
+# Set up CGI cache
+CGI::Cache::setup();
+# Set up a cache in /manpages_cache/man-cgi, with publicly
+# unreadable cache entries, a maximum size of 10 megabytes,
+# and a time-to-live of 24 hours.
+CGI::Cache::setup( { cache_options =>
+ { cache_root => $baseDir.'/manpages_cache',
+ namespace => 'man_cgi',
+ directory_umask => 077,
+ max_size => 10 * 1024 * 1024,
+ default_expires_in => '24 hours',
+ }
+ } );
+# CGI::Vars requires CGI version 2.50 or better
+# TODO: set key based on other man variables
+$cgiquery = new CGI;
+CGI::Cache::set_key( $cgiquery->Vars );
+CGI::Cache::invalidate_cache_entry() if $cgiquery->param( 'force_regenerate' )
eq 'true';
+
&secure_env;
# CGI Interface -- runs at load time
-&do_man(&env('SCRIPT_NAME'), &env('PATH_INFO'), &env('QUERY_STRING'))
- unless defined($main'plexus_configured);
+&do_man();
$enable_include_links = 0;
-# Plexus Native Interface
+# Query the manapge
sub do_man {
- local($BASE, $path, $form) = @_;
- local($_, %form, $query, $proto, $name, $section, $apropos);
+ local($_, $query, $name, $section, $apropos, $package, $version);
+
+ local $BASE = $cgiquery->script_name();
+ local $path = $cgiquery->url();
+ local $format = $cgiquery->param('format') || 'html';
+ local $name = $cgiquery->param('query');
+ $name = clean_input($name);
+ local $section = $cgiquery->param('sektion') || '';
+ local $apropos = $cgiquery->param('apropos');
+ local $alttitle = $cgiquery->param('title');
+ local $manpath = $cgiquery->param('manpath');
+ local $locale = $cgiquery->param('locale') || 'en';
+ # Debian-specific, provide a package and version
+ local $package = $cgiquery->param('package');
+ local $version = $cgiquery->param('version');
+
+ print "DEBUG: Query string is '".$cgiquery->query_string()."'\n" if $debug;
+ print "DEBUG: Manpage name is '$name'\n" if $debug;
+ print "DEBUG: Manpage section is '$section'\n" if $debug;
# spinner is buggy, shit
local($u) = $www{'home'}.'/cgi-bin/man.cgi';
@@ -309,26 +348,18 @@
return &include_output($path)
if ($enable_include_links && $path =~ m%^/usr/include/% && -f $path);
- return &indexpage if ($form eq "");
-
- &decode_form($form, *form, 0);
-
- $format = $form{'format'};
+ return &indexpage if ($cgiquery->query_string() eq "");
+
$format = 'html' if $format !~ /^(ps|pdf|ascii|latin1|dvi|troff)$/;
- local($fform) = &dec($form);
- if ($fform =~ m%^([\w\_\-\:\+\.]+)$%) {
- return &man($1, '');
- } elsif ($fform =~ m%^([\w\_\-\:\+\.]+)\(([0-9a-zA-Z]+)\)$%) {
- return &man($1, $2);
- }
-
- $name = $query = clean_input($form{'query'});
- $section = $form{'sektion'};
- $apropos = $form{'apropos'};
- $alttitle = $form{'title'};
- $manpath = $form{'manpath'};
- $locale = $form{'locale'};
+# TODO - review
+# local($fform) = &dec($form);
+# if ($fform =~ m%^([\w\_\-\:\+\.]+)$%) {
+# return &man($1, '');
+# } elsif ($fform =~ m%^([\w\_\-\:\+\.]+)\(([0-9a-zA-Z]+)\)$%) {
+# return &man($1, $2);
+# }
+
$locale = '' if $locale eq 'en' or $locale eq 'C'; # Default locale
$encoding = '' ; # No encoding
if (!$manpath) {
@@ -341,22 +372,18 @@
$manpath = $manPathDefault;
}
}
- # Debian-specific, provide a package and version
- $package = $form{'package'};
- $version = $form{'version'};
-
- # download a man hierarchie as gzip'd tar file
+
+ # download a man hierarchy as gzip'd tar file
return &download if ($apropos > 1);
# empty query
- return &indexpage if ($manpath && $form !~ /query=/);
+ return &indexpage if ($manpath && $name eq '');
$section = "" if $section eq "ALL" || $section eq '';
- if (!$apropos && $query =~ m/^(.*)\(([^\)]*)\)/) {
+ if (!$apropos && $name =~ m/^(.*)\(([^\)]*)\)/) {
$name = $1; $section = $2;
}
-
$apropos ? &apropos($query) : &man($name, $section);
}
@@ -379,7 +406,7 @@
}
sub detailed_information {
- local($file) = '/srv/manpages.debian.org/www/README.txt';
+ local($file) = $baseDir.'/www/README.txt';
$file = $0 if ! -f $file;
open(R, $file) || &mydie("open $file: $!\n");
@@ -423,11 +450,7 @@
sub http_header {
local($content_type) = @_;
- if (defined($main'plexus_configured)) {
- &main'MIME_header('ok', $content_type);
- } else {
- print "Content-type: $content_type\n\n";
- }
+ print "Content-type: $content_type\n\n";
}
sub env { defined($main'ENV{$_[0]}) ? $main'ENV{$_[0]} : undef; }
@@ -444,6 +467,8 @@
local($_, $title, $head, *APROPOS);
local($names, $section, $msg, $key);
local($prefix);
+
+ CGI::Cache::start() or exit;
$prefix = "Apropos ";
if ($alttitle) {
@@ -508,6 +533,8 @@
}
print "</DL>\n";
print &html_footer();
+
+ CGI::Cache::stop();
}
sub man {
@@ -517,6 +544,7 @@
local(@manargs);
local($query) = $name;
local($output_lines) = 0;
+
# $section =~ s/^([0-9ln]).*$/$1/;
$section =~ tr/A-Z/a-z/;
@@ -559,6 +587,8 @@
# Find out our charset
$charset = $1;
}
+
+ CGI::Cache::start() or exit;
if ($format eq "html") {
$header="text/html";
@@ -672,12 +702,20 @@
push(@manargs, '-t');
}
- print "X $command{'man'} @manargs -- $section $name x\n" if $debug;
- #die "Section $section is tainted\n" if is_tainted($section);
- printenv() if $debug > 1;
- print "X Calling $command{'man'} ".join(" ",@manargs)." for $name
($section)\n" if $debug;
- &proc(*MAN, $command{'man'}, @manargs, "--", $section, $name) ||
- &mydie ("$0: open of $command{'man'} command failed: $!\n");
+ if ( $section ) {
+ print "X $command{'man'} @manargs -- $section $name x\n" if $debug;
+#die "Section $section is tainted\n" if is_tainted($section);
+ printenv() if $debug > 1;
+ print "X Calling $command{'man'} ".join(" ",@manargs)." for $name
($section)\n" if $debug;
+ &proc(*MAN, $command{'man'}, @manargs, "--", $section, $name) ||
+ &mydie ("$0: open of $command{'man'} command failed: $!\n");
+ } else {
+ print "X $command{'man'} @manargs -- $name x\n" if $debug;
+ printenv() if $debug > 1;
+ print "X Calling $command{'man'} ".join(" ",@manargs)." for $name
(no section)\n" if $debug;
+ &proc(*MAN, $command{'man'}, @manargs, "--", $name) ||
+ &mydie ("$0: open of $command{'man'} command failed: $!\n");
+ }
if ($format ne "html") {
if ($format eq "latin1" || $format eq "ascii") {
@@ -799,6 +837,8 @@
}
print &html_footer();
+
+ CGI::Cache::stop();
# Sleep 0.35 seconds to avoid DoS attacs
select undef, undef, undef, 0.35;
@@ -1460,10 +1500,10 @@
<ul>
};
if ( $type eq 'apropos' ) {
- $text = $text. "<li>The keyword cannot be found in any manpage
name or title."
+ $text = $text. "<li>The keyword cannot be found in any manpage
name or title.</li>\n"
}
if ( $type eq 'section' ) {
- $text = $text. "<li>The manpage does not exist in the archive."
+ $text = $text. "<li>The manpage does not exist in the
archive.</li>\n"
}
if ( $section != 0 ) {
$text = $text. "<li>The manpage exists but not in the section
you selected. Try searching in 'All sections'.</li>\n";
@@ -1529,7 +1569,7 @@
# Manpage names can only contain alphanumerical
# characters and a limited number of special characters
- $input =~ s/[^A-Za-z0-9 :_\+\-\.]//;
+ $input =~ s/[^A-Za-z0-9 :_\+\-\.\(\)]//;
return $input;
}
