IkiWiki/Plugin/apache404.pm

   1 #!/usr/bin/perl
   2 # Copyright © 2009 Simon McVittie <http://smcv.pseudorandom.co.uk/>
   3 # Licensed under the GNU GPL, version 2, or any later version published by the
   4 # Free Software Foundation
   5 package IkiWiki::Plugin::apache404;
   6
   7 use warnings;
   8 use strict;
   9 use IkiWiki 3.00;
  10
  11 sub import {
  12         hook(type => "cgi", id => 'apache404',  call => \&cgi);
  13 }
  14
  15 sub getsetup () {
  16         return
  17                 plugin => {
  18                         # not really a matter of safety, but enabling/disabling
  19                         # through a web interface is useless - it needs web
  20                         # server admin action too
  21                         safe => 0,
  22                         rebuild => 0,
  23                 }
  24 }
  25
  26 sub cgi_page_from_404 ($$$) {
  27         my $path = shift;
  28         my $baseurl = shift;
  29         my $usedirs = shift;
  30
  31         # fail if missing from environment or whatever
  32         return undef unless defined $path;
  33         return undef unless defined $baseurl;
  34
  35         # with usedirs on, path is like /~fred/foo/bar/ or /~fred/foo/bar or
  36         #    /~fred/foo/bar/index.html
  37         # with usedirs off, path is like /~fred/foo/bar.html
  38         # baseurl is like 'http://people.example.com/~fred'
  39
  40         # convert baseurl to ~fred
  41         unless ($baseurl =~ s{^https?://[^/]+/?}{}) {
  42                 return undef;
  43         }
  44
  45         # convert path to /~fred/foo/bar
  46         if ($usedirs) {
  47                 $path =~ s/\/*(?:index\.$config{htmlext})?$//;
  48         }
  49         else {
  50                 $path =~ s/\.$config{htmlext}$//;
  51         }
  52
  53         # remove /~fred/
  54         unless ($path =~ s{^/*\Q$baseurl\E/*}{}) {
  55                 return undef;
  56         }
  57
  58         # special case for the index
  59         unless ($path) {
  60                 return 'index';
  61         }
  62
  63         return $path;
  64 }
  65
  66 sub cgi ($) {
  67         my $cgi=shift;
  68
  69         if ($ENV{REDIRECT_STATUS} eq '404') {
  70                 my $page = cgi_page_from_404($ENV{REDIRECT_URL},
  71                         $config{url}, $config{usedirs});
  72                 IkiWiki::cgi_goto($cgi, $page);
  73         }
  74 }
  75
  76 1;