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