r11110 - /man-cgi/man.cgi
Author: jfs
Date: Sun Apr 17 15:47:21 2016
New Revision: 11110
URL: http://svn.debian.org/wsvn/?sc=1&rev=11110
Log:
- Make it possible to enable/disable the cache in the script.
- Before the cache is enabled make sure that the module can be loaded and that the cache directory
exists. If the pre-conditions are matched then load and enable cache
- Define the input to all functions
Modified:
man-cgi/man.cgi
Modified: man-cgi/man.cgi
URL: http://svn.debian.org/wsvn/man-cgi/man.cgi?rev=11110&op=diff
==============================================================================
--- man-cgi/man.cgi (original)
+++ man-cgi/man.cgi Sun Apr 17 15:47:21 2016
@@ -41,20 +41,49 @@
############################################################################
use lib '/srv/manpages.debian.org/lib';
+
+# Basic modules
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';
$www{'head'} = qq[<IMG height=61 width=60 SRC="http://www.debian.org/logos/openlogo-nd-50.png"; Alt="[Debian Logo]"><img src="http://www.debian.org/Pics/debian.png"; width="179" height="61" alt="Debian project">] .
"";
+# Main directories with the manpages and the files
+$baseDir = '/srv/manpages.debian.org';
+$manLocalDir = $baseDir.'/extractor/manpages-dists';
+$manFilesDir = $baseDir.'/extractor/manpages-files';
+
# Set this to 1 (or above) to debug the CGI script
$debug = 0;
+
+# Set this to 0 to not cache content locally
+$cache = 1;
+
+# Cache configuration (if possible)
+$cache_root = $baseDir.'/manpages_cache';
+if (! -e $cache_root ) {
+ $cache = 0;
+ print "DEBUG: CGI::Cache module requested, but cache will be disabled as $cache_root is not readable\n" if $debug;
+}
+if ($cache) {
+ $module_test = eval {
+ require CGI::Cache;
+ CGI::Cache->import();
+ 1;
+ };
+ if(! $module_test) {
+ # Cannot find CGI::Cache, disable cache
+ $cache = 0;
+ print "DEBUG: Could not load CGI::Cache module, missing library\n" if $debug;
+ } else {
+ print "DEBUG: CGI::Cache module loaded\n" if $debug;
+ }
+}
#$command{'man'} = 'man'; # 8Bit clean man
#$command{'man'} = '/home/wosch/bin/cgi-man'; # 8Bit clean man
@@ -127,9 +156,6 @@
'n', 'n - New Commands',
);
-$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';
@@ -289,24 +315,26 @@
$webmasterDesc = 'the service administrator';
#$manstat = 'http://www.de.freebsd.org/de/stat/man';
+$cgiquery = new CGI;
# Set up CGI cache
-CGI::Cache::setup();
+if ($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::Cache::setup( { cache_options =>
+ { cache_root => $cache_root,
+ 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';
+ 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
@@ -315,7 +343,7 @@
$enable_include_links = 0;
# Query the manapge
-sub do_man {
+sub do_man ($$$$$$$) {
local($_, $query, $name, $section, $apropos, $package, $version);
local $BASE = $cgiquery->script_name();
@@ -389,13 +417,13 @@
# --------------------- support routines ------------------------
-sub debug {
+sub debug () {
print header (-type=>'text/plain');
print @_,"\n----------\n\n\n";
}
-sub get_the_sources {
- local($file) = '/usr/lib/cgi-bin/man.cgi';
+sub get_the_sources () {
+ local($file) = $baseDir.'/cgi-bin/man.cgi';
$file = $0 if ! -f $file;
open(R, $file) || &mydie("open $file: $!\n");
@@ -405,7 +433,7 @@
exit;
}
-sub detailed_information {
+sub detailed_information () {
local($file) = $baseDir.'/www/README.txt';
$file = $0 if ! -f $file;
@@ -453,7 +481,7 @@
print header (-type=> "$content_type", -expires=> "$expiration");
}
-sub env { defined($main'ENV{$_[0]}) ? $main'ENV{$_[0]} : undef; }
+sub env () { defined($main'ENV{$_[0]}) ? $main'ENV{$_[0]} : undef; }
sub printenv () {
# Print the environment, useful for debugging
@@ -468,7 +496,9 @@
local($names, $section, $msg, $key);
local($prefix);
- CGI::Cache::start() or exit;
+ if ($cache) {
+ CGI::Cache::start() or exit;
+ }
$prefix = "Apropos ";
if ($alttitle) {
@@ -535,10 +565,10 @@
print "</DL>\n";
print &html_footer();
- CGI::Cache::stop();
-}
-
-sub man {
+ CGI::Cache::stop() if $cache;
+}
+
+sub man ($$) {
local($name, $section) = @_;
local($_, $title, $head, *MAN);
local($html_name, $html_section, $prefix);
@@ -589,7 +619,9 @@
$charset = $1;
}
- CGI::Cache::start() or exit;
+ if ($cache) {
+ CGI::Cache::start() or exit;
+ }
if ($format eq "html") {
$header="text/html";
@@ -837,7 +869,7 @@
print &html_footer();
- CGI::Cache::stop();
+ CGI::Cache::stop() if $cache;
# Sleep 0.35 seconds to avoid DoS attacs
select undef, undef, undef, 0.35;
@@ -865,7 +897,7 @@
$ENV{'GROFF_TMAC_PATH'} = join(':', @groff_path, '/usr/share/tmac');
}
-sub mlnk {
+sub mlnk ($) {
local($matched) = @_;
local($link, $section);
($link = $matched) =~ s/[\s]+//g;
@@ -882,7 +914,7 @@
return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
}
-sub proc {
+sub proc ($$$) {
local(*FH, $prog, @args) = @_;
local($pid) = open(FH, "-|");
return undef unless defined($pid);
@@ -926,7 +958,7 @@
# formatting the data nicely when you are emailing it.
# This is derived from code by Denis Howe <dbh@doc.ic.ac.uk>
# and Thomas A Fine <fine@cis.ohio-state.edu>
-sub decode_form {
+sub decode_form ($$$$$) {
local($form, *data, $indent, $key, $_) = @_;
foreach $_ (split(/&/, $form)) {
($key, $_) = split(/=/, $_, 2);
@@ -942,7 +974,7 @@
# block cross-site scripting attacks (css)
sub escape($) { $_ = $_[0]; s/&/&/g; s/</</g; s/>/>/g; $_; }
-sub dec {
+sub dec ($) {
local($_) = @_;
s/\+/ /g; # '+' -> space
@@ -955,13 +987,13 @@
# Splits up a query request, returns an array of items.
# usage: @items = &main'splitquery($query);
#
-sub splitquery {
+sub splitquery ($) {
local($query) = @_;
grep((s/%([\da-f]{1,2})/pack(C,hex($1))/eig, 1), split(/\+/, $query));
}
# encode unknown data for use in a URL <A HREF="...">
-sub encode_url {
+sub encode_url ($) {
local($_) = @_;
# rfc1738 says that ";"|"/"|"?"|":"|"@"|"&"|"=" may be reserved.
# And % is the escape character so we escape it along with
@@ -973,14 +1005,14 @@
$_;
}
# encode unknown data for use in <TITLE>...</TITILE>
-sub encode_title {
+sub encode_title ($) {
# like encode_url but less strict (I couldn't find docs on this)
local($_) = @_;
s/([\000-\031\%\&\<\>\177-\377])/sprintf('%%%02x',ord($1))/eg;
$_;
}
# encode unknown data for use inside markup attributes <MARKUP ATTR="...">
-sub encode_attribute {
+sub encode_attribute ($) {
# rfc1738 says to use entity references here
local($_) = @_;
s/([\000-\031\"\'\`\%\&\<\>\177-\377])/sprintf('\&#%03d;',ord($1))/eg;
@@ -988,7 +1020,7 @@
}
# encode unknown text data for using as HTML,
# treats ^H as overstrike ala nroff.
-sub encode_data {
+sub encode_data ($) {
local($_) = @_;
local($str);
@@ -1023,7 +1055,7 @@
}
-sub available_translations {
+sub available_translations ($$) {
# Print translations available for a given manual page
local($name, $section) = @_;
print "X Checking available translations (name: $name, section: $section)\n" if $debug;
@@ -1053,7 +1085,7 @@
return $found;
}
-sub indexpage {
+sub indexpage () {
&http_header("text/html", "+7d");
print &html_header("$www{'title'}: Index Page") .
"<H1>$www{'head'}</H1>\n\n" . &intro;
@@ -1098,14 +1130,14 @@
0;
}
-sub is_empty {
+sub is_empty () {
my $ret = 0;
my $file = $manLocalDir."/timestamp";
return 1 if ! -e $file;
return $ret;
}
-sub is_out_of_date {
+sub is_out_of_date () {
my $ret = 0;
my $file = $manLocalDir."/timestamp";
return 1 if ! -e $file;
@@ -1116,7 +1148,7 @@
}
-sub no_content {
+sub no_content () {
print <<ETX;
<p><STRONG><font color="#FF0000">NOTE:</font></STRONG> This service is
currently not working as there are no manpages available in the server.
@@ -1132,7 +1164,7 @@
}
-sub out_of_date {
+sub out_of_date () {
print <<ETX;
<p><STRONG><font color="#FF0000">NOTE:</font></STRONG> The content
used by this service is currently out of date. As a consequence newer Debian
@@ -1145,7 +1177,7 @@
}
-sub formquery {
+sub formquery () {
local($astring, $bstring);
if (!$apropos) {
$astring = " CHECKED";
@@ -1239,7 +1271,7 @@
}
# TODO: This should be an include file
-sub copyright {
+sub copyright () {
return qq{\
<PRE>
Copyright (c) 1996-2007 <a href="$authorURL">Wolfram Schneider</A>
@@ -1259,7 +1291,7 @@
};
}
-sub faq {
+sub faq () {
local(@list, @list2);
local($url);
@@ -1323,7 +1355,7 @@
}
-sub intro {
+sub intro () {
return qq{\
<P>
<I>Man Page Lookup</I> searches for man pages name and section as
@@ -1338,7 +1370,7 @@
};
}
-sub info {
+sub info () {
return qq{\
<H1>Information on this service</H1>
<p>The man-cgi interface used by manpages.debian.org is derived from the
@@ -1424,7 +1456,7 @@
};
}
-sub copyright_output {
+sub copyright_output () {
&http_header("text/html", "+7d");
print &html_header("HTML hypertext Debian man page interface") .
"<H1>$www{'head'}</H1>\n" . ©right . qq{\
@@ -1435,7 +1467,7 @@
print &html_footer();
}
-sub faq_output {
+sub faq_output () {
&http_header("text/html", "+7d");
print &html_header("HTML hypertext Debian man page interface") .
"<H1>$www{'head'}</H1>\n" . &faq . qq{\
@@ -1446,7 +1478,7 @@
print &html_footer();
}
-sub info_output {
+sub info_output () {
&http_header("text/html", "+7d");
print &html_header("HTML hypertext Debian man page interface") . &info . qq{\
<HR>
@@ -1457,7 +1489,7 @@
}
-sub html_header {
+sub html_header () {
my $header="";
$header = qq{<HTML>
<HEAD>
@@ -1483,7 +1515,7 @@
return $header;
}
-sub not_found {
+sub not_found ($$$$) {
local($type, $section, $locale, $query) = @_;
my $text ="";
@@ -1529,7 +1561,7 @@
return $text;
}
-sub html_footer {
+sub html_footer () {
my $footer ="";
$footer = qq{
<br>
@@ -1538,7 +1570,7 @@
return $footer;
}
-sub secure_env {
+sub secure_env () {
$main'ENV{'PATH'} = '/bin:/usr/bin';
$main'ENV{'MANPATH'} = $manPath{$manPathDefault};
$main'ENV{'IFS'} = " \t\n";
@@ -1550,7 +1582,7 @@
undef $main'ENV{'DISPLAY'};
}
-sub include_output {
+sub include_output ($) {
local($inc) = @_;
&http_header("text/plain", "+1d");
@@ -1559,7 +1591,7 @@
close(I);
}
-sub clean_input {
+sub clean_input ($) {
local($input) = @_;
# remove trailing spaces for dumb users
Reply to: