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