ikiwiki/IkiWiki.pm

3132 lines
71 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
package IkiWiki;
2008-07-11 12:08:36 +02:00
use warnings;
use strict;
use Encode;
use Fcntl q{:flock};
2007-03-08 07:25:20 +01:00
use URI::Escape q{uri_escape_utf8};
use POSIX ();
use Storable;
use open qw{:utf8 :std};
use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
2010-04-17 18:54:22 +02:00
%pagestate %wikistate %renderedfiles %oldrenderedfiles
%pagesources %delpagesources %destsources %depends %depends_simple
@mass_depends %hooks %forcerebuild %loaded_plugins %typedlinks
%oldtypedlinks %autofiles @underlayfiles $lastrev $phase};
use Exporter q{import};
our @EXPORT = qw(hook debug error htmlpage template template_depends
deptype add_depends pagespec_match pagespec_match_list bestlink
2010-04-17 18:54:22 +02:00
htmllink readfile writefile pagetype srcfile pagename
displaytime strftime_utf8 will_render gettext ngettext urlto targetpage
2010-04-17 18:54:22 +02:00
add_underlay pagetitle titlepage linkpage newpagefile
inject add_link add_autofile useragent
2010-04-17 18:54:22 +02:00
%config %links %pagestate %wikistate %renderedfiles
%pagesources %destsources %typedlinks);
our $VERSION = 3.00; # plugin interface version, next is ikiwiki version
our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
our $installdir='/usr'; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
# Page dependency types.
our $DEPEND_CONTENT=1;
our $DEPEND_PRESENCE=2;
our $DEPEND_LINKS=4;
# Phases of processing.
sub PHASE_SCAN () { 0 }
sub PHASE_RENDER () { 1 }
$phase = PHASE_SCAN;
# Optimisation.
use Memoize;
memoize("abs2rel");
memoize("sortspec_translate");
memoize("pagespec_translate");
memoize("template_file");
sub getsetup () {
wikiname => {
type => "string",
default => "wiki",
description => "name of the wiki",
safe => 1,
rebuild => 1,
},
2008-08-03 23:02:00 +02:00
adminemail => {
type => "string",
default => undef,
example => 'me@example.com',
description => "contact email for wiki",
safe => 1,
rebuild => 0,
},
adminuser => {
type => "string",
default => [],
description => "users who are wiki admins",
safe => 1,
rebuild => 0,
},
banned_users => {
type => "string",
default => [],
description => "users who are banned from the wiki",
safe => 1,
rebuild => 0,
},
srcdir => {
type => "string",
default => undef,
example => "$ENV{HOME}/wiki",
description => "where the source of the wiki is located",
safe => 0, # path
rebuild => 1,
},
destdir => {
type => "string",
default => undef,
example => "/var/www/wiki",
description => "where to build the wiki",
safe => 0, # path
rebuild => 1,
},
url => {
type => "string",
default => '',
example => "http://example.com/wiki",
description => "base url to the wiki",
safe => 1,
rebuild => 1,
},
cgiurl => {
type => "string",
default => '',
example => "http://example.com/wiki/ikiwiki.cgi",
description => "url to the ikiwiki.cgi",
safe => 1,
rebuild => 1,
},
reverse_proxy => {
type => "boolean",
default => 0,
description => "do not adjust cgiurl if CGI is accessed via different URL",
advanced => 0,
safe => 1,
rebuild => 0, # only affects CGI requests
},
cgi_wrapper => {
type => "string",
default => '',
example => "/var/www/wiki/ikiwiki.cgi",
2008-12-18 20:49:24 +01:00
description => "filename of cgi wrapper to generate",
safe => 0, # file
rebuild => 0,
},
cgi_wrappermode => {
type => "string",
default => '06755',
description => "mode for cgi_wrapper (can safely be made suid)",
safe => 0,
rebuild => 0,
},
cgi_overload_delay => {
type => "string",
default => '',
example => "10",
description => "number of seconds to delay CGI requests when overloaded",
safe => 1,
rebuild => 0,
},
2012-10-11 17:22:03 +02:00
cgi_overload_message => {
type => "string",
default => '',
example => "Please wait",
description => "message to display when overloaded (may contain html)",
safe => 1,
rebuild => 0,
},
only_committed_changes => {
type => "boolean",
default => 0,
description => "enable optimization of only refreshing committed changes?",
safe => 1,
rebuild => 0,
},
rcs => {
type => "string",
default => '',
description => "rcs backend to use",
safe => 0, # don't allow overriding
rebuild => 0,
},
2008-07-27 00:36:56 +02:00
default_plugins => {
type => "internal",
default => [qw{mdwn link inline meta htmlscrubber passwordauth
openid signinedit lockedit conditional
recentchanges parentlinks editpage
templatebody}],
2008-07-27 00:36:56 +02:00
description => "plugins to enable by default",
2008-07-30 20:36:40 +02:00
safe => 0,
2008-07-27 00:36:56 +02:00
rebuild => 1,
},
add_plugins => {
type => "string",
default => [],
description => "plugins to add to the default configuration",
safe => 1,
rebuild => 1,
},
disable_plugins => {
type => "string",
default => [],
description => "plugins to disable",
safe => 1,
rebuild => 1,
},
templatedir => {
type => "string",
default => "$installdir/share/ikiwiki/templates",
2010-04-25 03:38:22 +02:00
description => "additional directory to search for template files",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # path
rebuild => 1,
},
underlaydir => {
type => "string",
default => "$installdir/share/ikiwiki/basewiki",
description => "base wiki source location",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # path
rebuild => 0,
},
underlaydirbase => {
type => "internal",
default => "$installdir/share/ikiwiki",
description => "parent directory containing additional underlays",
safe => 0,
rebuild => 0,
},
wrappers => {
type => "internal",
default => [],
description => "wrappers to generate",
safe => 0,
rebuild => 0,
},
underlaydirs => {
type => "internal",
default => [],
description => "additional underlays to use",
safe => 0,
rebuild => 0,
},
verbose => {
type => "boolean",
example => 1,
description => "display verbose messages?",
safe => 1,
rebuild => 0,
},
syslog => {
type => "boolean",
example => 1,
2008-07-26 20:43:47 +02:00
description => "log to syslog?",
safe => 1,
rebuild => 0,
},
usedirs => {
type => "boolean",
default => 1,
description => "create output files named page/index.html?",
safe => 0, # changing requires manual transition
rebuild => 1,
},
prefix_directives => {
type => "boolean",
2008-12-23 22:24:43 +01:00
default => 1,
description => "use '!'-prefixed preprocessor directives?",
safe => 0, # changing requires manual transition
rebuild => 1,
},
indexpages => {
type => "boolean",
2008-10-01 21:55:50 +02:00
default => 0,
description => "use page/index.mdwn source files",
safe => 1,
rebuild => 1,
},
2008-07-27 00:36:56 +02:00
discussion => {
type => "boolean",
default => 1,
description => "enable Discussion pages?",
safe => 1,
rebuild => 1,
},
discussionpage => {
type => "string",
default => gettext("Discussion"),
description => "name of Discussion pages",
safe => 1,
rebuild => 1,
},
html5 => {
type => "boolean",
default => 0,
description => "use elements new in HTML5 like <section>?",
advanced => 0,
safe => 1,
rebuild => 1,
},
2008-08-03 23:02:00 +02:00
sslcookie => {
type => "boolean",
default => 0,
description => "only send cookies over SSL connections?",
advanced => 1,
safe => 1,
rebuild => 0,
},
default_pageext => {
type => "string",
default => "mdwn",
description => "extension to use for new pages",
safe => 0, # not sanitized
rebuild => 0,
},
htmlext => {
type => "string",
default => "html",
description => "extension to use for html files",
safe => 0, # not sanitized
rebuild => 1,
},
timeformat => {
type => "string",
default => '%c',
description => "strftime format string to display date",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 1,
rebuild => 1,
},
locale => {
type => "string",
default => undef,
example => "en_US.UTF-8",
description => "UTF-8 locale to use",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0,
rebuild => 1,
},
userdir => {
type => "string",
default => "",
example => "users",
description => "put user pages below specified page",
safe => 1,
rebuild => 1,
},
numbacklinks => {
type => "integer",
default => 10,
description => "how many backlinks to show before hiding excess (0 to show all)",
safe => 1,
rebuild => 1,
},
hardlink => {
type => "boolean",
default => 0,
2008-07-26 20:43:47 +02:00
description => "attempt to hardlink source files? (optimisation for large files)",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # paranoia
rebuild => 0,
},
umask => {
type => "string",
example => "public",
description => "force ikiwiki to use a particular umask (keywords public, group or private, or a number)",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # paranoia
rebuild => 0,
},
wrappergroup => {
type => "string",
example => "ikiwiki",
description => "group for wrappers to run in",
advanced => 1,
safe => 0, # paranoia
rebuild => 0,
},
libdirs => {
type => "string",
default => [],
example => ["$ENV{HOME}/.local/share/ikiwiki"],
description => "extra library and plugin directories",
advanced => 1,
safe => 0, # directory
rebuild => 0,
},
libdir => {
type => "string",
default => "",
example => "$ENV{HOME}/.ikiwiki/",
description => "extra library and plugin directory (searched after libdirs)",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # directory
rebuild => 0,
},
ENV => {
type => "string",
default => {},
description => "environment variables",
safe => 0, # paranoia
rebuild => 0,
},
timezone => {
type => "string",
default => "",
example => "US/Eastern",
description => "time zone name",
safe => 1,
rebuild => 1,
},
include => {
type => "string",
default => undef,
example => '^\.htaccess$',
description => "regexp of normally excluded files to include",
advanced => 1,
safe => 0, # regexp
rebuild => 1,
},
exclude => {
type => "string",
default => undef,
2010-03-18 04:24:31 +01:00
example => '^(*\.private|Makefile)$',
description => "regexp of files that should be skipped",
2008-08-03 20:57:24 +02:00
advanced => 1,
safe => 0, # regexp
rebuild => 1,
},
wiki_file_prune_regexps => {
type => "internal",
default => [qr/(^|\/)\.\.(\/|$)/, qr/^\//, qr/^\./, qr/\/\./,
qr/\.x?html?$/, qr/\.ikiwiki-new$/,
qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
2009-04-05 00:49:57 +02:00
qr/(^|\/)_MTN\//, qr/(^|\/)_darcs\//,
2009-08-13 22:56:26 +02:00
qr/(^|\/)CVS\//, qr/\.dpkg-tmp$/],
description => "regexps of source files to ignore",
safe => 0,
rebuild => 1,
},
wiki_file_chars => {
type => "string",
description => "specifies the characters that are allowed in source filenames",
default => "-[:alnum:]+/.:_",
safe => 0,
rebuild => 1,
},
wiki_file_regexp => {
type => "internal",
description => "regexp of legal source files",
safe => 0,
rebuild => 1,
},
web_commit_regexp => {
type => "internal",
default => qr/^web commit (by (.*?(?=: |$))|from ([0-9a-fA-F:.]+[0-9a-fA-F])):?(.*)/,
description => "regexp to parse web commits from logs",
safe => 0,
rebuild => 0,
},
cgi => {
type => "internal",
default => 0,
description => "run as a cgi",
safe => 0,
rebuild => 0,
},
cgi_disable_uploads => {
type => "internal",
default => 1,
description => "whether CGI should accept file uploads",
safe => 0,
rebuild => 0,
},
post_commit => {
type => "internal",
default => 0,
description => "run as a post-commit hook",
safe => 0,
rebuild => 0,
},
rebuild => {
type => "internal",
default => 0,
description => "running in rebuild mode",
safe => 0,
rebuild => 0,
},
setup => {
type => "internal",
default => undef,
description => "running in setup mode",
safe => 0,
rebuild => 0,
},
clean => {
type => "internal",
default => 0,
description => "running in clean mode",
safe => 0,
rebuild => 0,
},
refresh => {
type => "internal",
default => 0,
description => "running in refresh mode",
safe => 0,
rebuild => 0,
},
test_receive => {
type => "internal",
default => 0,
description => "running in receive test mode",
safe => 0,
rebuild => 0,
},
wrapper_background_command => {
type => "internal",
default => '',
description => "background shell command to run",
safe => 0,
rebuild => 0,
},
gettime => {
type => "internal",
description => "running in gettime mode",
safe => 0,
rebuild => 0,
},
w3mmode => {
type => "internal",
default => 0,
description => "running in w3mmode",
safe => 0,
rebuild => 0,
},
wikistatedir => {
type => "internal",
default => undef,
description => "path to the .ikiwiki directory holding ikiwiki state",
safe => 0,
rebuild => 0,
},
setupfile => {
type => "internal",
default => undef,
description => "path to setup file",
safe => 0,
rebuild => 0,
},
setuptype => {
type => "internal",
default => "Yaml",
description => "perl class to use to dump setup file",
safe => 0,
rebuild => 0,
},
allow_symlinks_before_srcdir => {
type => "boolean",
default => 0,
description => "allow symlinks in the path leading to the srcdir (potentially insecure)",
safe => 0,
rebuild => 0,
},
cookiejar => {
type => "string",
2013-09-04 16:15:35 +02:00
default => { file => "$ENV{HOME}/.ikiwiki/cookies" },
description => "cookie control",
safe => 0, # hooks into perl module internals
rebuild => 0,
},
useragent => {
type => "string",
default => "ikiwiki/$version",
example => "Wget/1.13.4 (linux-gnu)",
description => "set custom user agent string for outbound HTTP requests e.g. when fetching aggregated RSS feeds",
safe => 0,
rebuild => 0,
},
responsive_layout => {
type => "boolean",
default => 1,
description => "theme has a responsive layout? (mobile-optimized)",
safe => 1,
rebuild => 1,
},
deterministic => {
type => "boolean",
default => 0,
description => "try harder to produce deterministic output",
safe => 1,
rebuild => 1,
advanced => 1,
},
}
sub getlibdirs () {
2014-12-16 09:11:59 +01:00
my @libdirs;
if ($config{libdirs}) {
@libdirs = @{$config{libdirs}};
}
if (length $config{libdir}) {
push @libdirs, $config{libdir};
}
return @libdirs;
}
sub defaultconfig () {
my %s=getsetup();
my @ret;
foreach my $key (keys %s) {
push @ret, $key, $s{$key}->{default};
}
return @ret;
}
# URL to top of wiki as a path starting with /, valid from any wiki page or
# the CGI; if that's not possible, an absolute URL. Either way, it ends with /
my $local_url;
# URL to CGI script, similar to $local_url
my $local_cgiurl;
sub checkconfig () {
# locale stuff; avoid LC_ALL since it overrides everything
if (defined $ENV{LC_ALL}) {
$ENV{LANG} = $ENV{LC_ALL};
delete $ENV{LC_ALL};
}
if (defined $config{locale}) {
2007-01-28 03:24:43 +01:00
if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
$ENV{LANG}=$config{locale};
define_gettext();
2007-01-28 03:24:43 +01:00
}
}
if (! defined $config{wiki_file_regexp}) {
$config{wiki_file_regexp}=qr/(^[$config{wiki_file_chars}]+$)/;
}
if (ref $config{ENV} eq 'HASH') {
foreach my $val (keys %{$config{ENV}}) {
$ENV{$val}=$config{ENV}{$val};
}
}
if (defined $config{timezone} && length $config{timezone}) {
$ENV{TZ}=$config{timezone};
}
elsif (defined $ENV{TZ} && length $ENV{TZ}) {
$config{timezone}=$ENV{TZ};
}
else {
eval q{use Config qw()};
error($@) if $@;
if ($Config::Config{d_gnulibc} && -e '/etc/localtime') {
$config{timezone}=$ENV{TZ}=':/etc/localtime';
}
else {
$config{timezone}=$ENV{TZ}='GMT';
}
}
if ($config{w3mmode}) {
eval q{use Cwd q{abs_path}};
error($@) if $@;
$config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
$config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
$config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
unless $config{cgiurl} =~ m!file:///!;
$config{url}="file://".$config{destdir};
}
if ($config{cgi} && ! length $config{url}) {
error(gettext("Must specify url to wiki with --url when using --cgi"));
}
if (defined $config{url} && length $config{url}) {
eval q{use URI};
my $baseurl = URI->new($config{url});
$local_url = $baseurl->path . "/";
$local_cgiurl = undef;
if (length $config{cgiurl}) {
my $cgiurl = URI->new($config{cgiurl});
$local_cgiurl = $cgiurl->path;
if ($cgiurl->scheme eq 'https' &&
$baseurl->scheme eq 'http') {
# We assume that the same content is available
# over both http and https, because if it
# wasn't, accessing the static content
# from the CGI would be mixed-content,
# which would be a security flaw.
if ($cgiurl->authority ne $baseurl->authority) {
# use protocol-relative URL for
# static content
$local_url = "$config{url}/";
$local_url =~ s{^http://}{//};
}
# else use host-relative URL for static content
# either way, CGI needs to be absolute
$local_cgiurl = $config{cgiurl};
}
elsif ($cgiurl->scheme ne $baseurl->scheme) {
# too far apart, fall back to absolute URLs
$local_url = "$config{url}/";
$local_cgiurl = $config{cgiurl};
}
elsif ($cgiurl->authority ne $baseurl->authority) {
# slightly too far apart, fall back to
# protocol-relative URLs
$local_url = "$config{url}/";
$local_url =~ s{^https?://}{//};
$local_cgiurl = $config{cgiurl};
$local_cgiurl =~ s{^https?://}{//};
}
# else keep host-relative URLs
}
$local_url =~ s{//$}{/};
}
else {
$local_cgiurl = $config{cgiurl};
}
$config{wikistatedir}="$config{srcdir}/.ikiwiki"
unless exists $config{wikistatedir} && defined $config{wikistatedir};
if (defined $config{umask}) {
my $u = possibly_foolish_untaint($config{umask});
if ($u =~ m/^\d+$/) {
umask($u);
}
elsif ($u eq 'private') {
umask(077);
}
elsif ($u eq 'group') {
umask(027);
}
elsif ($u eq 'public') {
umask(022);
}
else {
error(sprintf(gettext("unsupported umask setting %s"), $u));
}
}
run_hooks(checkconfig => sub { shift->() });
return 1;
}
sub listplugins () {
2008-07-27 01:10:11 +02:00
my %ret;
foreach my $dir (@INC, getlibdirs()) {
2008-07-28 01:20:14 +02:00
next unless defined $dir && length $dir;
2008-07-27 01:10:11 +02:00
foreach my $file (glob("$dir/IkiWiki/Plugin/*.pm")) {
my ($plugin)=$file=~/.*\/(.*)\.pm$/;
$ret{$plugin}=1;
}
}
foreach my $dir (getlibdirs(), "$installdir/lib/ikiwiki") {
2008-07-28 01:20:14 +02:00
next unless defined $dir && length $dir;
2008-07-27 01:10:11 +02:00
foreach my $file (glob("$dir/plugins/*")) {
$ret{basename($file)}=1 if -x $file;
}
}
return keys %ret;
}
2008-07-27 01:10:11 +02:00
sub loadplugins () {
foreach my $dir (getlibdirs()) {
unshift @INC, possibly_foolish_untaint($dir);
}
foreach my $plugin (@{$config{default_plugins}}, @{$config{add_plugins}}) {
loadplugin($plugin);
}
if ($config{rcs}) {
2009-10-03 20:01:19 +02:00
if (exists $hooks{rcs}) {
error(gettext("cannot use multiple rcs plugins"));
}
loadplugin($config{rcs});
}
2009-10-03 20:01:19 +02:00
if (! exists $hooks{rcs}) {
loadplugin("norcs");
}
run_hooks(getopt => sub { shift->() });
if (grep /^-/, @ARGV) {
print STDERR "Unknown option (or missing parameter): $_\n"
foreach grep /^-/, @ARGV;
usage();
}
return 1;
}
sub loadplugin ($;$) {
my $plugin=shift;
my $force=shift;
return if ! $force && grep { $_ eq $plugin} @{$config{disable_plugins}};
foreach my $possiblytainteddir (getlibdirs(), "$installdir/lib/ikiwiki") {
my $dir = possibly_foolish_untaint($possiblytainteddir);
if (defined $dir && -x "$dir/plugins/$plugin") {
eval { require IkiWiki::Plugin::external };
if ($@) {
my $reason=$@;
error(sprintf(gettext("failed to load external plugin needed for %s plugin: %s"), $plugin, $reason));
}
import IkiWiki::Plugin::external "$dir/plugins/$plugin";
2008-08-02 22:40:46 +02:00
$loaded_plugins{$plugin}=1;
return 1;
}
}
my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
eval qq{use $mod};
if ($@) {
error("Failed to load plugin $mod: $@");
}
2008-08-02 22:40:46 +02:00
$loaded_plugins{$plugin}=1;
return 1;
}
sub error ($;$) {
my $message=shift;
my $cleaner=shift;
log_message('err' => $message) if $config{syslog};
if (defined $cleaner) {
$cleaner->();
}
die $message."\n";
}
sub debug ($) {
return unless $config{verbose};
return log_message(debug => @_);
}
my $log_open=0;
my $log_failed=0;
sub log_message ($$) {
my $type=shift;
if ($config{syslog}) {
require Sys::Syslog;
if (! $log_open) {
Sys::Syslog::setlogsock('unix');
Sys::Syslog::openlog('ikiwiki', '', 'user');
$log_open=1;
}
eval {
my $message = "[$config{wikiname}] ".join(" ", @_);
utf8::encode($message);
Sys::Syslog::syslog($type, "%s", $message);
};
if ($@) {
print STDERR "failed to syslog: $@" unless $log_failed;
$log_failed=1;
print STDERR "@_\n";
}
return $@;
}
elsif (! $config{cgi}) {
return print "@_\n";
}
else {
return print STDERR "@_\n";
}
}
sub possibly_foolish_untaint ($) {
my $tainted=shift;
my ($untainted)=$tainted=~/(.*)/s;
return $untainted;
}
sub basename ($) {
my $file=shift;
$file=~s!.*/+!!;
return $file;
}
sub dirname ($) {
my $file=shift;
$file=~s!/*[^/]+$!!;
return $file;
}
sub isinternal ($) {
my $page=shift;
return exists $pagesources{$page} &&
$pagesources{$page} =~ /\._([^.]+)$/;
}
sub pagetype ($) {
my $file=shift;
if ($file =~ /\.([^.]+)$/) {
return $1 if exists $hooks{htmlize}{$1};
}
my $base=basename($file);
if (exists $hooks{htmlize}{$base} &&
$hooks{htmlize}{$base}{noextension}) {
return $base;
}
return;
}
my %pagename_cache;
sub pagename ($) {
my $file=shift;
if (exists $pagename_cache{$file}) {
return $pagename_cache{$file};
}
my $type=pagetype($file);
my $page=$file;
2010-10-04 22:34:33 +02:00
$page=~s/\Q.$type\E*$//
if defined $type && !$hooks{htmlize}{$type}{keepextension}
&& !$hooks{htmlize}{$type}{noextension};
if ($config{indexpages} && $page=~/(.*)\/index$/) {
$page=$1;
}
$pagename_cache{$file} = $page;
return $page;
}
sub newpagefile ($$) {
2008-09-30 00:51:16 +02:00
my $page=shift;
my $type=shift;
if (! $config{indexpages} || $page eq 'index') {
return $page.".".$type;
}
else {
return $page."/index.".$type;
}
}
2008-09-30 00:51:16 +02:00
sub targetpage ($$;$) {
my $page=shift;
my $ext=shift;
my $filename=shift;
if (defined $filename) {
return $page."/".$filename.".".$ext;
}
elsif (! $config{usedirs} || $page eq 'index') {
return $page.".".$ext;
2008-09-30 00:51:16 +02:00
}
else {
return $page."/index.".$ext;
}
}
sub htmlpage ($) {
my $page=shift;
return targetpage($page, $config{htmlext});
}
sub srcfile_stat {
my $file=shift;
my $nothrow=shift;
return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file";
foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
return "$dir/$file", stat(_) if -e "$dir/$file";
}
error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow;
return;
}
sub srcfile ($;$) {
return (srcfile_stat(@_))[0];
}
sub add_literal_underlay ($) {
my $dir=shift;
if (! grep { $_ eq $dir } @{$config{underlaydirs}}) {
unshift @{$config{underlaydirs}}, $dir;
}
}
sub add_underlay ($) {
my $dir = shift;
if ($dir !~ /^\//) {
$dir="$config{underlaydirbase}/$dir";
}
add_literal_underlay($dir);
# why does it return 1? we just don't know
return 1;
}
sub readfile ($;$$) {
my $file=shift;
my $binary=shift;
my $wantfd=shift;
if (-l $file) {
error("cannot read a symlink ($file)");
}
local $/=undef;
open (my $in, "<", $file) || error("failed to read $file: $!");
binmode($in) if ($binary);
return \*$in if $wantfd;
my $ret=<$in>;
# check for invalid utf-8, and toss it back to avoid crashes
if (! utf8::valid($ret)) {
$ret=encode_utf8($ret);
}
close $in || error("failed to read $file: $!");
return $ret;
}
sub prep_writefile ($$) {
my $file=shift;
my $destdir=shift;
my $test=$file;
while (length $test) {
if (-l "$destdir/$test") {
error("cannot write to a symlink ($test)");
}
if (-f _ && $test ne $file) {
# Remove conflicting file.
foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
if ($f eq $test) {
unlink("$destdir/$test");
last;
}
}
}
}
$test=dirname($test);
}
my $dir=dirname("$destdir/$file");
if (! -d $dir) {
my $d="";
foreach my $s (split(m!/+!, $dir)) {
$d.="$s/";
if (! -d $d) {
mkdir($d) || error("failed to create directory $d: $!");
}
}
}
return 1;
}
sub writefile ($$$;$$) {
my $file=shift; # can include subdirs
my $destdir=shift; # directory to put file in
my $content=shift;
my $binary=shift;
my $writer=shift;
prep_writefile($file, $destdir);
my $newfile="$destdir/$file.ikiwiki-new";
if (-l $newfile) {
error("cannot write to a symlink ($newfile)");
}
my $cleanup = sub { unlink($newfile) };
open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
binmode($out) if ($binary);
if ($writer) {
$writer->(\*$out, $cleanup);
}
else {
print $out $content or error("failed writing to $newfile: $!", $cleanup);
}
close $out || error("failed saving $newfile: $!", $cleanup);
rename($newfile, "$destdir/$file") ||
error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
return 1;
}
my %cleared;
sub will_render ($$;$) {
my $page=shift;
my $dest=shift;
my $clear=shift;
# Important security check for independently created files.
if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}}, @{$wikistate{editpage}{previews}})) {
my $from_other_page=0;
# Expensive, but rarely runs.
foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
if (grep {
$_ eq $dest ||
dirname($_) eq $dest
} @{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
$from_other_page=1;
last;
}
}
error("$config{destdir}/$dest independently created, not overwriting with version from $page")
unless $from_other_page;
}
# If $dest exists as a directory, remove conflicting files in it
# rendered from other pages.
if (-d _) {
foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
2010-07-18 23:47:36 +02:00
if (dirname($f) eq $dest) {
unlink("$config{destdir}/$f");
rmdir(dirname("$config{destdir}/$f"));
}
}
}
}
if (! $clear || $cleared{$page}) {
$renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
}
else {
foreach my $old (@{$renderedfiles{$page}}) {
delete $destsources{$old};
}
$renderedfiles{$page}=[$dest];
$cleared{$page}=1;
}
$destsources{$dest}=$page;
return 1;
}
sub bestlink ($$) {
my $page=shift;
my $link=shift;
my $cwd=$page;
if ($link=~s/^\/+//) {
# absolute links
$cwd="";
}
$link=~s/\/$//;
do {
my $l=$cwd;
$l.="/" if length $l;
$l.=$link;
if (exists $pagesources{$l}) {
return $l;
}
elsif (exists $pagecase{lc $l}) {
return $pagecase{lc $l};
}
} while $cwd=~s{/?[^/]+$}{};
if (length $config{userdir}) {
my $l = "$config{userdir}/".lc($link);
if (exists $pagesources{$l}) {
return $l;
}
elsif (exists $pagecase{lc $l}) {
return $pagecase{lc $l};
}
}
#print STDERR "warning: page $page, broken link: $link\n";
return "";
}
sub isinlinableimage ($) {
my $file=shift;
return $file =~ /\.(png|gif|jpg|jpeg|svg)$/i;
}
sub pagetitle ($;$) {
my $page=shift;
my $unescaped=shift;
if ($unescaped) {
$page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
}
else {
$page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
}
return $page;
}
sub titlepage ($) {
my $title=shift;
# support use w/o %config set
my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_";
$title=~s/([^$chars]|_)/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
return $title;
}
sub linkpage ($) {
my $link=shift;
my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_";
$link=~s/([^$chars])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
return $link;
}
sub cgiurl (@) {
my %params=@_;
my $cgiurl=$local_cgiurl;
if (exists $params{cgiurl}) {
$cgiurl=$params{cgiurl};
delete $params{cgiurl};
}
unless (%params) {
return $cgiurl;
}
return $cgiurl."?".
join("&amp;", map $_."=".uri_escape_utf8($params{$_}), sort(keys %params));
}
sub cgiurl_abs (@) {
eval q{use URI};
URI->new_abs(cgiurl(@_), $config{cgiurl});
}
# Same as cgiurl_abs, but when the user connected using https,
# will be a https url even if the cgiurl is normally a http url.
#
# This should be used for anything involving emailing a login link,
# because a https session cookie will not be sent over http.
sub cgiurl_abs_samescheme (@) {
my $u=cgiurl_abs(@_);
if (($ENV{HTTPS} && lc $ENV{HTTPS} ne "off")) {
$u=~s/^http:/https:/i;
}
return $u
}
sub baseurl (;$) {
my $page=shift;
return $local_url if ! defined $page;
$page=htmlpage($page);
$page=~s/[^\/]+$//;
$page=~s/[^\/]+\//..\//g;
return $page;
}
sub urlabs ($$) {
my $url=shift;
my $urlbase=shift;
return $url unless defined $urlbase && length $urlbase;
eval q{use URI};
URI->new_abs($url, $urlbase)->as_string;
}
sub abs2rel ($$) {
# Work around very innefficient behavior in File::Spec if abs2rel
# is passed two relative paths. It's much faster if paths are
2006-12-07 05:56:06 +01:00
# absolute! (Debian bug #376658; fixed in debian unstable now)
my $path="/".shift;
my $base="/".shift;
require File::Spec;
my $ret=File::Spec->abs2rel($path, $base);
$ret=~s/^// if defined $ret;
return $ret;
}
sub displaytime ($;$$) {
# Plugins can override this function to mark up the time to
# display.
my $time=formattime($_[0], $_[1]);
if ($config{html5}) {
return '<time datetime="'.date_3339($_[0]).'"'.
2010-05-09 01:45:02 +02:00
($_[2] ? ' pubdate="pubdate"' : '').
'>'.$time.'</time>';
}
else {
return '<span class="date">'.$time.'</span>';
}
}
sub formattime ($;$) {
# Plugins can override this function to format the time.
my $time=shift;
my $format=shift;
if (! defined $format) {
$format=$config{timeformat};
}
return strftime_utf8($format, localtime($time));
}
my $strftime_encoding;
sub strftime_utf8 {
# strftime didn't know about encodings in older Perl, so make sure
# its output is properly treated as utf8.
# Note that this does not handle utf-8 in the format string.
my $result = POSIX::strftime(@_);
if (Encode::is_utf8($result)) {
return $result;
}
2012-02-02 03:47:21 +01:00
($strftime_encoding) = POSIX::setlocale(&POSIX::LC_TIME) =~ m#\.([^@]+)#
unless defined $strftime_encoding;
$strftime_encoding
? Encode::decode($strftime_encoding, $result)
: $result;
}
sub date_3339 ($) {
my $time=shift;
my $lc_time=POSIX::setlocale(&POSIX::LC_TIME);
POSIX::setlocale(&POSIX::LC_TIME, "C");
my $ret=POSIX::strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($time));
POSIX::setlocale(&POSIX::LC_TIME, $lc_time);
return $ret;
}
sub beautify_urlpath ($) {
my $url=shift;
# Ensure url is not an empty link, and if necessary,
# add ./ to avoid colon confusion.
if ($url !~ /^\// && $url !~ /^\.\.?\//) {
$url="./$url";
}
if ($config{usedirs}) {
$url =~ s!/index.$config{htmlext}$!/!;
}
return $url;
}
2010-11-29 19:59:48 +01:00
sub urlto ($;$$) {
my $to=shift;
my $from=shift;
my $absolute=shift;
if (! length $to) {
$to = 'index';
}
if (! $destsources{$to}) {
$to=htmlpage($to);
}
if ($absolute) {
return $config{url}.beautify_urlpath("/".$to);
}
if (! defined $from) {
my $u = $local_url || '';
$u =~ s{/$}{};
return $u.beautify_urlpath("/".$to);
}
my $link = abs2rel($to, dirname(htmlpage($from)));
return beautify_urlpath($link);
}
sub isselflink ($$) {
2010-07-11 11:35:37 +02:00
# Plugins can override this function to support special types
# of selflinks.
my $page=shift;
my $link=shift;
2010-10-04 22:34:33 +02:00
return $page eq $link;
}
sub htmllink ($$$;@) {
my $lpage=shift; # the page doing the linking
my $page=shift; # the page that will contain the link (different for inline)
my $link=shift;
my %opts=@_;
$link=~s/\/$//;
my $bestlink;
if (! $opts{forcesubpage}) {
$bestlink=bestlink($lpage, $link);
}
else {
$bestlink="$lpage/".lc($link);
}
my $linktext;
if (defined $opts{linktext}) {
$linktext=$opts{linktext};
}
else {
$linktext=pagetitle(basename($link));
}
return "<span class=\"selflink\">$linktext</span>"
if length $bestlink && isselflink($page, $bestlink) &&
! defined $opts{anchor};
if (! $destsources{$bestlink}) {
$bestlink=htmlpage($bestlink);
if (! $destsources{$bestlink}) {
my $cgilink = "";
if (length $config{cgiurl}) {
$cgilink = "<a href=\"".
2010-04-21 18:50:34 +02:00
cgiurl(
do => "create",
page => $link,
2010-04-21 18:50:34 +02:00
from => $lpage
)."\" rel=\"nofollow\">?</a>";
}
return "<span class=\"createlink\">$cgilink$linktext</span>"
}
}
$bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
$bestlink=beautify_urlpath($bestlink);
if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
return "<img src=\"$bestlink\" alt=\"$linktext\" />";
}
2007-02-20 02:49:52 +01:00
if (defined $opts{anchor}) {
$bestlink.="#".$opts{anchor};
}
my @attrs;
foreach my $attr (qw{rel class title}) {
if (defined $opts{$attr}) {
push @attrs, " $attr=\"$opts{$attr}\"";
}
}
return "<a href=\"$bestlink\"@attrs>$linktext</a>";
}
sub userpage ($) {
my $user=shift;
return length $config{userdir} ? "$config{userdir}/$user" : $user;
}
# Username to display for openid accounts.
sub openiduser ($) {
my $user=shift;
if (defined $user && $user =~ m!^https?://! &&
eval q{use Net::OpenID::VerifiedIdentity; 1} && !$@) {
my $display;
if (Net::OpenID::VerifiedIdentity->can("DisplayOfURL")) {
$display = Net::OpenID::VerifiedIdentity::DisplayOfURL($user);
}
else {
# backcompat with old version
my $oid=Net::OpenID::VerifiedIdentity->new(identity => $user);
$display=$oid->display;
}
# Convert "user.somehost.com" to "user [somehost.com]"
# (also "user.somehost.co.uk")
if ($display !~ /\[/) {
$display=~s/^([-a-zA-Z0-9]+?)\.([-.a-zA-Z0-9]+\.[a-z]+)$/$1 [$2]/;
}
# Convert "http://somehost.com/user" to "user [somehost.com]".
# (also "https://somehost.com/user/")
if ($display !~ /\[/) {
$display=~s/^https?:\/\/(.+)\/([^\/#?]+)\/?(?:[#?].*)?$/$2 [$1]/;
}
$display=~s!^https?://!!; # make sure this is removed
eval q{use CGI 'escapeHTML'};
error($@) if $@;
return escapeHTML($display);
}
return;
}
# Username to display for emailauth accounts.
sub emailuser ($) {
my $user=shift;
if (defined $user && $user =~ m/(.+)@/) {
my $nick=$1;
# remove any characters from not allowed in wiki files
# support use w/o %config set
my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_";
$nick=~s/[^$chars]/_/g;
return $nick;
}
return;
}
# Some user information should not be exposed in commit metadata, etc.
# This generates a cloaked form of such information.
sub cloak ($) {
my $user=shift;
# cloak email address using http://xmlns.com/foaf/spec/#term_mbox_sha1sum
if ($user=~m/(.+)@/) {
my $nick=$1;
eval q{use Digest::SHA};
return $user if $@;
return $nick.'@'.Digest::SHA::sha1_hex("mailto:$user");
}
else {
return $user;
}
}
sub htmlize ($$$$) {
my $page=shift;
my $destpage=shift;
my $type=shift;
my $content=shift;
2008-01-09 20:45:07 +01:00
my $oneline = $content !~ /\n/;
if (exists $hooks{htmlize}{$type}) {
$content=$hooks{htmlize}{$type}{call}->(
page => $page,
content => $content,
);
}
else {
error("htmlization of $type not supported");
}
run_hooks(sanitize => sub {
$content=shift->(
page => $page,
destpage => $destpage,
content => $content,
);
});
if ($oneline) {
# hack to get rid of enclosing junk added by markdown
# and other htmlizers/sanitizers
$content=~s/^<p>//i;
$content=~s/<\/p>\n*$//i;
}
return $content;
}
sub linkify ($$$) {
my $page=shift;
my $destpage=shift;
my $content=shift;
run_hooks(linkify => sub {
$content=shift->(
page => $page,
2008-02-24 21:58:20 +01:00
destpage => $destpage,
content => $content,
);
});
return $content;
}
our %preprocessing;
our $preprocess_preview=0;
sub preprocess ($$$;$$) {
my $page=shift; # the page the data comes from
my $destpage=shift; # the page the data will appear in (different for inline)
my $content=shift;
my $scan=shift;
my $preview=shift;
# Using local because it needs to be set within any nested calls
# of this function.
local $preprocess_preview=$preview if defined $preview;
my $handle=sub {
my $escape=shift;
my $prefix=shift;
my $command=shift;
my $params=shift;
2008-08-04 20:58:21 +02:00
$params="" if ! defined $params;
2008-08-06 01:39:50 +02:00
if (length $escape) {
return "[[$prefix$command $params]]";
}
elsif (exists $hooks{preprocess}{$command}) {
return "" if $scan && ! $hooks{preprocess}{$command}{scan};
# Note: preserve order of params, some plugins may
# consider it significant.
my @params;
while ($params =~ m{
(?:([-.\w]+)=)? # 1: named parameter key?
(?:
"""(.*?)""" # 2: triple-quoted value
|
"([^"]*?)" # 3: single-quoted value
|
'''(.*?)''' # 4: triple-single-quote
|
<<([a-zA-Z]+)\n # 5: heredoc start
(.*?)\n\5 # 6: heredoc value
|
(\S+) # 7: unquoted value
)
(?:\s+|$) # delimiter to next param
}msgx) {
my $key=$1;
my $val;
if (defined $2) {
$val=$2;
$val=~s/\r\n/\n/mg;
$val=~s/^\n+//g;
$val=~s/\n+$//g;
}
elsif (defined $3) {
$val=$3;
}
elsif (defined $4) {
$val=$4;
}
elsif (defined $7) {
$val=$7;
}
elsif (defined $6) {
$val=$6;
}
if (defined $key) {
push @params, $key, $val;
}
else {
push @params, $val, '';
}
}
if ($preprocessing{$page}++ > 8) {
# Avoid loops of preprocessed pages preprocessing
# other pages that preprocess them, etc.
return "[[!$command <span class=\"error\">".
sprintf(gettext("preprocessing loop detected on %s at depth %i"),
$page, $preprocessing{$page}).
"</span>]]";
}
my $ret;
if (! $scan) {
$ret=eval {
$hooks{preprocess}{$command}{call}->(
@params,
page => $page,
destpage => $destpage,
preview => $preprocess_preview,
);
};
if ($@) {
my $error=$@;
chomp $error;
eval q{use HTML::Entities};
$error = encode_entities($error);
# Also encode most ASCII punctuation
# as entities so that error messages
# are not interpreted as Markdown etc.
$error = encode_entities($error, '[](){}!#$%*?@^`|~'."\\");
$ret="[[!$command <span class=\"error\">".
gettext("Error").": $error"."</span>]]";
}
}
else {
# use void context during scan pass
eval {
$hooks{preprocess}{$command}{call}->(
@params,
page => $page,
destpage => $destpage,
preview => $preprocess_preview,
);
};
$ret="";
}
$preprocessing{$page}--;
return $ret;
}
else {
return "[[$prefix$command $params]]";
}
};
my $regex;
if ($config{prefix_directives}) {
$regex = qr{
(\\?) # 1: escape?
\[\[(!) # directive open; 2: prefix
([-\w]+) # 3: command
( # 4: the parameters..
\s+ # Must have space if parameters present
(?:
(?:[-.\w]+=)? # named parameter key?
(?:
""".*?""" # triple-quoted value
|
"[^"]*?" # single-quoted value
|
'''.*?''' # triple-single-quote
|
<<([a-zA-Z]+)\n # 5: heredoc start
(?:.*?)\n\5 # heredoc value
|
[^"\s\]]+ # unquoted value
)
\s* # whitespace or end
# of directive
)
*)? # 0 or more parameters
\]\] # directive closed
}sx;
2008-07-17 06:22:25 +02:00
}
else {
$regex = qr{
(\\?) # 1: escape?
\[\[(!?) # directive open; 2: optional prefix
([-\w]+) # 3: command
\s+
( # 4: the parameters..
(?:
(?:[-.\w]+=)? # named parameter key?
(?:
""".*?""" # triple-quoted value
|
"[^"]*?" # single-quoted value
|
'''.*?''' # triple-single-quote
|
<<([a-zA-Z]+)\n # 5: heredoc start
(?:.*?)\n\5 # heredoc value
|
[^"\s\]]+ # unquoted value
)
\s* # whitespace or end
# of directive
)
*) # 0 or more parameters
\]\] # directive closed
}sx;
}
2008-08-04 20:58:21 +02:00
$content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
return $content;
}
sub filter ($$$) {
my $page=shift;
my $destpage=shift;
my $content=shift;
run_hooks(filter => sub {
$content=shift->(page => $page, destpage => $destpage,
content => $content);
});
return $content;
}
sub check_canedit ($$$;$) {
my $page=shift;
my $q=shift;
my $session=shift;
my $nonfatal=shift;
my $canedit;
run_hooks(canedit => sub {
return if defined $canedit;
my $ret=shift->($page, $q, $session);
if (defined $ret) {
if ($ret eq "") {
$canedit=1;
}
elsif (ref $ret eq 'CODE') {
$ret->() unless $nonfatal;
$canedit=0;
}
elsif (defined $ret) {
error($ret) unless $nonfatal;
$canedit=0;
}
}
});
return defined $canedit ? $canedit : 1;
}
sub check_content (@) {
my %params=@_;
return 1 if ! exists $hooks{checkcontent}; # optimisation
if (exists $pagesources{$params{page}}) {
my @diff;
my %old=map { $_ => 1 }
split("\n", readfile(srcfile($pagesources{$params{page}})));
foreach my $line (split("\n", $params{content})) {
push @diff, $line if ! exists $old{$line};
}
$params{diff}=join("\n", @diff);
}
my $ok;
run_hooks(checkcontent => sub {
return if defined $ok;
my $ret=shift->(%params);
if (defined $ret) {
if ($ret eq "") {
$ok=1;
}
elsif (ref $ret eq 'CODE') {
$ret->() unless $params{nonfatal};
$ok=0;
}
elsif (defined $ret) {
error($ret) unless $params{nonfatal};
$ok=0;
}
}
});
return defined $ok ? $ok : 1;
}
sub check_canchange (@) {
my %params = @_;
my $cgi = $params{cgi};
my $session = $params{session};
my @changes = @{$params{changes}};
my %newfiles;
foreach my $change (@changes) {
# This untaint is safe because we check file_pruned and
# wiki_file_regexp.
my ($file)=$change->{file}=~/$config{wiki_file_regexp}/;
$file=possibly_foolish_untaint($file);
if (! defined $file || ! length $file ||
file_pruned($file)) {
error(sprintf(gettext("bad file name %s"), $file));
}
my $type=pagetype($file);
my $page=pagename($file) if defined $type;
if ($change->{action} eq 'add') {
$newfiles{$file}=1;
}
if ($change->{action} eq 'change' ||
$change->{action} eq 'add') {
if (defined $page) {
check_canedit($page, $cgi, $session);
next;
}
else {
if (IkiWiki::Plugin::attachment->can("check_canattach")) {
IkiWiki::Plugin::attachment::check_canattach($session, $file, $change->{path});
check_canedit($file, $cgi, $session);
next;
}
}
}
elsif ($change->{action} eq 'remove') {
# check_canremove tests to see if the file is present
# on disk. This will fail when a single commit adds a
# file and then removes it again. Avoid the problem
# by not testing the removal in such pairs of changes.
# (The add is still tested, just to make sure that
# no data is added to the repo that a web edit
# could not add.)
next if $newfiles{$file};
if (IkiWiki::Plugin::remove->can("check_canremove")) {
IkiWiki::Plugin::remove::check_canremove(defined $page ? $page : $file, $cgi, $session);
check_canedit(defined $page ? $page : $file, $cgi, $session);
next;
}
}
else {
error "unknown action ".$change->{action};
}
error sprintf(gettext("you are not allowed to change %s"), $file);
}
}
my $wikilock;
sub lockwiki () {
# Take an exclusive lock on the wiki to prevent multiple concurrent
# run issues. The lock will be dropped on program exit.
if (! -d $config{wikistatedir}) {
mkdir($config{wikistatedir});
}
open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
error ("cannot write to $config{wikistatedir}/lockfile: $!");
if (! flock($wikilock, LOCK_EX | LOCK_NB)) {
2014-12-02 16:38:17 +01:00
debug("failed to get lock; waiting...");
if (! flock($wikilock, LOCK_EX)) {
error("failed to get lock");
}
}
return 1;
}
sub unlockwiki () {
POSIX::close($ENV{IKIWIKI_CGILOCK_FD}) if exists $ENV{IKIWIKI_CGILOCK_FD};
return close($wikilock) if $wikilock;
return;
}
my $commitlock;
sub commit_hook_enabled () {
open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
error("cannot write to $config{wikistatedir}/commitlock: $!");
if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
close($commitlock) || error("failed closing commitlock: $!");
return 0;
}
close($commitlock) || error("failed closing commitlock: $!");
return 1;
}
sub disable_commit_hook () {
open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
error("cannot write to $config{wikistatedir}/commitlock: $!");
if (! flock($commitlock, 2)) { # LOCK_EX
error("failed to get commit lock");
}
return 1;
}
sub enable_commit_hook () {
return close($commitlock) if $commitlock;
return;
}
sub loadindex () {
%oldrenderedfiles=%pagectime=();
my $rebuild=$config{rebuild};
if (! $rebuild) {
%pagesources=%pagemtime=%oldlinks=%links=%depends=
%destsources=%renderedfiles=%pagecase=%pagestate=
%depends_simple=%typedlinks=%oldtypedlinks=();
}
2008-03-21 14:37:52 +01:00
my $in;
if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
if (-e "$config{wikistatedir}/index") {
2008-03-21 18:56:52 +01:00
system("ikiwiki-transition", "indexdb", $config{srcdir});
2008-03-21 14:37:52 +01:00
open ($in, "<", "$config{wikistatedir}/indexdb") || return;
}
else {
# gettime on first build
$config{gettime}=1 unless defined $config{gettime};
2008-03-21 14:37:52 +01:00
return;
}
}
my $index=Storable::fd_retrieve($in);
if (! defined $index) {
return 0;
}
my $pages;
if (exists $index->{version} && ! ref $index->{version}) {
$pages=$index->{page};
%wikistate=%{$index->{state}};
# Handle plugins that got disabled by loading a new setup.
if (exists $config{setupfile}) {
require IkiWiki::Setup;
IkiWiki::Setup::disabled_plugins(
grep { ! $loaded_plugins{$_} } keys %wikistate);
}
}
else {
$pages=$index;
%wikistate=();
}
foreach my $src (keys %$pages) {
my $d=$pages->{$src};
my $page;
if (exists $d->{page} && ! $rebuild) {
$page=$d->{page};
}
else {
$page=pagename($src);
}
$pagectime{$page}=$d->{ctime};
$pagesources{$page}=$src;
if (! $rebuild) {
$pagemtime{$page}=$d->{mtime};
$renderedfiles{$page}=$d->{dest};
if (exists $d->{links} && ref $d->{links}) {
$links{$page}=$d->{links};
$oldlinks{$page}=[@{$d->{links}}];
}
if (ref $d->{depends_simple} eq 'ARRAY') {
# old format
$depends_simple{$page}={
map { $_ => 1 } @{$d->{depends_simple}}
};
}
elsif (exists $d->{depends_simple}) {
2009-10-07 01:03:23 +02:00
$depends_simple{$page}=$d->{depends_simple};
}
if (exists $d->{dependslist}) {
# old format
$depends{$page}={
map { $_ => $DEPEND_CONTENT }
@{$d->{dependslist}}
};
}
elsif (exists $d->{depends} && ! ref $d->{depends}) {
# old format
$depends{$page}={$d->{depends} => $DEPEND_CONTENT };
}
elsif (exists $d->{depends}) {
$depends{$page}=$d->{depends};
}
if (exists $d->{state}) {
$pagestate{$page}=$d->{state};
}
if (exists $d->{typedlinks}) {
$typedlinks{$page}=$d->{typedlinks};
while (my ($type, $links) = each %{$typedlinks{$page}}) {
next unless %$links;
$oldtypedlinks{$page}{$type} = {%$links};
}
}
}
$oldrenderedfiles{$page}=[@{$d->{dest}}];
}
foreach my $page (keys %pagesources) {
$pagecase{lc $page}=$page;
}
foreach my $page (keys %renderedfiles) {
$destsources{$_}=$page foreach @{$renderedfiles{$page}};
}
$lastrev=$index->{lastrev};
@underlayfiles=@{$index->{underlayfiles}} if ref $index->{underlayfiles};
return close($in);
}
sub saveindex () {
2006-07-30 03:38:50 +02:00
run_hooks(savestate => sub { shift->() });
my @plugins=keys %loaded_plugins;
if (! -d $config{wikistatedir}) {
mkdir($config{wikistatedir});
}
2008-03-21 14:37:52 +01:00
my $newfile="$config{wikistatedir}/indexdb.new";
my $cleanup = sub { unlink($newfile) };
open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
my %index;
foreach my $page (keys %pagemtime) {
next unless $pagemtime{$page};
my $src=$pagesources{$page};
$index{page}{$src}={
page => $page,
ctime => $pagectime{$page},
mtime => $pagemtime{$page},
dest => $renderedfiles{$page},
links => $links{$page},
};
if (exists $depends{$page}) {
$index{page}{$src}{depends} = $depends{$page};
}
if (exists $depends_simple{$page}) {
$index{page}{$src}{depends_simple} = $depends_simple{$page};
}
if (exists $typedlinks{$page} && %{$typedlinks{$page}}) {
$index{page}{$src}{typedlinks} = $typedlinks{$page};
}
if (exists $pagestate{$page}) {
$index{page}{$src}{state}=$pagestate{$page};
}
}
$index{state}={};
foreach my $id (@plugins) {
$index{state}{$id}={}; # used to detect disabled plugins
foreach my $key (keys %{$wikistate{$id}}) {
$index{state}{$id}{$key}=$wikistate{$id}{$key};
}
}
$index{lastrev}=$lastrev;
$index{underlayfiles}=\@underlayfiles;
$index{version}="3";
my $ret=Storable::nstore_fd(\%index, $out);
return if ! defined $ret || ! $ret;
close $out || error("failed saving to $newfile: $!", $cleanup);
2008-03-21 14:37:52 +01:00
rename($newfile, "$config{wikistatedir}/indexdb") ||
error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
return 1;
}
sub template_file ($) {
my $name=shift;
2010-04-25 01:50:23 +02:00
my $tpage=($name =~ s/^\///) ? $name : "templates/$name";
my $template;
if ($name !~ /\.tmpl$/ && exists $pagesources{$tpage}) {
$template=srcfile($pagesources{$tpage}, 1);
$name.=".tmpl";
}
else {
$template=srcfile($tpage, 1);
}
if (defined $template) {
return $template, $tpage, 1 if wantarray;
return $template;
}
else {
2010-04-23 22:20:02 +02:00
$name=~s:/::; # avoid path traversal
foreach my $dir ($config{templatedir},
"$installdir/share/ikiwiki/templates") {
if (-e "$dir/$name") {
$template="$dir/$name";
last;
}
}
if (defined $template) {
return $template, $tpage if wantarray;
return $template;
}
}
return;
}
sub template_depends ($$;@) {
my $name=shift;
my $page=shift;
my ($filename, $tpage, $untrusted)=template_file($name);
if (! defined $filename) {
error(sprintf(gettext("template %s not found"), $name))
}
if (defined $page && defined $tpage) {
add_depends($page, $tpage);
}
2014-02-21 22:10:43 +01:00
my @opts=(
filter => sub {
my $text_ref = shift;
${$text_ref} = decode_utf8(${$text_ref});
2014-02-21 22:10:43 +01:00
run_hooks(readtemplate => sub {
${$text_ref} = shift->(
id => $name,
page => $tpage,
content => ${$text_ref},
untrusted => $untrusted,
);
});
},
loop_context_vars => 1,
die_on_bad_params => 0,
parent_global_vars => 1,
filename => $filename,
@_,
($untrusted ? (no_includes => 1) : ()),
);
return @opts if wantarray;
require HTML::Template;
return HTML::Template->new(@opts);
}
sub template ($;@) {
template_depends(shift, undef, @_);
}
2010-05-15 02:20:41 +02:00
sub templateactions ($$) {
my $template=shift;
my $page=shift;
my $have_actions=0;
my @actions;
run_hooks(pageactions => sub {
push @actions, map { { action => $_ } }
2010-05-15 02:20:41 +02:00
grep { defined } shift->(page => $page);
});
$template->param(actions => \@actions);
2010-05-15 02:20:41 +02:00
if ($config{cgiurl} && exists $hooks{auth}) {
$template->param(prefsurl => cgiurl(do => "prefs"));
$have_actions=1;
}
2010-05-15 02:20:41 +02:00
if ($have_actions || @actions) {
$template->param(have_actions => 1);
}
}
sub hook (@) {
my %param=@_;
if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
error 'hook requires type, call, and id parameters';
}
return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
$hooks{$param{type}}{$param{id}}=\%param;
return 1;
}
sub run_hooks ($$) {
# Calls the given sub for each hook of the given type,
# passing it the hook function to call.
my $type=shift;
my $sub=shift;
if (exists $hooks{$type}) {
inline: Run format hook first inline has a format hook that is an optimisation hack. Until this hook runs, the inlined content is not present on the page. This can prevent other format hooks, that process that content, from acting on inlined content. In bug ##509710, we discovered this happened commonly for the embed plugin, but it could in theory happen for many other plugins (color, cutpaste, etc) that use format to fill in special html after sanitization. The ordering was essentially random (hash key order). That's kinda a good thing, because hooks should be independent of other hooks and able to run in any order. But for things like inline, that just doesn't work. To fix the immediate problem, let's make hooks able to be registered as running "first". There was already the ability to make them run "last". Now, this simple first/middle/last ordering is obviously not going to work if a lot of things need to run first, or last, since then we'll be back to being unable to specify ordering inside those sets. But before worrying about that too much, and considering dependency ordering, etc, observe how few plugins use last ordering: Exactly one needs it. And, so far, exactly one needs first ordering. So for now, KISS. Another implementation note: I could have sorted the plugins with first/last/middle as the primary key, and plugin name secondary, to get a guaranteed stable order. Instead, I chose to preserve hash order. Two opposing things pulled me toward that decision: 1. Since has order is randomish, it will ensure that no accidental ordering assumptions are made. 2. Assume for a minute that ordering matters a lot more than expected. Drastically changing the order a particular configuration uses could result in a lot of subtle bugs cropping up. (I hope this assumption is false, partly due to #1, but can't rule it out.)
2008-12-26 22:08:33 +01:00
my (@first, @middle, @last);
foreach my $id (keys %{$hooks{$type}}) {
inline: Run format hook first inline has a format hook that is an optimisation hack. Until this hook runs, the inlined content is not present on the page. This can prevent other format hooks, that process that content, from acting on inlined content. In bug ##509710, we discovered this happened commonly for the embed plugin, but it could in theory happen for many other plugins (color, cutpaste, etc) that use format to fill in special html after sanitization. The ordering was essentially random (hash key order). That's kinda a good thing, because hooks should be independent of other hooks and able to run in any order. But for things like inline, that just doesn't work. To fix the immediate problem, let's make hooks able to be registered as running "first". There was already the ability to make them run "last". Now, this simple first/middle/last ordering is obviously not going to work if a lot of things need to run first, or last, since then we'll be back to being unable to specify ordering inside those sets. But before worrying about that too much, and considering dependency ordering, etc, observe how few plugins use last ordering: Exactly one needs it. And, so far, exactly one needs first ordering. So for now, KISS. Another implementation note: I could have sorted the plugins with first/last/middle as the primary key, and plugin name secondary, to get a guaranteed stable order. Instead, I chose to preserve hash order. Two opposing things pulled me toward that decision: 1. Since has order is randomish, it will ensure that no accidental ordering assumptions are made. 2. Assume for a minute that ordering matters a lot more than expected. Drastically changing the order a particular configuration uses could result in a lot of subtle bugs cropping up. (I hope this assumption is false, partly due to #1, but can't rule it out.)
2008-12-26 22:08:33 +01:00
if ($hooks{$type}{$id}{first}) {
push @first, $id;
}
elsif ($hooks{$type}{$id}{last}) {
push @last, $id;
}
else {
push @middle, $id;
}
}
inline: Run format hook first inline has a format hook that is an optimisation hack. Until this hook runs, the inlined content is not present on the page. This can prevent other format hooks, that process that content, from acting on inlined content. In bug ##509710, we discovered this happened commonly for the embed plugin, but it could in theory happen for many other plugins (color, cutpaste, etc) that use format to fill in special html after sanitization. The ordering was essentially random (hash key order). That's kinda a good thing, because hooks should be independent of other hooks and able to run in any order. But for things like inline, that just doesn't work. To fix the immediate problem, let's make hooks able to be registered as running "first". There was already the ability to make them run "last". Now, this simple first/middle/last ordering is obviously not going to work if a lot of things need to run first, or last, since then we'll be back to being unable to specify ordering inside those sets. But before worrying about that too much, and considering dependency ordering, etc, observe how few plugins use last ordering: Exactly one needs it. And, so far, exactly one needs first ordering. So for now, KISS. Another implementation note: I could have sorted the plugins with first/last/middle as the primary key, and plugin name secondary, to get a guaranteed stable order. Instead, I chose to preserve hash order. Two opposing things pulled me toward that decision: 1. Since has order is randomish, it will ensure that no accidental ordering assumptions are made. 2. Assume for a minute that ordering matters a lot more than expected. Drastically changing the order a particular configuration uses could result in a lot of subtle bugs cropping up. (I hope this assumption is false, partly due to #1, but can't rule it out.)
2008-12-26 22:08:33 +01:00
foreach my $id (@first, @middle, @last) {
$sub->($hooks{$type}{$id}{call});
}
}
return 1;
}
sub rcs_update () {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_update}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_prepedit ($) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_prepedit}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_commit (@) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_commit}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_commit_staged (@) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_commit_staged}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_add ($) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_add}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_remove ($) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_remove}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_rename ($$) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_rename}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_recentchanges ($) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_recentchanges}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_diff ($;$) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_diff}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_getctime ($) {
2008-07-27 04:27:58 +02:00
$hooks{rcs}{rcs_getctime}{call}->(@_);
}
2008-07-27 04:27:58 +02:00
sub rcs_getmtime ($) {
$hooks{rcs}{rcs_getmtime}{call}->(@_);
}
sub rcs_receive () {
$hooks{rcs}{rcs_receive}{call}->();
}
2009-10-08 22:49:53 +02:00
sub add_depends ($$;$) {
2007-01-28 01:35:32 +01:00
my $page=shift;
my $pagespec=shift;
2009-10-08 22:49:53 +02:00
my $deptype=shift || $DEPEND_CONTENT;
# Is the pagespec a simple page name?
if ($pagespec =~ /$config{wiki_file_regexp}/ &&
$pagespec !~ /[\s*?()!]/) {
$depends_simple{$page}{lc $pagespec} |= $deptype;
return 1;
2007-01-28 01:35:32 +01:00
}
# Add explicit dependencies for influences.
my $sub=pagespec_translate($pagespec);
return unless defined $sub;
foreach my $p (keys %pagesources) {
my $r=$sub->($p, location => $page);
my $i=$r->influences;
my $static=$r->influences_static;
foreach my $k (keys %$i) {
next unless $r || $static || $k eq $page;
$depends_simple{$page}{lc $k} |= $i->{$k};
}
last if $static;
}
2009-10-08 22:49:53 +02:00
$depends{$page}{$pagespec} |= $deptype;
return 1;
}
sub deptype (@) {
my $deptype=0;
foreach my $type (@_) {
if ($type eq 'presence') {
$deptype |= $DEPEND_PRESENCE;
}
elsif ($type eq 'links') {
$deptype |= $DEPEND_LINKS;
}
elsif ($type eq 'content') {
$deptype |= $DEPEND_CONTENT;
}
}
return $deptype;
}
2007-01-28 01:35:32 +01:00
my $file_prune_regexp;
2010-04-20 20:08:29 +02:00
sub file_pruned ($) {
my $file=shift;
if (defined $config{include} && length $config{include}) {
return 0 if $file =~ m/$config{include}/;
}
2007-01-28 01:35:32 +01:00
if (! defined $file_prune_regexp) {
$file_prune_regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
$file_prune_regexp=qr/$file_prune_regexp/;
}
return $file =~ m/$file_prune_regexp/;
}
2007-01-28 01:35:32 +01:00
sub define_gettext () {
# If translation is needed, redefine the gettext function to do it.
# Otherwise, it becomes a quick no-op.
my $gettext_obj;
my $getobj;
if ((exists $ENV{LANG} && length $ENV{LANG}) ||
(exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
(exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
$getobj=sub {
$gettext_obj=eval q{
2007-01-28 01:35:32 +01:00
use Locale::gettext q{textdomain};
Locale::gettext->domain('ikiwiki')
};
};
2007-01-28 01:35:32 +01:00
}
no warnings 'redefine';
*gettext=sub {
$getobj->() if $getobj;
if ($gettext_obj) {
$gettext_obj->get(shift);
}
else {
return shift;
}
};
2010-04-17 18:54:22 +02:00
*ngettext=sub {
$getobj->() if $getobj;
if ($gettext_obj) {
$gettext_obj->nget(@_);
}
else {
return ($_[2] == 1 ? $_[0] : $_[1])
}
};
}
2007-01-28 01:35:32 +01:00
sub gettext {
define_gettext();
gettext(@_);
}
sub ngettext {
define_gettext();
ngettext(@_);
}
sub yesno ($) {
my $val=shift;
return (defined $val && (lc($val) eq gettext("yes") || lc($val) eq "yes" || $val eq "1"));
}
sub inject {
# Injects a new function into the symbol table to replace an
# exported function.
my %params=@_;
# This is deep ugly perl foo, beware.
no strict;
no warnings;
if (! defined $params{parent}) {
$params{parent}='::';
$params{old}=\&{$params{name}};
$params{name}=~s/.*:://;
}
my $parent=$params{parent};
foreach my $ns (grep /^\w+::/, keys %{$parent}) {
$ns = $params{parent} . $ns;
inject(%params, parent => $ns) unless $ns eq '::main::';
*{$ns . $params{name}} = $params{call}
if exists ${$ns}{$params{name}} &&
\&{${$ns}{$params{name}}} == $params{old};
}
use strict;
use warnings;
}
sub add_link ($$;$) {
my $page=shift;
my $link=shift;
my $type=shift;
push @{$links{$page}}, $link
unless grep { $_ eq $link } @{$links{$page}};
if (defined $type) {
$typedlinks{$page}{$type}{$link} = 1;
}
}
sub add_autofile ($$$) {
my $file=shift;
my $plugin=shift;
my $generator=shift;
$autofiles{$file}{plugin}=$plugin;
$autofiles{$file}{generator}=$generator;
}
sub useragent () {
return LWP::UserAgent->new(
cookie_jar => $config{cookiejar},
env_proxy => 1, # respect proxy env vars
agent => $config{useragent},
);
}
sub sortspec_translate ($$) {
my $spec = shift;
my $reverse = shift;
my $code = "";
my @data;
while ($spec =~ m{
\s*
(-?) # group 1: perhaps negated
\s*
( # group 2: a word
\w+\([^\)]*\) # command(params)
|
[^\s]+ # or anything else
)
\s*
}gx) {
my $negated = $1;
my $word = $2;
my $params = undef;
if ($word =~ m/^(\w+)\((.*)\)$/) {
# command with parameters
$params = $2;
$word = $1;
}
elsif ($word !~ m/^\w+$/) {
error(sprintf(gettext("invalid sort type %s"), $word));
}
if (length $code) {
$code .= " || ";
}
if ($negated) {
$code .= "-";
}
if (exists $IkiWiki::SortSpec::{"cmp_$word"}) {
if (defined $params) {
push @data, $params;
$code .= "IkiWiki::SortSpec::cmp_$word(\$data[$#data])";
}
else {
$code .= "IkiWiki::SortSpec::cmp_$word(undef)";
}
}
else {
error(sprintf(gettext("unknown sort type %s"), $word));
}
}
if (! length $code) {
# undefined sorting method... sort arbitrarily
return sub { 0 };
}
if ($reverse) {
$code="-($code)";
}
no warnings;
return eval 'sub { '.$code.' }';
}
sub pagespec_translate ($) {
my $spec=shift;
# Convert spec to perl code.
my $code="";
my @data;
while ($spec=~m{
\s* # ignore whitespace
( # 1: match a single word
\! # !
|
\( # (
|
\) # )
|
\w+\([^\)]*\) # command(params)
|
[^\s()]+ # any other text
)
\s* # ignore whitespace
}gx) {
my $word=$1;
if (lc $word eq 'and') {
$code.=' &';
}
elsif (lc $word eq 'or') {
$code.=' |';
}
elsif ($word eq "(" || $word eq ")" || $word eq "!") {
$code.=' '.$word;
}
elsif ($word =~ /^(\w+)\((.*)\)$/) {
if (exists $IkiWiki::PageSpec::{"match_$1"}) {
push @data, $2;
$code.="IkiWiki::PageSpec::match_$1(\$page, \$data[$#data], \@_)";
}
else {
push @data, qq{unknown function in pagespec "$word"};
$code.="IkiWiki::ErrorReason->new(\$data[$#data])";
}
}
else {
push @data, $word;
$code.=" IkiWiki::PageSpec::match_glob(\$page, \$data[$#data], \@_)";
}
}
if (! length $code) {
$code="IkiWiki::FailReason->new('empty pagespec')";
}
no warnings;
return eval 'sub { my $page=shift; '.$code.' }';
}
sub pagespec_match ($$;@) {
my $page=shift;
my $spec=shift;
my @params=@_;
# Backwards compatability with old calling convention.
if (@params == 1) {
unshift @params, 'location';
}
my $sub=pagespec_translate($spec);
return IkiWiki::ErrorReason->new("syntax error in pagespec \"$spec\"")
if ! defined $sub;
return $sub->($page, @params);
}
# e.g. @pages = sort_pages("title", \@pages, reverse => "yes")
#
# Not exported yet, but could be in future if it is generally useful.
# Note that this signature is not the same as IkiWiki::SortSpec::sort_pages,
# which is "more internal".
sub sort_pages ($$;@) {
my $sort = shift;
my $list = shift;
my %params = @_;
$sort = sortspec_translate($sort, $params{reverse});
return IkiWiki::SortSpec::sort_pages($sort, @$list);
}
sub pagespec_match_list ($$;@) {
my $page=shift;
my $pagespec=shift;
my %params=@_;
# Backwards compatability with old calling convention.
if (ref $page) {
print STDERR "warning: a plugin (".caller().") is using pagespec_match_list in an obsolete way, and needs to be updated\n";
$params{list}=$page;
$page=$params{location}; # ugh!
}
my $sub=pagespec_translate($pagespec);
error "syntax error in pagespec \"$pagespec\""
if ! defined $sub;
2010-04-12 18:41:32 +02:00
my $sort=sortspec_translate($params{sort}, $params{reverse})
if defined $params{sort};
my @candidates;
if (exists $params{list}) {
@candidates=exists $params{filter}
? grep { ! $params{filter}->($_) } @{$params{list}}
: @{$params{list}};
}
else {
@candidates=exists $params{filter}
? grep { ! $params{filter}->($_) } keys %pagesources
: keys %pagesources;
}
2010-04-12 18:41:32 +02:00
# clear params, remainder is passed to pagespec
$depends{$page}{$pagespec} |= ($params{deptype} || $DEPEND_CONTENT);
my $num=$params{num};
2010-04-12 18:41:32 +02:00
delete @params{qw{num deptype reverse sort filter list}};
# when only the top matches will be returned, it's efficient to
# sort before matching to pagespec,
if (defined $num && defined $sort) {
@candidates=IkiWiki::SortSpec::sort_pages(
2010-04-12 18:41:32 +02:00
$sort, @candidates);
}
my @matches;
my $firstfail;
my $count=0;
my $accum=IkiWiki::SuccessReason->new();
foreach my $p (@candidates) {
my $r=$sub->($p, %params, location => $page);
error(sprintf(gettext("cannot match pages: %s"), $r))
if $r->isa("IkiWiki::ErrorReason");
unless ($r || $r->influences_static) {
$r->remove_influence($p);
}
$accum |= $r;
if ($r) {
push @matches, $p;
last if defined $num && ++$count == $num;
}
}
# Add simple dependencies for accumulated influences.
my $i=$accum->influences;
foreach my $k (keys %$i) {
$depends_simple{$page}{lc $k} |= $i->{$k};
}
# when all matches will be returned, it's efficient to
# sort after matching
if (! defined $num && defined $sort) {
return IkiWiki::SortSpec::sort_pages(
2010-04-12 18:41:32 +02:00
$sort, @matches);
}
else {
return @matches;
}
}
sub pagespec_valid ($) {
my $spec=shift;
return defined pagespec_translate($spec);
}
sub glob2re ($) {
2008-07-02 23:33:37 +02:00
my $re=quotemeta(shift);
$re=~s/\\\*/.*/g;
$re=~s/\\\?/./g;
return qr/^$re$/i;
}
package IkiWiki::FailReason;
use overload (
'""' => sub { $_[0][0] },
2007-04-27 19:01:52 +02:00
'0+' => sub { 0 },
'!' => sub { bless $_[0], 'IkiWiki::SuccessReason'},
'&' => sub { $_[0]->merge_influences($_[1], 1); $_[0] },
2009-10-08 03:48:03 +02:00
'|' => sub { $_[1]->merge_influences($_[0]); $_[1] },
fallback => 1,
);
our @ISA = 'IkiWiki::SuccessReason';
package IkiWiki::SuccessReason;
# A blessed array-ref:
#
# [0]: human-readable reason for success (or, in FailReason subclass, failure)
# [1]{""}:
# - if absent or false, the influences of this evaluation are "static",
# see the influences_static method
# - if true, they are dynamic (not static)
# [1]{any other key}:
# the dependency types of influences, as returned by the influences method
use overload (
# in string context, it's the human-readable reason
'""' => sub { $_[0][0] },
# in boolean context, SuccessReason is 1 and FailReason is 0
2007-04-27 19:01:52 +02:00
'0+' => sub { 1 },
# negating a result gives the opposite result with the same influences
'!' => sub { bless $_[0], 'IkiWiki::FailReason'},
# A & B = (A ? B : A) with the influences of both
'&' => sub { $_[1]->merge_influences($_[0], 1); $_[1] },
# A | B = (A ? A : B) with the influences of both
2009-10-08 03:48:03 +02:00
'|' => sub { $_[0]->merge_influences($_[1]); $_[0] },
fallback => 1,
);
# SuccessReason->new("human-readable reason", page => deptype, ...)
sub new {
my $class = shift;
my $value = shift;
2009-10-08 03:48:03 +02:00
return bless [$value, {@_}], $class;
}
# influences(): return a reference to a copy of the hash
# { page => dependency type } describing the pages that indirectly influenced
# this result, but would not cause a dependency through ikiwiki's core
# dependency logic.
#
# See [[todo/dependency_types]] for extensive discussion of what this means.
#
# influences(page => deptype, ...): remove all influences, replace them
# with the arguments, and return a reference to a copy of the new influences.
sub influences {
my $this=shift;
$this->[1]={@_} if @_;
my %i=%{$this->[1]};
delete $i{""};
return \%i;
}
# True if this result has the same influences whichever page it matches,
# For instance, whether bar matches backlink(foo) is influenced only by
# the set of links in foo, so its only influence is { foo => DEPEND_LINKS },
# which does not mention bar anywhere.
#
# False if this result would have different influences when matching
# different pages. For instance, when testing whether link(foo) matches bar,
# { bar => DEPEND_LINKS } is an influence on that result, because changing
# bar's links could change the outcome; so its influences are not the same
# as when testing whether link(foo) matches baz.
#
# Static influences are one of the things that make pagespec_match_list
# more efficient than repeated calls to pagespec_match.
sub influences_static {
return ! $_[0][1]->{""};
2009-10-08 03:48:03 +02:00
}
# Change the influences of $this to be the influences of "$this & $other"
# or "$this | $other".
#
# If both $this and $other are either successful or have influences,
# or this is an "or" operation, the result has all the influences from
# either of the arguments. It has dynamic influences if either argument
# has dynamic influences.
#
# If this is an "and" operation, and at least one argument is a
# FailReason with no influences, the result has no influences, and they
# are not dynamic. For instance, link(foo) matching bar is influenced
# by bar, but enabled(ddate) has no influences. Suppose ddate is disabled;
# then (link(foo) and enabled(ddate)) not matching bar is not influenced by
# bar, because it would be false however often you edit bar.
2009-10-08 03:48:03 +02:00
sub merge_influences {
my $this=shift;
my $other=shift;
my $anded=shift;
# This "if" is odd because it needs to avoid negating $this
# or $other, which would alter the objects in-place. Be careful.
if (! $anded || (($this || %{$this->[1]}) &&
2010-04-22 03:38:53 +02:00
($other || %{$other->[1]}))) {
foreach my $influence (keys %{$other->[1]}) {
$this->[1]{$influence} |= $other->[1]{$influence};
}
}
else {
# influence blocker
$this->[1]={};
2009-10-08 03:48:03 +02:00
}
}
# Change $this so it is not considered to be influenced by $torm.
sub remove_influence {
my $this=shift;
my $torm=shift;
delete $this->[1]{$torm};
}
package IkiWiki::ErrorReason;
our @ISA = 'IkiWiki::FailReason';
package IkiWiki::PageSpec;
sub derel ($$) {
my $path=shift;
my $from=shift;
if ($path =~ m!^\.(/|$)!) {
if ($1) {
$from=~s#/?[^/]+$## if defined $from;
$path=~s#^\./##;
$path="$from/$path" if defined $from && length $from;
}
else {
$path = $from;
$path = "" unless defined $path;
}
}
return $path;
}
2010-11-14 17:22:15 +01:00
my %glob_cache;
sub match_glob ($$;@) {
my $page=shift;
my $glob=shift;
my %params=@_;
$glob=derel($glob, $params{location});
2010-11-14 17:22:15 +01:00
# Instead of converting the glob to a regex every time,
# cache the compiled regex to save time.
2010-11-20 17:25:52 +01:00
my $re=$glob_cache{$glob};
unless (defined $re) {
$glob_cache{$glob} = $re = IkiWiki::glob2re($glob);
2010-11-14 17:22:15 +01:00
}
2010-11-20 17:25:52 +01:00
if ($page =~ $re) {
if (! IkiWiki::isinternal($page) || $params{internal}) {
return IkiWiki::SuccessReason->new("$glob matches $page");
}
else {
return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
}
}
else {
return IkiWiki::FailReason->new("$glob does not match $page");
}
}
sub match_internal ($$;@) {
2010-05-07 02:46:58 +02:00
return match_glob(shift, shift, @_, internal => 1)
}
sub match_page ($$;@) {
my $page=shift;
2010-05-07 02:46:58 +02:00
my $match=match_glob($page, shift, @_);
if ($match) {
my $source=exists $IkiWiki::pagesources{$page} ?
$IkiWiki::pagesources{$page} :
$IkiWiki::delpagesources{$page};
my $type=defined $source ? IkiWiki::pagetype($source) : undef;
if (! defined $type) {
return IkiWiki::FailReason->new("$page is not a page");
}
}
return $match;
}
sub match_link ($$;@) {
my $page=shift;
my $link=lc(shift);
my %params=@_;
$link=derel($link, $params{location});
my $from=exists $params{location} ? $params{location} : '';
my $linktype=$params{linktype};
my $qualifier='';
if (defined $linktype) {
$qualifier=" with type $linktype";
}
my $links = $IkiWiki::links{$page};
return IkiWiki::FailReason->new("$page has no links", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
2009-10-08 03:48:03 +02:00
unless $links && @{$links};
my $bestlink = IkiWiki::bestlink($from, $link);
foreach my $p (@{$links}) {
next unless (! defined $linktype || exists $IkiWiki::typedlinks{$page}{$linktype}{$p});
if (length $bestlink) {
if ($bestlink eq IkiWiki::bestlink($page, $p)) {
return IkiWiki::SuccessReason->new("$page links to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
}
}
else {
if (match_glob($p, $link, %params)) {
return IkiWiki::SuccessReason->new("$page links to page $p$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
}
my ($p_rel)=$p=~/^\/?(.*)/;
$link=~s/^\///;
if (match_glob($p_rel, $link, %params)) {
return IkiWiki::SuccessReason->new("$page links to page $p_rel$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
}
}
}
return IkiWiki::FailReason->new("$page does not link to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1);
}
sub match_backlink ($$;@) {
my $page=shift;
my $testpage=shift;
my %params=@_;
if ($testpage eq '.') {
$testpage = $params{'location'}
}
my $ret=match_link($testpage, $page, @_);
$ret->influences($testpage => $IkiWiki::DEPEND_LINKS);
return $ret;
}
sub match_created_before ($$;@) {
my $page=shift;
my $testpage=shift;
my %params=@_;
$testpage=derel($testpage, $params{location});
if (exists $IkiWiki::pagectime{$testpage}) {
if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
2009-10-08 03:48:03 +02:00
return IkiWiki::SuccessReason->new("$page created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
else {
2009-10-08 03:48:03 +02:00
return IkiWiki::FailReason->new("$page not created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
}
else {
2009-10-08 03:48:03 +02:00
return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
}
sub match_created_after ($$;@) {
my $page=shift;
my $testpage=shift;
my %params=@_;
$testpage=derel($testpage, $params{location});
if (exists $IkiWiki::pagectime{$testpage}) {
if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
2009-10-08 03:48:03 +02:00
return IkiWiki::SuccessReason->new("$page created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
else {
2009-10-08 03:48:03 +02:00
return IkiWiki::FailReason->new("$page not created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
}
else {
2009-10-08 03:48:03 +02:00
return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
}
}
sub match_creation_day ($$;@) {
2010-10-23 22:47:19 +02:00
my $page=shift;
my $d=shift;
if ($d !~ /^\d+$/) {
return IkiWiki::ErrorReason->new("invalid day $d");
}
2010-10-23 22:47:19 +02:00
if ((localtime($IkiWiki::pagectime{$page}))[3] == $d) {
return IkiWiki::SuccessReason->new('creation_day matched');
}
else {
return IkiWiki::FailReason->new('creation_day did not match');
}
}
sub match_creation_month ($$;@) {
2010-10-23 22:47:19 +02:00
my $page=shift;
my $m=shift;
if ($m !~ /^\d+$/) {
return IkiWiki::ErrorReason->new("invalid month $m");
}
2010-10-23 22:47:19 +02:00
if ((localtime($IkiWiki::pagectime{$page}))[4] + 1 == $m) {
return IkiWiki::SuccessReason->new('creation_month matched');
}
else {
return IkiWiki::FailReason->new('creation_month did not match');
}
}
sub match_creation_year ($$;@) {
2010-10-23 22:47:19 +02:00
my $page=shift;
my $y=shift;
if ($y !~ /^\d+$/) {
return IkiWiki::ErrorReason->new("invalid year $y");
}
2010-10-23 22:47:19 +02:00
if ((localtime($IkiWiki::pagectime{$page}))[5] + 1900 == $y) {
return IkiWiki::SuccessReason->new('creation_year matched');
}
else {
return IkiWiki::FailReason->new('creation_year did not match');
}
}
sub match_user ($$;@) {
shift;
my $user=shift;
my %params=@_;
if (! exists $params{user}) {
return IkiWiki::ErrorReason->new("no user specified");
}
my $regexp=IkiWiki::glob2re($user);
2010-11-20 01:02:49 +01:00
if (defined $params{user} && $params{user}=~$regexp) {
return IkiWiki::SuccessReason->new("user is $user");
}
elsif (! defined $params{user}) {
return IkiWiki::FailReason->new("not logged in");
}
else {
return IkiWiki::FailReason->new("user is $params{user}, not $user");
}
}
sub match_admin ($$;@) {
shift;
shift;
my %params=@_;
if (! exists $params{user}) {
return IkiWiki::ErrorReason->new("no user specified");
}
if (defined $params{user} && IkiWiki::is_admin($params{user})) {
return IkiWiki::SuccessReason->new("user is an admin");
}
elsif (! defined $params{user}) {
return IkiWiki::FailReason->new("not logged in");
}
else {
return IkiWiki::FailReason->new("user is not an admin");
}
}
sub match_ip ($$;@) {
shift;
my $ip=shift;
my %params=@_;
if (! exists $params{ip}) {
return IkiWiki::ErrorReason->new("no IP specified");
}
my $regexp=IkiWiki::glob2re(lc $ip);
if (defined $params{ip} && lc $params{ip}=~$regexp) {
return IkiWiki::SuccessReason->new("IP is $ip");
}
else {
return IkiWiki::FailReason->new("IP is $params{ip}, not $ip");
}
}
package IkiWiki::SortSpec;
# This is in the SortSpec namespace so that the $a and $b that sort() uses
2010-04-07 05:29:18 +02:00
# are easily available in this namespace, for cmp functions to use them.
sub sort_pages {
2010-04-12 18:41:32 +02:00
my $f=shift;
sort $f @_
}
sub cmp_title {
IkiWiki::pagetitle(IkiWiki::basename($a))
cmp
IkiWiki::pagetitle(IkiWiki::basename($b))
}
sub cmp_path { IkiWiki::pagetitle($a) cmp IkiWiki::pagetitle($b) }
sub cmp_mtime { $IkiWiki::pagemtime{$b} <=> $IkiWiki::pagemtime{$a} }
sub cmp_age { $IkiWiki::pagectime{$b} <=> $IkiWiki::pagectime{$a} }
1