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                 }
  25 }
  26
  27 sub cgi_page_from_404 ($$$) {
  28         my $path = shift;
  29         my $baseurl = shift;
  30         my $usedirs = shift;
  31
  32         # fail if missing from environment or whatever
  33         return undef unless defined $path;
  34         return undef unless defined $baseurl;
  35
  36         # with usedirs on, path is like /~fred/foo/bar/ or /~fred/foo/bar or
  37         #    /~fred/foo/bar/index.html
  38         # with usedirs off, path is like /~fred/foo/bar.html
  39         # baseurl is like 'http://people.example.com/~fred'
  40
  41         # convert baseurl to ~fred
  42         unless ($baseurl =~ s{^https?://[^/]+/?}{}) {
  43                 return undef;
  44         }
  45
  46         # convert path to /~fred/foo/bar
  47         if ($usedirs) {
  48                 $path =~ s/\/*(?:index\.$config{htmlext})?$//;
  49         }
  50         else {
  51                 $path =~ s/\.$config{htmlext}$//;
  52         }
  53
  54         # remove /~fred/
  55         unless ($path =~ s{^/*\Q$baseurl\E/*}{}) {
  56                 return undef;
  57         }
  58
  59         # special case for the index
  60         unless ($path) {
  61                 return 'index';
  62         }
  63
  64         return $path;
  65 }
  66
  67 sub cgi ($) {
  68         my $cgi=shift;
  69
  70         if (exists $ENV{REDIRECT_STATUS} &&
  71             $ENV{REDIRECT_STATUS} eq '404') {
  72                 my $page = cgi_page_from_404(
  73                         Encode::decode_utf8($ENV{REDIRECT_URL}),
  74                         $config{url}, $config{usedirs});
  75                 IkiWiki::Plugin::goto::cgi_goto($cgi, $page);
  76         }
  77 }
  78
  79 1;