man.cgi

jfs Sun, 17 Apr 2016 09:03:24 -0700

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 <d...@doc.ic.ac.uk>
 # and Thomas A Fine <f...@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/&/&amp;/g; s/</&lt;/g; s/>/&gt;/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" . &copyright . 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

r11110 - /man-cgi/man.cgi

Reply via email to