404handler.pl

   1 #! /usr/bin/perl
   2 # Copyright (C) 2004  Alex Schroeder <alex@emacswiki.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the
  16 #    Free Software Foundation, Inc.
  17 #    59 Temple Place, Suite 330
  18 #    Boston, MA 02111-1307 USA
  19
  20 package OddMuse;
  21
  22 my $dir = '/var/www/wiki'; # absolute path to the file cache
  23 my $origname = '/wiki'; # relative url to the file cache, with trailing slash
  24 my $script = '/usr/lib/cgi-bin/wiki.pl'; # absolute path to the wiki script
  25 my $name = '/cgi-bin/wiki.pl'; # relative url to the wiki script
  26 my @path = split(/\//, $ENV{REDIRECT_URL});
  27 my $file = $path[$#path];
  28
  29 # for dynamic pages
  30 use vars qw($NotFoundHandlerExceptionsPage);
  31 $NotFoundHandlerExceptionsPage = 'NoCachePages';
  32 $RunCGI = 0;
  33 do $script;
  34 Init();
  35
  36 # call the wiki for the page missing in the cache.  first set up CGI
  37 # environment -- see http://localhost/cgi-bin/printenv.  then call the
  38 # script and read output from the pipe.
  39
  40 local $/;
  41 $ENV{REQUEST_METHOD}="GET";
  42 $ENV{QUERY_STRING}=$file;
  43 $ENV{SCRIPT_FILENAME}=$script;
  44 $ENV{SCRIPT_NAME}=$name;
  45 $ENV{REQUEST_URI}=$origname;
  46 # print "Content-Type: text/plain\r\n\r\n";
  47 # print "$script $file\n";
  48 open(F, "$script |") || print STDERR "can't run $script: $!\n";
  49 my $data = <F>;
  50 close(F);
  51
  52 # print data to stdout and write a copy without headers into the cache
  53 # if the script didn't print a Status (since the default is "200 Ok").
  54
  55 print $data;
  56 $data =~ /^Status: ([1-9][0-9][0-9])/;
  57 my $status = $1;
  58 $data =~ /((.+:.*\n)*)/;
  59 my $header = $1;
  60 # print "<pre>$header</pre>";
  61 if (not $status) { # ie. 200
  62   my %skip = ();
  63   foreach (split(/\n/, GetPageContent($NotFoundHandlerExceptionsPage))) {
  64     if (/^ ([^ ]+)[ \t]*$/) {  # only read lines with one word after one space
  65       $skip{$1} = 1;
  66     }
  67   }
  68   if (not $skip{$file}) {
  69     $data =~ s/^(.*\r\n)+//; # strip header
  70     open(G, "> $dir/$file") || print STDERR "can't write $dir/$file: $!\n";
  71     print G $data;
  72     close(G);
  73   }
  74 }
  75
  76 1;
  77
  78 # cache cleanup has to hook into the wiki!