]> git.vanrenterghem.biz Git - git.ikiwiki.info.git/blob - IkiWiki.pm
entab
[git.ikiwiki.info.git] / IkiWiki.pm
1 #!/usr/bin/perl
3 package IkiWiki;
5 use warnings;
6 use strict;
7 use Encode;
8 use Fcntl q{:flock};
9 use URI::Escape q{uri_escape_utf8};
10 use POSIX ();
11 use Storable;
12 use open qw{:utf8 :std};
14 use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
15         %pagestate %wikistate %renderedfiles %oldrenderedfiles
16         %pagesources %delpagesources %destsources %depends %depends_simple
17         @mass_depends %hooks %forcerebuild %loaded_plugins %typedlinks
18         %oldtypedlinks %autofiles @underlayfiles $lastrev $phase};
20 use Exporter q{import};
21 our @EXPORT = qw(hook debug error htmlpage template template_depends
22         deptype add_depends pagespec_match pagespec_match_list bestlink
23         htmllink readfile writefile pagetype srcfile pagename
24         displaytime strftime_utf8 will_render gettext ngettext urlto targetpage
25         add_underlay pagetitle titlepage linkpage newpagefile
26         inject add_link add_autofile useragent
27         %config %links %pagestate %wikistate %renderedfiles
28         %pagesources %destsources %typedlinks);
29 our $VERSION = 3.00; # plugin interface version, next is ikiwiki version
30 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
31 our $installdir='/usr'; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
33 # Page dependency types.
34 our $DEPEND_CONTENT=1;
35 our $DEPEND_PRESENCE=2;
36 our $DEPEND_LINKS=4;
38 # Phases of processing.
39 sub PHASE_SCAN () { 0 }
40 sub PHASE_RENDER () { 1 }
41 $phase = PHASE_SCAN;
43 # Optimisation.
44 use Memoize;
45 memoize("abs2rel");
46 memoize("sortspec_translate");
47 memoize("pagespec_translate");
48 memoize("template_file");
50 sub getsetup () {
51         wikiname => {
52                 type => "string",
53                 default => "wiki",
54                 description => "name of the wiki",
55                 safe => 1,
56                 rebuild => 1,
57         },
58         adminemail => {
59                 type => "string",
60                 default => undef,
61                 example => 'me@example.com',
62                 description => "contact email for wiki",
63                 safe => 1,
64                 rebuild => 0,
65         },
66         adminuser => {
67                 type => "string",
68                 default => [],
69                 description => "users who are wiki admins",
70                 safe => 1,
71                 rebuild => 0,
72         },
73         banned_users => {
74                 type => "string",
75                 default => [],
76                 description => "users who are banned from the wiki",
77                 safe => 1,
78                 rebuild => 0,
79         },
80         srcdir => {
81                 type => "string",
82                 default => undef,
83                 example => "$ENV{HOME}/wiki",
84                 description => "where the source of the wiki is located",
85                 safe => 0, # path
86                 rebuild => 1,
87         },
88         destdir => {
89                 type => "string",
90                 default => undef,
91                 example => "/var/www/wiki",
92                 description => "where to build the wiki",
93                 safe => 0, # path
94                 rebuild => 1,
95         },
96         url => {
97                 type => "string",
98                 default => '',
99                 example => "http://example.com/wiki",
100                 description => "base url to the wiki",
101                 safe => 1,
102                 rebuild => 1,
103         },
104         cgiurl => {
105                 type => "string",
106                 default => '',
107                 example => "http://example.com/wiki/ikiwiki.cgi",
108                 description => "url to the ikiwiki.cgi",
109                 safe => 1,
110                 rebuild => 1,
111         },
112         reverse_proxy => {
113                 type => "boolean",
114                 default => 0,
115                 description => "do not adjust cgiurl if CGI is accessed via different URL",
116                 advanced => 0,
117                 safe => 1,
118                 rebuild => 0, # only affects CGI requests
119         },
120         cgi_wrapper => {
121                 type => "string",
122                 default => '',
123                 example => "/var/www/wiki/ikiwiki.cgi",
124                 description => "filename of cgi wrapper to generate",
125                 safe => 0, # file
126                 rebuild => 0,
127         },
128         cgi_wrappermode => {
129                 type => "string",
130                 default => '06755',
131                 description => "mode for cgi_wrapper (can safely be made suid)",
132                 safe => 0,
133                 rebuild => 0,
134         },
135         cgi_overload_delay => {
136                 type => "string",
137                 default => '',
138                 example => "10",
139                 description => "number of seconds to delay CGI requests when overloaded",
140                 safe => 1,
141                 rebuild => 0,
142         },
143         cgi_overload_message => {
144                 type => "string",
145                 default => '',
146                 example => "Please wait",
147                 description => "message to display when overloaded (may contain html)",
148                 safe => 1,
149                 rebuild => 0,
150         },
151         only_committed_changes => {
152                 type => "boolean",
153                 default => 0,
154                 description => "enable optimization of only refreshing committed changes?",
155                 safe => 1,
156                 rebuild => 0,
157         },
158         rcs => {
159                 type => "string",
160                 default => '',
161                 description => "rcs backend to use",
162                 safe => 0, # don't allow overriding
163                 rebuild => 0,
164         },
165         default_plugins => {
166                 type => "internal",
167                 default => [qw{mdwn link inline meta htmlscrubber passwordauth
168                                 openid signinedit lockedit conditional
169                                 recentchanges parentlinks editpage
170                                 templatebody}],
171                 description => "plugins to enable by default",
172                 safe => 0,
173                 rebuild => 1,
174         },
175         add_plugins => {
176                 type => "string",
177                 default => [],
178                 description => "plugins to add to the default configuration",
179                 safe => 1,
180                 rebuild => 1,
181         },
182         disable_plugins => {
183                 type => "string",
184                 default => [],
185                 description => "plugins to disable",
186                 safe => 1,
187                 rebuild => 1,
188         },
189         templatedir => {
190                 type => "string",
191                 default => "$installdir/share/ikiwiki/templates",
192                 description => "additional directory to search for template files",
193                 advanced => 1,
194                 safe => 0, # path
195                 rebuild => 1,
196         },
197         underlaydir => {
198                 type => "string",
199                 default => "$installdir/share/ikiwiki/basewiki",
200                 description => "base wiki source location",
201                 advanced => 1,
202                 safe => 0, # path
203                 rebuild => 0,
204         },
205         underlaydirbase => {
206                 type => "internal",
207                 default => "$installdir/share/ikiwiki",
208                 description => "parent directory containing additional underlays",
209                 safe => 0,
210                 rebuild => 0,
211         },
212         wrappers => {
213                 type => "internal",
214                 default => [],
215                 description => "wrappers to generate",
216                 safe => 0,
217                 rebuild => 0,
218         },
219         underlaydirs => {
220                 type => "internal",
221                 default => [],
222                 description => "additional underlays to use",
223                 safe => 0,
224                 rebuild => 0,
225         },
226         verbose => {
227                 type => "boolean",
228                 example => 1,
229                 description => "display verbose messages?",
230                 safe => 1,
231                 rebuild => 0,
232         },
233         syslog => {
234                 type => "boolean",
235                 example => 1,
236                 description => "log to syslog?",
237                 safe => 1,
238                 rebuild => 0,
239         },
240         usedirs => {
241                 type => "boolean",
242                 default => 1,
243                 description => "create output files named page/index.html?",
244                 safe => 0, # changing requires manual transition
245                 rebuild => 1,
246         },
247         prefix_directives => {
248                 type => "boolean",
249                 default => 1,
250                 description => "use '!'-prefixed preprocessor directives?",
251                 safe => 0, # changing requires manual transition
252                 rebuild => 1,
253         },
254         indexpages => {
255                 type => "boolean",
256                 default => 0,
257                 description => "use page/index.mdwn source files",
258                 safe => 1,
259                 rebuild => 1,
260         },
261         discussion => {
262                 type => "boolean",
263                 default => 1,
264                 description => "enable Discussion pages?",
265                 safe => 1,
266                 rebuild => 1,
267         },
268         discussionpage => {
269                 type => "string",
270                 default => gettext("Discussion"),
271                 description => "name of Discussion pages",
272                 safe => 1,
273                 rebuild => 1,
274         },
275         html5 => {
276                 type => "boolean",
277                 default => 0,
278                 description => "use elements new in HTML5 like <section>?",
279                 advanced => 0,
280                 safe => 1,
281                 rebuild => 1,
282         },
283         sslcookie => {
284                 type => "boolean",
285                 default => 0,
286                 description => "only send cookies over SSL connections?",
287                 advanced => 1,
288                 safe => 1,
289                 rebuild => 0,
290         },
291         default_pageext => {
292                 type => "string",
293                 default => "mdwn",
294                 description => "extension to use for new pages",
295                 safe => 0, # not sanitized
296                 rebuild => 0,
297         },
298         htmlext => {
299                 type => "string",
300                 default => "html",
301                 description => "extension to use for html files",
302                 safe => 0, # not sanitized
303                 rebuild => 1,
304         },
305         timeformat => {
306                 type => "string",
307                 default => '%c',
308                 description => "strftime format string to display date",
309                 advanced => 1,
310                 safe => 1,
311                 rebuild => 1,
312         },
313         locale => {
314                 type => "string",
315                 default => undef,
316                 example => "en_US.UTF-8",
317                 description => "UTF-8 locale to use",
318                 advanced => 1,
319                 safe => 0,
320                 rebuild => 1,
321         },
322         userdir => {
323                 type => "string",
324                 default => "",
325                 example => "users",
326                 description => "put user pages below specified page",
327                 safe => 1,
328                 rebuild => 1,
329         },
330         numbacklinks => {
331                 type => "integer",
332                 default => 10,
333                 description => "how many backlinks to show before hiding excess (0 to show all)",
334                 safe => 1,
335                 rebuild => 1,
336         },
337         hardlink => {
338                 type => "boolean",
339                 default => 0,
340                 description => "attempt to hardlink source files? (optimisation for large files)",
341                 advanced => 1,
342                 safe => 0, # paranoia
343                 rebuild => 0,
344         },
345         umask => {
346                 type => "string",
347                 example => "public",
348                 description => "force ikiwiki to use a particular umask (keywords public, group or private, or a number)",
349                 advanced => 1,
350                 safe => 0, # paranoia
351                 rebuild => 0,
352         },
353         wrappergroup => {
354                 type => "string",
355                 example => "ikiwiki",
356                 description => "group for wrappers to run in",
357                 advanced => 1,
358                 safe => 0, # paranoia
359                 rebuild => 0,
360         },
361         libdir => {
362                 type => "string",
363                 default => "",
364                 example => "$ENV{HOME}/.ikiwiki/",
365                 description => "extra library and plugin directory",
366                 advanced => 1,
367                 safe => 0, # directory
368                 rebuild => 0,
369         },
370         ENV => {
371                 type => "string", 
372                 default => {},
373                 description => "environment variables",
374                 safe => 0, # paranoia
375                 rebuild => 0,
376         },
377         timezone => {
378                 type => "string", 
379                 default => "",
380                 example => "US/Eastern",
381                 description => "time zone name",
382                 safe => 1,
383                 rebuild => 1,
384         },
385         include => {
386                 type => "string",
387                 default => undef,
388                 example => '^\.htaccess$',
389                 description => "regexp of normally excluded files to include",
390                 advanced => 1,
391                 safe => 0, # regexp
392                 rebuild => 1,
393         },
394         exclude => {
395                 type => "string",
396                 default => undef,
397                 example => '^(*\.private|Makefile)$',
398                 description => "regexp of files that should be skipped",
399                 advanced => 1,
400                 safe => 0, # regexp
401                 rebuild => 1,
402         },
403         wiki_file_prune_regexps => {
404                 type => "internal",
405                 default => [qr/(^|\/)\.\.(\/|$)/, qr/^\//, qr/^\./, qr/\/\./,
406                         qr/\.x?html?$/, qr/\.ikiwiki-new$/,
407                         qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
408                         qr/(^|\/)_MTN\//, qr/(^|\/)_darcs\//,
409                         qr/(^|\/)CVS\//, qr/\.dpkg-tmp$/],
410                 description => "regexps of source files to ignore",
411                 safe => 0,
412                 rebuild => 1,
413         },
414         wiki_file_chars => {
415                 type => "string",
416                 description => "specifies the characters that are allowed in source filenames",
417                 default => "-[:alnum:]+/.:_",
418                 safe => 0,
419                 rebuild => 1,
420         },
421         wiki_file_regexp => {
422                 type => "internal",
423                 description => "regexp of legal source files",
424                 safe => 0,
425                 rebuild => 1,
426         },
427         web_commit_regexp => {
428                 type => "internal",
429                 default => qr/^web commit (by (.*?(?=: |$))|from ([0-9a-fA-F:.]+[0-9a-fA-F])):?(.*)/,
430                 description => "regexp to parse web commits from logs",
431                 safe => 0,
432                 rebuild => 0,
433         },
434         cgi => {
435                 type => "internal",
436                 default => 0,
437                 description => "run as a cgi",
438                 safe => 0,
439                 rebuild => 0,
440         },
441         cgi_disable_uploads => {
442                 type => "internal",
443                 default => 1,
444                 description => "whether CGI should accept file uploads",
445                 safe => 0,
446                 rebuild => 0,
447         },
448         post_commit => {
449                 type => "internal",
450                 default => 0,
451                 description => "run as a post-commit hook",
452                 safe => 0,
453                 rebuild => 0,
454         },
455         rebuild => {
456                 type => "internal",
457                 default => 0,
458                 description => "running in rebuild mode",
459                 safe => 0,
460                 rebuild => 0,
461         },
462         setup => {
463                 type => "internal",
464                 default => undef,
465                 description => "running in setup mode",
466                 safe => 0,
467                 rebuild => 0,
468         },
469         clean => {
470                 type => "internal",
471                 default => 0,
472                 description => "running in clean mode",
473                 safe => 0,
474                 rebuild => 0,
475         },
476         refresh => {
477                 type => "internal",
478                 default => 0,
479                 description => "running in refresh mode",
480                 safe => 0,
481                 rebuild => 0,
482         },
483         test_receive => {
484                 type => "internal",
485                 default => 0,
486                 description => "running in receive test mode",
487                 safe => 0,
488                 rebuild => 0,
489         },
490         wrapper_background_command => {
491                 type => "internal",
492                 default => '',
493                 description => "background shell command to run",
494                 safe => 0,
495                 rebuild => 0,
496         },
497         gettime => {
498                 type => "internal",
499                 description => "running in gettime mode",
500                 safe => 0,
501                 rebuild => 0,
502         },
503         w3mmode => {
504                 type => "internal",
505                 default => 0,
506                 description => "running in w3mmode",
507                 safe => 0,
508                 rebuild => 0,
509         },
510         wikistatedir => {
511                 type => "internal",
512                 default => undef,
513                 description => "path to the .ikiwiki directory holding ikiwiki state",
514                 safe => 0,
515                 rebuild => 0,
516         },
517         setupfile => {
518                 type => "internal",
519                 default => undef,
520                 description => "path to setup file",
521                 safe => 0,
522                 rebuild => 0,
523         },
524         setuptype => {
525                 type => "internal",
526                 default => "Yaml",
527                 description => "perl class to use to dump setup file",
528                 safe => 0,
529                 rebuild => 0,
530         },
531         allow_symlinks_before_srcdir => {
532                 type => "boolean",
533                 default => 0,
534                 description => "allow symlinks in the path leading to the srcdir (potentially insecure)",
535                 safe => 0,
536                 rebuild => 0,
537         },
538         cookiejar => {
539                 type => "string",
540                 default => { file => "$ENV{HOME}/.ikiwiki/cookies" },
541                 description => "cookie control",
542                 safe => 0, # hooks into perl module internals
543                 rebuild => 0,
544         },
545         useragent => {
546                 type => "string",
547                 default => "ikiwiki/$version",
548                 example => "Wget/1.13.4 (linux-gnu)",
549                 description => "set custom user agent string for outbound HTTP requests e.g. when fetching aggregated RSS feeds",
550                 safe => 0,
551                 rebuild => 0,
552         },
553         responsive_layout => {
554                 type => "boolean",
555                 default => 1,
556                 description => "theme has a responsive layout? (mobile-optimized)",
557                 safe => 1,
558                 rebuild => 1,
559         },
562 sub defaultconfig () {
563         my %s=getsetup();
564         my @ret;
565         foreach my $key (keys %s) {
566                 push @ret, $key, $s{$key}->{default};
567         }
568         return @ret;
571 # URL to top of wiki as a path starting with /, valid from any wiki page or
572 # the CGI; if that's not possible, an absolute URL. Either way, it ends with /
573 my $local_url;
574 # URL to CGI script, similar to $local_url
575 my $local_cgiurl;
577 sub checkconfig () {
578         # locale stuff; avoid LC_ALL since it overrides everything
579         if (defined $ENV{LC_ALL}) {
580                 $ENV{LANG} = $ENV{LC_ALL};
581                 delete $ENV{LC_ALL};
582         }
583         if (defined $config{locale}) {
584                 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
585                         $ENV{LANG}=$config{locale};
586                         define_gettext();
587                 }
588         }
589                 
590         if (! defined $config{wiki_file_regexp}) {
591                 $config{wiki_file_regexp}=qr/(^[$config{wiki_file_chars}]+$)/;
592         }
594         if (ref $config{ENV} eq 'HASH') {
595                 foreach my $val (keys %{$config{ENV}}) {
596                         $ENV{$val}=$config{ENV}{$val};
597                 }
598         }
599         if (defined $config{timezone} && length $config{timezone}) {
600                 $ENV{TZ}=$config{timezone};
601         }
602         else {
603                 $config{timezone}=$ENV{TZ};
604         }
606         if ($config{w3mmode}) {
607                 eval q{use Cwd q{abs_path}};
608                 error($@) if $@;
609                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
610                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
611                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
612                         unless $config{cgiurl} =~ m!file:///!;
613                 $config{url}="file://".$config{destdir};
614         }
616         if ($config{cgi} && ! length $config{url}) {
617                 error(gettext("Must specify url to wiki with --url when using --cgi"));
618         }
620         if (defined $config{url} && length $config{url}) {
621                 eval q{use URI};
622                 my $baseurl = URI->new($config{url});
624                 $local_url = $baseurl->path . "/";
625                 $local_cgiurl = undef;
627                 if (length $config{cgiurl}) {
628                         my $cgiurl = URI->new($config{cgiurl});
630                         $local_cgiurl = $cgiurl->path;
632                         if ($cgiurl->scheme eq 'https' &&
633                                 $baseurl->scheme eq 'http') {
634                                 # We assume that the same content is available
635                                 # over both http and https, because if it
636                                 # wasn't, accessing the static content
637                                 # from the CGI would be mixed-content,
638                                 # which would be a security flaw.
640                                 if ($cgiurl->authority ne $baseurl->authority) {
641                                         # use protocol-relative URL for
642                                         # static content
643                                         $local_url = "$config{url}/";
644                                         $local_url =~ s{^http://}{//};
645                                 }
646                                 # else use host-relative URL for static content
648                                 # either way, CGI needs to be absolute
649                                 $local_cgiurl = $config{cgiurl};
650                         }
651                         elsif ($cgiurl->scheme ne $baseurl->scheme) {
652                                 # too far apart, fall back to absolute URLs
653                                 $local_url = "$config{url}/";
654                                 $local_cgiurl = $config{cgiurl};
655                         }
656                         elsif ($cgiurl->authority ne $baseurl->authority) {
657                                 # slightly too far apart, fall back to
658                                 # protocol-relative URLs
659                                 $local_url = "$config{url}/";
660                                 $local_url =~ s{^https?://}{//};
661                                 $local_cgiurl = $config{cgiurl};
662                                 $local_cgiurl =~ s{^https?://}{//};
663                         }
664                         # else keep host-relative URLs
665                 }
667                 $local_url =~ s{//$}{/};
668         }
669         else {
670                 $local_cgiurl = $config{cgiurl};
671         }
673         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
674                 unless exists $config{wikistatedir} && defined $config{wikistatedir};
676         if (defined $config{umask}) {
677                 my $u = possibly_foolish_untaint($config{umask});
679                 if ($u =~ m/^\d+$/) {
680                         umask($u);
681                 }
682                 elsif ($u eq 'private') {
683                         umask(077);
684                 }
685                 elsif ($u eq 'group') {
686                         umask(027);
687                 }
688                 elsif ($u eq 'public') {
689                         umask(022);
690                 }
691                 else {
692                         error(sprintf(gettext("unsupported umask setting %s"), $u));
693                 }
694         }
696         run_hooks(checkconfig => sub { shift->() });
698         return 1;
701 sub listplugins () {
702         my %ret;
704         foreach my $dir (@INC, $config{libdir}) {
705                 next unless defined $dir && length $dir;
706                 foreach my $file (glob("$dir/IkiWiki/Plugin/*.pm")) {
707                         my ($plugin)=$file=~/.*\/(.*)\.pm$/;
708                         $ret{$plugin}=1;
709                 }
710         }
711         foreach my $dir ($config{libdir}, "$installdir/lib/ikiwiki") {
712                 next unless defined $dir && length $dir;
713                 foreach my $file (glob("$dir/plugins/*")) {
714                         $ret{basename($file)}=1 if -x $file;
715                 }
716         }
718         return keys %ret;
721 sub loadplugins () {
722         if (defined $config{libdir} && length $config{libdir}) {
723                 unshift @INC, possibly_foolish_untaint($config{libdir});
724         }
726         foreach my $plugin (@{$config{default_plugins}}, @{$config{add_plugins}}) {
727                 loadplugin($plugin);
728         }
729         
730         if ($config{rcs}) {
731                 if (exists $hooks{rcs}) {
732                         error(gettext("cannot use multiple rcs plugins"));
733                 }
734                 loadplugin($config{rcs});
735         }
736         if (! exists $hooks{rcs}) {
737                 loadplugin("norcs");
738         }
740         run_hooks(getopt => sub { shift->() });
741         if (grep /^-/, @ARGV) {
742                 print STDERR "Unknown option (or missing parameter): $_\n"
743                         foreach grep /^-/, @ARGV;
744                 usage();
745         }
747         return 1;
750 sub loadplugin ($;$) {
751         my $plugin=shift;
752         my $force=shift;
754         return if ! $force && grep { $_ eq $plugin} @{$config{disable_plugins}};
756         foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
757                          "$installdir/lib/ikiwiki") {
758                 if (defined $dir && -x "$dir/plugins/$plugin") {
759                         eval { require IkiWiki::Plugin::external };
760                         if ($@) {
761                                 my $reason=$@;
762                                 error(sprintf(gettext("failed to load external plugin needed for %s plugin: %s"), $plugin, $reason));
763                         }
764                         import IkiWiki::Plugin::external "$dir/plugins/$plugin";
765                         $loaded_plugins{$plugin}=1;
766                         return 1;
767                 }
768         }
770         my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
771         eval qq{use $mod};
772         if ($@) {
773                 error("Failed to load plugin $mod: $@");
774         }
775         $loaded_plugins{$plugin}=1;
776         return 1;
779 sub error ($;$) {
780         my $message=shift;
781         my $cleaner=shift;
782         log_message('err' => $message) if $config{syslog};
783         if (defined $cleaner) {
784                 $cleaner->();
785         }
786         die $message."\n";
789 sub debug ($) {
790         return unless $config{verbose};
791         return log_message(debug => @_);
794 my $log_open=0;
795 my $log_failed=0;
796 sub log_message ($$) {
797         my $type=shift;
799         if ($config{syslog}) {
800                 require Sys::Syslog;
801                 if (! $log_open) {
802                         Sys::Syslog::setlogsock('unix');
803                         Sys::Syslog::openlog('ikiwiki', '', 'user');
804                         $log_open=1;
805                 }
806                 eval {
807                         # keep a copy to avoid editing the original config repeatedly
808                         my $wikiname = $config{wikiname};
809                         utf8::encode($wikiname);
810                         Sys::Syslog::syslog($type, "[$wikiname] %s", join(" ", @_));
811                 };
812                 if ($@) {
813                     print STDERR "failed to syslog: $@" unless $log_failed;
814                     $log_failed=1;
815                     print STDERR "@_\n";
816                 }
817                 return $@;
818         }
819         elsif (! $config{cgi}) {
820                 return print "@_\n";
821         }
822         else {
823                 return print STDERR "@_\n";
824         }
827 sub possibly_foolish_untaint ($) {
828         my $tainted=shift;
829         my ($untainted)=$tainted=~/(.*)/s;
830         return $untainted;
833 sub basename ($) {
834         my $file=shift;
836         $file=~s!.*/+!!;
837         return $file;
840 sub dirname ($) {
841         my $file=shift;
843         $file=~s!/*[^/]+$!!;
844         return $file;
847 sub isinternal ($) {
848         my $page=shift;
849         return exists $pagesources{$page} &&
850                 $pagesources{$page} =~ /\._([^.]+)$/;
853 sub pagetype ($) {
854         my $file=shift;
855         
856         if ($file =~ /\.([^.]+)$/) {
857                 return $1 if exists $hooks{htmlize}{$1};
858         }
859         my $base=basename($file);
860         if (exists $hooks{htmlize}{$base} &&
861             $hooks{htmlize}{$base}{noextension}) {
862                 return $base;
863         }
864         return;
867 my %pagename_cache;
869 sub pagename ($) {
870         my $file=shift;
872         if (exists $pagename_cache{$file}) {
873                 return $pagename_cache{$file};
874         }
876         my $type=pagetype($file);
877         my $page=$file;
878         $page=~s/\Q.$type\E*$//
879                 if defined $type && !$hooks{htmlize}{$type}{keepextension}
880                         && !$hooks{htmlize}{$type}{noextension};
881         if ($config{indexpages} && $page=~/(.*)\/index$/) {
882                 $page=$1;
883         }
885         $pagename_cache{$file} = $page;
886         return $page;
889 sub newpagefile ($$) {
890         my $page=shift;
891         my $type=shift;
893         if (! $config{indexpages} || $page eq 'index') {
894                 return $page.".".$type;
895         }
896         else {
897                 return $page."/index.".$type;
898         }
901 sub targetpage ($$;$) {
902         my $page=shift;
903         my $ext=shift;
904         my $filename=shift;
905         
906         if (defined $filename) {
907                 return $page."/".$filename.".".$ext;
908         }
909         elsif (! $config{usedirs} || $page eq 'index') {
910                 return $page.".".$ext;
911         }
912         else {
913                 return $page."/index.".$ext;
914         }
917 sub htmlpage ($) {
918         my $page=shift;
919         
920         return targetpage($page, $config{htmlext});
923 sub srcfile_stat {
924         my $file=shift;
925         my $nothrow=shift;
927         return "$config{srcdir}/$file", stat(_) if -e "$config{srcdir}/$file";
928         foreach my $dir (@{$config{underlaydirs}}, $config{underlaydir}) {
929                 return "$dir/$file", stat(_) if -e "$dir/$file";
930         }
931         error("internal error: $file cannot be found in $config{srcdir} or underlay") unless $nothrow;
932         return;
935 sub srcfile ($;$) {
936         return (srcfile_stat(@_))[0];
939 sub add_literal_underlay ($) {
940         my $dir=shift;
942         if (! grep { $_ eq $dir } @{$config{underlaydirs}}) {
943                 unshift @{$config{underlaydirs}}, $dir;
944         }
947 sub add_underlay ($) {
948         my $dir = shift;
950         if ($dir !~ /^\//) {
951                 $dir="$config{underlaydirbase}/$dir";
952         }
954         add_literal_underlay($dir);
955         # why does it return 1? we just don't know
956         return 1;
959 sub readfile ($;$$) {
960         my $file=shift;
961         my $binary=shift;
962         my $wantfd=shift;
964         if (-l $file) {
965                 error("cannot read a symlink ($file)");
966         }
967         
968         local $/=undef;
969         open (my $in, "<", $file) || error("failed to read $file: $!");
970         binmode($in) if ($binary);
971         return \*$in if $wantfd;
972         my $ret=<$in>;
973         # check for invalid utf-8, and toss it back to avoid crashes
974         if (! utf8::valid($ret)) {
975                 $ret=encode_utf8($ret);
976         }
977         close $in || error("failed to read $file: $!");
978         return $ret;
981 sub prep_writefile ($$) {
982         my $file=shift;
983         my $destdir=shift;
984         
985         my $test=$file;
986         while (length $test) {
987                 if (-l "$destdir/$test") {
988                         error("cannot write to a symlink ($test)");
989                 }
990                 if (-f _ && $test ne $file) {
991                         # Remove conflicting file.
992                         foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
993                                 foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
994                                         if ($f eq $test) {
995                                                 unlink("$destdir/$test");
996                                                 last;
997                                         }
998                                 }
999                         }
1000                 }
1001                 $test=dirname($test);
1002         }
1004         my $dir=dirname("$destdir/$file");
1005         if (! -d $dir) {
1006                 my $d="";
1007                 foreach my $s (split(m!/+!, $dir)) {
1008                         $d.="$s/";
1009                         if (! -d $d) {
1010                                 mkdir($d) || error("failed to create directory $d: $!");
1011                         }
1012                 }
1013         }
1015         return 1;
1018 sub writefile ($$$;$$) {
1019         my $file=shift; # can include subdirs
1020         my $destdir=shift; # directory to put file in
1021         my $content=shift;
1022         my $binary=shift;
1023         my $writer=shift;
1024         
1025         prep_writefile($file, $destdir);
1026         
1027         my $newfile="$destdir/$file.ikiwiki-new";
1028         if (-l $newfile) {
1029                 error("cannot write to a symlink ($newfile)");
1030         }
1031         
1032         my $cleanup = sub { unlink($newfile) };
1033         open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
1034         binmode($out) if ($binary);
1035         if ($writer) {
1036                 $writer->(\*$out, $cleanup);
1037         }
1038         else {
1039                 print $out $content or error("failed writing to $newfile: $!", $cleanup);
1040         }
1041         close $out || error("failed saving $newfile: $!", $cleanup);
1042         rename($newfile, "$destdir/$file") || 
1043                 error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
1045         return 1;
1048 my %cleared;
1049 sub will_render ($$;$) {
1050         my $page=shift;
1051         my $dest=shift;
1052         my $clear=shift;
1054         # Important security check for independently created files.
1055         if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
1056             ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}}, @{$wikistate{editpage}{previews}})) {
1057                 my $from_other_page=0;
1058                 # Expensive, but rarely runs.
1059                 foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
1060                         if (grep {
1061                                 $_ eq $dest ||
1062                                 dirname($_) eq $dest
1063                             } @{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
1064                                 $from_other_page=1;
1065                                 last;
1066                         }
1067                 }
1069                 error("$config{destdir}/$dest independently created, not overwriting with version from $page")
1070                         unless $from_other_page;
1071         }
1073         # If $dest exists as a directory, remove conflicting files in it
1074         # rendered from other pages.
1075         if (-d _) {
1076                 foreach my $p (keys %renderedfiles, keys %oldrenderedfiles) {
1077                         foreach my $f (@{$renderedfiles{$p}}, @{$oldrenderedfiles{$p}}) {
1078                                 if (dirname($f) eq $dest) {
1079                                         unlink("$config{destdir}/$f");
1080                                         rmdir(dirname("$config{destdir}/$f"));
1081                                 }
1082                         }
1083                 }
1084         }
1086         if (! $clear || $cleared{$page}) {
1087                 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
1088         }
1089         else {
1090                 foreach my $old (@{$renderedfiles{$page}}) {
1091                         delete $destsources{$old};
1092                 }
1093                 $renderedfiles{$page}=[$dest];
1094                 $cleared{$page}=1;
1095         }
1096         $destsources{$dest}=$page;
1098         return 1;
1101 sub bestlink ($$) {
1102         my $page=shift;
1103         my $link=shift;
1104         
1105         my $cwd=$page;
1106         if ($link=~s/^\/+//) {
1107                 # absolute links
1108                 $cwd="";
1109         }
1110         $link=~s/\/$//;
1112         do {
1113                 my $l=$cwd;
1114                 $l.="/" if length $l;
1115                 $l.=$link;
1117                 if (exists $pagesources{$l}) {
1118                         return $l;
1119                 }
1120                 elsif (exists $pagecase{lc $l}) {
1121                         return $pagecase{lc $l};
1122                 }
1123         } while $cwd=~s{/?[^/]+$}{};
1125         if (length $config{userdir}) {
1126                 my $l = "$config{userdir}/".lc($link);
1127                 if (exists $pagesources{$l}) {
1128                         return $l;
1129                 }
1130                 elsif (exists $pagecase{lc $l}) {
1131                         return $pagecase{lc $l};
1132                 }
1133         }
1135         #print STDERR "warning: page $page, broken link: $link\n";
1136         return "";
1139 sub isinlinableimage ($) {
1140         my $file=shift;
1141         
1142         return $file =~ /\.(png|gif|jpg|jpeg|svg)$/i;
1145 sub pagetitle ($;$) {
1146         my $page=shift;
1147         my $unescaped=shift;
1149         if ($unescaped) {
1150                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
1151         }
1152         else {
1153                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
1154         }
1156         return $page;
1159 sub titlepage ($) {
1160         my $title=shift;
1161         # support use w/o %config set
1162         my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_";
1163         $title=~s/([^$chars]|_)/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
1164         return $title;
1167 sub linkpage ($) {
1168         my $link=shift;
1169         my $chars = defined $config{wiki_file_chars} ? $config{wiki_file_chars} : "-[:alnum:]+/.:_";
1170         $link=~s/([^$chars])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
1171         return $link;
1174 sub cgiurl (@) {
1175         my %params=@_;
1177         my $cgiurl=$local_cgiurl;
1179         if (exists $params{cgiurl}) {
1180                 $cgiurl=$params{cgiurl};
1181                 delete $params{cgiurl};
1182         }
1184         unless (%params) {
1185                 return $cgiurl;
1186         }
1188         return $cgiurl."?".
1189                 join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
1192 sub cgiurl_abs (@) {
1193         eval q{use URI};
1194         URI->new_abs(cgiurl(@_), $config{cgiurl});
1197 sub baseurl (;$) {
1198         my $page=shift;
1200         return $local_url if ! defined $page;
1201         
1202         $page=htmlpage($page);
1203         $page=~s/[^\/]+$//;
1204         $page=~s/[^\/]+\//..\//g;
1205         return $page;
1208 sub urlabs ($$) {
1209         my $url=shift;
1210         my $urlbase=shift;
1212         return $url unless defined $urlbase && length $urlbase;
1214         eval q{use URI};
1215         URI->new_abs($url, $urlbase)->as_string;
1218 sub abs2rel ($$) {
1219         # Work around very innefficient behavior in File::Spec if abs2rel
1220         # is passed two relative paths. It's much faster if paths are
1221         # absolute! (Debian bug #376658; fixed in debian unstable now)
1222         my $path="/".shift;
1223         my $base="/".shift;
1225         require File::Spec;
1226         my $ret=File::Spec->abs2rel($path, $base);
1227         $ret=~s/^// if defined $ret;
1228         return $ret;
1231 sub displaytime ($;$$) {
1232         # Plugins can override this function to mark up the time to
1233         # display.
1234         my $time=formattime($_[0], $_[1]);
1235         if ($config{html5}) {
1236                 return '<time datetime="'.date_3339($_[0]).'"'.
1237                         ($_[2] ? ' pubdate="pubdate"' : '').
1238                         '>'.$time.'</time>';
1239         }
1240         else {
1241                 return '<span class="date">'.$time.'</span>';
1242         }
1245 sub formattime ($;$) {
1246         # Plugins can override this function to format the time.
1247         my $time=shift;
1248         my $format=shift;
1249         if (! defined $format) {
1250                 $format=$config{timeformat};
1251         }
1253         return strftime_utf8($format, localtime($time));
1256 my $strftime_encoding;
1257 sub strftime_utf8 {
1258         # strftime doesn't know about encodings, so make sure
1259         # its output is properly treated as utf8.
1260         # Note that this does not handle utf-8 in the format string.
1261         ($strftime_encoding) = POSIX::setlocale(&POSIX::LC_TIME) =~ m#\.([^@]+)#
1262                 unless defined $strftime_encoding;
1263         $strftime_encoding
1264                 ? Encode::decode($strftime_encoding, POSIX::strftime(@_))
1265                 : POSIX::strftime(@_);
1268 sub date_3339 ($) {
1269         my $time=shift;
1271         my $lc_time=POSIX::setlocale(&POSIX::LC_TIME);
1272         POSIX::setlocale(&POSIX::LC_TIME, "C");
1273         my $ret=POSIX::strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($time));
1274         POSIX::setlocale(&POSIX::LC_TIME, $lc_time);
1275         return $ret;
1278 sub beautify_urlpath ($) {
1279         my $url=shift;
1281         # Ensure url is not an empty link, and if necessary,
1282         # add ./ to avoid colon confusion.
1283         if ($url !~ /^\// && $url !~ /^\.\.?\//) {
1284                 $url="./$url";
1285         }
1287         if ($config{usedirs}) {
1288                 $url =~ s!/index.$config{htmlext}$!/!;
1289         }
1291         return $url;
1294 sub urlto ($;$$) {
1295         my $to=shift;
1296         my $from=shift;
1297         my $absolute=shift;
1298         
1299         if (! length $to) {
1300                 $to = 'index';
1301         }
1303         if (! $destsources{$to}) {
1304                 $to=htmlpage($to);
1305         }
1307         if ($absolute) {
1308                 return $config{url}.beautify_urlpath("/".$to);
1309         }
1311         if (! defined $from) {
1312                 my $u = $local_url || '';
1313                 $u =~ s{/$}{};
1314                 return $u.beautify_urlpath("/".$to);
1315         }
1317         my $link = abs2rel($to, dirname(htmlpage($from)));
1319         return beautify_urlpath($link);
1322 sub isselflink ($$) {
1323         # Plugins can override this function to support special types
1324         # of selflinks.
1325         my $page=shift;
1326         my $link=shift;
1328         return $page eq $link;
1331 sub htmllink ($$$;@) {
1332         my $lpage=shift; # the page doing the linking
1333         my $page=shift; # the page that will contain the link (different for inline)
1334         my $link=shift;
1335         my %opts=@_;
1337         $link=~s/\/$//;
1339         my $bestlink;
1340         if (! $opts{forcesubpage}) {
1341                 $bestlink=bestlink($lpage, $link);
1342         }
1343         else {
1344                 $bestlink="$lpage/".lc($link);
1345         }
1347         my $linktext;
1348         if (defined $opts{linktext}) {
1349                 $linktext=$opts{linktext};
1350         }
1351         else {
1352                 $linktext=pagetitle(basename($link));
1353         }
1354         
1355         return "<span class=\"selflink\">$linktext</span>"
1356                 if length $bestlink && isselflink($page, $bestlink) &&
1357                    ! defined $opts{anchor};
1358         
1359         if (! $destsources{$bestlink}) {
1360                 $bestlink=htmlpage($bestlink);
1362                 if (! $destsources{$bestlink}) {
1363                         my $cgilink = "";
1364                         if (length $config{cgiurl}) {
1365                                 $cgilink = "<a href=\"".
1366                                         cgiurl(
1367                                                 do => "create",
1368                                                 page => $link,
1369                                                 from => $lpage
1370                                         )."\" rel=\"nofollow\">?</a>";
1371                         }
1372                         return "<span class=\"createlink\">$cgilink$linktext</span>"
1373                 }
1374         }
1375         
1376         $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
1377         $bestlink=beautify_urlpath($bestlink);
1378         
1379         if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
1380                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
1381         }
1383         if (defined $opts{anchor}) {
1384                 $bestlink.="#".$opts{anchor};
1385         }
1387         my @attrs;
1388         foreach my $attr (qw{rel class title}) {
1389                 if (defined $opts{$attr}) {
1390                         push @attrs, " $attr=\"$opts{$attr}\"";
1391                 }
1392         }
1394         return "<a href=\"$bestlink\"@attrs>$linktext</a>";
1397 sub userpage ($) {
1398         my $user=shift;
1399         return length $config{userdir} ? "$config{userdir}/$user" : $user;
1402 sub openiduser ($) {
1403         my $user=shift;
1405         if (defined $user && $user =~ m!^https?://! &&
1406             eval q{use Net::OpenID::VerifiedIdentity; 1} && !$@) {
1407                 my $display;
1409                 if (Net::OpenID::VerifiedIdentity->can("DisplayOfURL")) {
1410                         $display = Net::OpenID::VerifiedIdentity::DisplayOfURL($user);
1411                 }
1412                 else {
1413                         # backcompat with old version
1414                         my $oid=Net::OpenID::VerifiedIdentity->new(identity => $user);
1415                         $display=$oid->display;
1416                 }
1418                 # Convert "user.somehost.com" to "user [somehost.com]"
1419                 # (also "user.somehost.co.uk")
1420                 if ($display !~ /\[/) {
1421                         $display=~s/^([-a-zA-Z0-9]+?)\.([-.a-zA-Z0-9]+\.[a-z]+)$/$1 [$2]/;
1422                 }
1423                 # Convert "http://somehost.com/user" to "user [somehost.com]".
1424                 # (also "https://somehost.com/user/")
1425                 if ($display !~ /\[/) {
1426                         $display=~s/^https?:\/\/(.+)\/([^\/#?]+)\/?(?:[#?].*)?$/$2 [$1]/;
1427                 }
1428                 $display=~s!^https?://!!; # make sure this is removed
1429                 eval q{use CGI 'escapeHTML'};
1430                 error($@) if $@;
1431                 return escapeHTML($display);
1432         }
1433         return;
1436 sub htmlize ($$$$) {
1437         my $page=shift;
1438         my $destpage=shift;
1439         my $type=shift;
1440         my $content=shift;
1441         
1442         my $oneline = $content !~ /\n/;
1443         
1444         if (exists $hooks{htmlize}{$type}) {
1445                 $content=$hooks{htmlize}{$type}{call}->(
1446                         page => $page,
1447                         content => $content,
1448                 );
1449         }
1450         else {
1451                 error("htmlization of $type not supported");
1452         }
1454         run_hooks(sanitize => sub {
1455                 $content=shift->(
1456                         page => $page,
1457                         destpage => $destpage,
1458                         content => $content,
1459                 );
1460         });
1461         
1462         if ($oneline) {
1463                 # hack to get rid of enclosing junk added by markdown
1464                 # and other htmlizers/sanitizers
1465                 $content=~s/^<p>//i;
1466                 $content=~s/<\/p>\n*$//i;
1467         }
1469         return $content;
1472 sub linkify ($$$) {
1473         my $page=shift;
1474         my $destpage=shift;
1475         my $content=shift;
1477         run_hooks(linkify => sub {
1478                 $content=shift->(
1479                         page => $page,
1480                         destpage => $destpage,
1481                         content => $content,
1482                 );
1483         });
1484         
1485         return $content;
1488 our %preprocessing;
1489 our $preprocess_preview=0;
1490 sub preprocess ($$$;$$) {
1491         my $page=shift; # the page the data comes from
1492         my $destpage=shift; # the page the data will appear in (different for inline)
1493         my $content=shift;
1494         my $scan=shift;
1495         my $preview=shift;
1497         # Using local because it needs to be set within any nested calls
1498         # of this function.
1499         local $preprocess_preview=$preview if defined $preview;
1501         my $handle=sub {
1502                 my $escape=shift;
1503                 my $prefix=shift;
1504                 my $command=shift;
1505                 my $params=shift;
1506                 $params="" if ! defined $params;
1508                 if (length $escape) {
1509                         return "[[$prefix$command $params]]";
1510                 }
1511                 elsif (exists $hooks{preprocess}{$command}) {
1512                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
1513                         # Note: preserve order of params, some plugins may
1514                         # consider it significant.
1515                         my @params;
1516                         while ($params =~ m{
1517                                 (?:([-.\w]+)=)?         # 1: named parameter key?
1518                                 (?:
1519                                         """(.*?)"""     # 2: triple-quoted value
1520                                 |
1521                                         "([^"]*?)"      # 3: single-quoted value
1522                                 |
1523                                         '''(.*?)'''     # 4: triple-single-quote
1524                                 |
1525                                         <<([a-zA-Z]+)\n # 5: heredoc start
1526                                         (.*?)\n\5       # 6: heredoc value
1527                                 |
1528                                         (\S+)           # 7: unquoted value
1529                                 )
1530                                 (?:\s+|$)               # delimiter to next param
1531                         }msgx) {
1532                                 my $key=$1;
1533                                 my $val;
1534                                 if (defined $2) {
1535                                         $val=$2;
1536                                         $val=~s/\r\n/\n/mg;
1537                                         $val=~s/^\n+//g;
1538                                         $val=~s/\n+$//g;
1539                                 }
1540                                 elsif (defined $3) {
1541                                         $val=$3;
1542                                 }
1543                                 elsif (defined $4) {
1544                                         $val=$4;
1545                                 }
1546                                 elsif (defined $7) {
1547                                         $val=$7;
1548                                 }
1549                                 elsif (defined $6) {
1550                                         $val=$6;
1551                                 }
1553                                 if (defined $key) {
1554                                         push @params, $key, $val;
1555                                 }
1556                                 else {
1557                                         push @params, $val, '';
1558                                 }
1559                         }
1560                         if ($preprocessing{$page}++ > 8) {
1561                                 # Avoid loops of preprocessed pages preprocessing
1562                                 # other pages that preprocess them, etc.
1563                                 return "[[!$command <span class=\"error\">".
1564                                         sprintf(gettext("preprocessing loop detected on %s at depth %i"),
1565                                                 $page, $preprocessing{$page}).
1566                                         "</span>]]";
1567                         }
1568                         my $ret;
1569                         if (! $scan) {
1570                                 $ret=eval {
1571                                         $hooks{preprocess}{$command}{call}->(
1572                                                 @params,
1573                                                 page => $page,
1574                                                 destpage => $destpage,
1575                                                 preview => $preprocess_preview,
1576                                         );
1577                                 };
1578                                 if ($@) {
1579                                         my $error=$@;
1580                                         chomp $error;
1581                                         $ret="[[!$command <span class=\"error\">".
1582                                                 gettext("Error").": $error"."</span>]]";
1583                                 }
1584                         }
1585                         else {
1586                                 # use void context during scan pass
1587                                 eval {
1588                                         $hooks{preprocess}{$command}{call}->(
1589                                                 @params,
1590                                                 page => $page,
1591                                                 destpage => $destpage,
1592                                                 preview => $preprocess_preview,
1593                                         );
1594                                 };
1595                                 $ret="";
1596                         }
1597                         $preprocessing{$page}--;
1598                         return $ret;
1599                 }
1600                 else {
1601                         return "[[$prefix$command $params]]";
1602                 }
1603         };
1604         
1605         my $regex;
1606         if ($config{prefix_directives}) {
1607                 $regex = qr{
1608                         (\\?)           # 1: escape?
1609                         \[\[(!)         # directive open; 2: prefix
1610                         ([-\w]+)        # 3: command
1611                         (               # 4: the parameters..
1612                                 \s+     # Must have space if parameters present
1613                                 (?:
1614                                         (?:[-.\w]+=)?           # named parameter key?
1615                                         (?:
1616                                                 """.*?"""       # triple-quoted value
1617                                                 |
1618                                                 "[^"]*?"        # single-quoted value
1619                                                 |
1620                                                 '''.*?'''       # triple-single-quote
1621                                                 |
1622                                                 <<([a-zA-Z]+)\n # 5: heredoc start
1623                                                 (?:.*?)\n\5     # heredoc value
1624                                                 |
1625                                                 [^"\s\]]+       # unquoted value
1626                                         )
1627                                         \s*                     # whitespace or end
1628                                                                 # of directive
1629                                 )
1630                         *)?             # 0 or more parameters
1631                         \]\]            # directive closed
1632                 }sx;
1633         }
1634         else {
1635                 $regex = qr{
1636                         (\\?)           # 1: escape?
1637                         \[\[(!?)        # directive open; 2: optional prefix
1638                         ([-\w]+)        # 3: command
1639                         \s+
1640                         (               # 4: the parameters..
1641                                 (?:
1642                                         (?:[-.\w]+=)?           # named parameter key?
1643                                         (?:
1644                                                 """.*?"""       # triple-quoted value
1645                                                 |
1646                                                 "[^"]*?"        # single-quoted value
1647                                                 |
1648                                                 '''.*?'''       # triple-single-quote
1649                                                 |
1650                                                 <<([a-zA-Z]+)\n # 5: heredoc start
1651                                                 (?:.*?)\n\5     # heredoc value
1652                                                 |
1653                                                 [^"\s\]]+       # unquoted value
1654                                         )
1655                                         \s*                     # whitespace or end
1656                                                                 # of directive
1657                                 )
1658                         *)              # 0 or more parameters
1659                         \]\]            # directive closed
1660                 }sx;
1661         }
1663         $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
1664         return $content;
1667 sub filter ($$$) {
1668         my $page=shift;
1669         my $destpage=shift;
1670         my $content=shift;
1672         run_hooks(filter => sub {
1673                 $content=shift->(page => $page, destpage => $destpage, 
1674                         content => $content);
1675         });
1677         return $content;
1680 sub check_canedit ($$$;$) {
1681         my $page=shift;
1682         my $q=shift;
1683         my $session=shift;
1684         my $nonfatal=shift;
1685         
1686         my $canedit;
1687         run_hooks(canedit => sub {
1688                 return if defined $canedit;
1689                 my $ret=shift->($page, $q, $session);
1690                 if (defined $ret) {
1691                         if ($ret eq "") {
1692                                 $canedit=1;
1693                         }
1694                         elsif (ref $ret eq 'CODE') {
1695                                 $ret->() unless $nonfatal;
1696                                 $canedit=0;
1697                         }
1698                         elsif (defined $ret) {
1699                                 error($ret) unless $nonfatal;
1700                                 $canedit=0;
1701                         }
1702                 }
1703         });
1704         return defined $canedit ? $canedit : 1;
1707 sub check_content (@) {
1708         my %params=@_;
1709         
1710         return 1 if ! exists $hooks{checkcontent}; # optimisation
1712         if (exists $pagesources{$params{page}}) {
1713                 my @diff;
1714                 my %old=map { $_ => 1 }
1715                         split("\n", readfile(srcfile($pagesources{$params{page}})));
1716                 foreach my $line (split("\n", $params{content})) {
1717                         push @diff, $line if ! exists $old{$line};
1718                 }
1719                 $params{diff}=join("\n", @diff);
1720         }
1722         my $ok;
1723         run_hooks(checkcontent => sub {
1724                 return if defined $ok;
1725                 my $ret=shift->(%params);
1726                 if (defined $ret) {
1727                         if ($ret eq "") {
1728                                 $ok=1;
1729                         }
1730                         elsif (ref $ret eq 'CODE') {
1731                                 $ret->() unless $params{nonfatal};
1732                                 $ok=0;
1733                         }
1734                         elsif (defined $ret) {
1735                                 error($ret) unless $params{nonfatal};
1736                                 $ok=0;
1737                         }
1738                 }
1740         });
1741         return defined $ok ? $ok : 1;
1744 sub check_canchange (@) {
1745         my %params = @_;
1746         my $cgi = $params{cgi};
1747         my $session = $params{session};
1748         my @changes = @{$params{changes}};
1750         my %newfiles;
1751         foreach my $change (@changes) {
1752                 # This untaint is safe because we check file_pruned and
1753                 # wiki_file_regexp.
1754                 my ($file)=$change->{file}=~/$config{wiki_file_regexp}/;
1755                 $file=possibly_foolish_untaint($file);
1756                 if (! defined $file || ! length $file ||
1757                     file_pruned($file)) {
1758                         error(gettext("bad file name %s"), $file);
1759                 }
1761                 my $type=pagetype($file);
1762                 my $page=pagename($file) if defined $type;
1764                 if ($change->{action} eq 'add') {
1765                         $newfiles{$file}=1;
1766                 }
1768                 if ($change->{action} eq 'change' ||
1769                     $change->{action} eq 'add') {
1770                         if (defined $page) {
1771                                 check_canedit($page, $cgi, $session);
1772                                 next;
1773                         }
1774                         else {
1775                                 if (IkiWiki::Plugin::attachment->can("check_canattach")) {
1776                                         IkiWiki::Plugin::attachment::check_canattach($session, $file, $change->{path});
1777                                         check_canedit($file, $cgi, $session);
1778                                         next;
1779                                 }
1780                         }
1781                 }
1782                 elsif ($change->{action} eq 'remove') {
1783                         # check_canremove tests to see if the file is present
1784                         # on disk. This will fail when a single commit adds a
1785                         # file and then removes it again. Avoid the problem
1786                         # by not testing the removal in such pairs of changes.
1787                         # (The add is still tested, just to make sure that
1788                         # no data is added to the repo that a web edit
1789                         # could not add.)
1790                         next if $newfiles{$file};
1792                         if (IkiWiki::Plugin::remove->can("check_canremove")) {
1793                                 IkiWiki::Plugin::remove::check_canremove(defined $page ? $page : $file, $cgi, $session);
1794                                 check_canedit(defined $page ? $page : $file, $cgi, $session);
1795                                 next;
1796                         }
1797                 }
1798                 else {
1799                         error "unknown action ".$change->{action};
1800                 }
1802                 error sprintf(gettext("you are not allowed to change %s"), $file);
1803         }
1807 my $wikilock;
1809 sub lockwiki () {
1810         # Take an exclusive lock on the wiki to prevent multiple concurrent
1811         # run issues. The lock will be dropped on program exit.
1812         if (! -d $config{wikistatedir}) {
1813                 mkdir($config{wikistatedir});
1814         }
1815         open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
1816                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
1817         if (! flock($wikilock, LOCK_EX | LOCK_NB)) {
1818                 debug("failed to get lock; waiting...");
1819                 if (! flock($wikilock, LOCK_EX)) {
1820                         error("failed to get lock");
1821                 }
1822         }
1823         return 1;
1826 sub unlockwiki () {
1827         POSIX::close($ENV{IKIWIKI_CGILOCK_FD}) if exists $ENV{IKIWIKI_CGILOCK_FD};
1828         return close($wikilock) if $wikilock;
1829         return;
1832 my $commitlock;
1834 sub commit_hook_enabled () {
1835         open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
1836                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1837         if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
1838                 close($commitlock) || error("failed closing commitlock: $!");
1839                 return 0;
1840         }
1841         close($commitlock) || error("failed closing commitlock: $!");
1842         return 1;
1845 sub disable_commit_hook () {
1846         open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
1847                 error("cannot write to $config{wikistatedir}/commitlock: $!");
1848         if (! flock($commitlock, 2)) { # LOCK_EX
1849                 error("failed to get commit lock");
1850         }
1851         return 1;
1854 sub enable_commit_hook () {
1855         return close($commitlock) if $commitlock;
1856         return;
1859 sub loadindex () {
1860         %oldrenderedfiles=%pagectime=();
1861         my $rebuild=$config{rebuild};
1862         if (! $rebuild) {
1863                 %pagesources=%pagemtime=%oldlinks=%links=%depends=
1864                 %destsources=%renderedfiles=%pagecase=%pagestate=
1865                 %depends_simple=%typedlinks=%oldtypedlinks=();
1866         }
1867         my $in;
1868         if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
1869                 if (-e "$config{wikistatedir}/index") {
1870                         system("ikiwiki-transition", "indexdb", $config{srcdir});
1871                         open ($in, "<", "$config{wikistatedir}/indexdb") || return;
1872                 }
1873                 else {
1874                         # gettime on first build
1875                         $config{gettime}=1 unless defined $config{gettime};
1876                         return;
1877                 }
1878         }
1880         my $index=Storable::fd_retrieve($in);
1881         if (! defined $index) {
1882                 return 0;
1883         }
1885         my $pages;
1886         if (exists $index->{version} && ! ref $index->{version}) {
1887                 $pages=$index->{page};
1888                 %wikistate=%{$index->{state}};
1889                 # Handle plugins that got disabled by loading a new setup.
1890                 if (exists $config{setupfile}) {
1891                         require IkiWiki::Setup;
1892                         IkiWiki::Setup::disabled_plugins(
1893                                 grep { ! $loaded_plugins{$_} } keys %wikistate);
1894                 }
1895         }
1896         else {
1897                 $pages=$index;
1898                 %wikistate=();
1899         }
1901         foreach my $src (keys %$pages) {
1902                 my $d=$pages->{$src};
1903                 my $page;
1904                 if (exists $d->{page} && ! $rebuild) {
1905                         $page=$d->{page};
1906                 }
1907                 else {
1908                         $page=pagename($src);
1909                 }
1910                 $pagectime{$page}=$d->{ctime};
1911                 $pagesources{$page}=$src;
1912                 if (! $rebuild) {
1913                         $pagemtime{$page}=$d->{mtime};
1914                         $renderedfiles{$page}=$d->{dest};
1915                         if (exists $d->{links} && ref $d->{links}) {
1916                                 $links{$page}=$d->{links};
1917                                 $oldlinks{$page}=[@{$d->{links}}];
1918                         }
1919                         if (ref $d->{depends_simple} eq 'ARRAY') {
1920                                 # old format
1921                                 $depends_simple{$page}={
1922                                         map { $_ => 1 } @{$d->{depends_simple}}
1923                                 };
1924                         }
1925                         elsif (exists $d->{depends_simple}) {
1926                                 $depends_simple{$page}=$d->{depends_simple};
1927                         }
1928                         if (exists $d->{dependslist}) {
1929                                 # old format
1930                                 $depends{$page}={
1931                                         map { $_ => $DEPEND_CONTENT }
1932                                                 @{$d->{dependslist}}
1933                                 };
1934                         }
1935                         elsif (exists $d->{depends} && ! ref $d->{depends}) {
1936                                 # old format
1937                                 $depends{$page}={$d->{depends} => $DEPEND_CONTENT };
1938                         }
1939                         elsif (exists $d->{depends}) {
1940                                 $depends{$page}=$d->{depends};
1941                         }
1942                         if (exists $d->{state}) {
1943                                 $pagestate{$page}=$d->{state};
1944                         }
1945                         if (exists $d->{typedlinks}) {
1946                                 $typedlinks{$page}=$d->{typedlinks};
1948                                 while (my ($type, $links) = each %{$typedlinks{$page}}) {
1949                                         next unless %$links;
1950                                         $oldtypedlinks{$page}{$type} = {%$links};
1951                                 }
1952                         }
1953                 }
1954                 $oldrenderedfiles{$page}=[@{$d->{dest}}];
1955         }
1956         foreach my $page (keys %pagesources) {
1957                 $pagecase{lc $page}=$page;
1958         }
1959         foreach my $page (keys %renderedfiles) {
1960                 $destsources{$_}=$page foreach @{$renderedfiles{$page}};
1961         }
1962         $lastrev=$index->{lastrev};
1963         @underlayfiles=@{$index->{underlayfiles}} if ref $index->{underlayfiles};
1964         return close($in);
1967 sub saveindex () {
1968         run_hooks(savestate => sub { shift->() });
1970         my @plugins=keys %loaded_plugins;
1972         if (! -d $config{wikistatedir}) {
1973                 mkdir($config{wikistatedir});
1974         }
1975         my $newfile="$config{wikistatedir}/indexdb.new";
1976         my $cleanup = sub { unlink($newfile) };
1977         open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
1979         my %index;
1980         foreach my $page (keys %pagemtime) {
1981                 next unless $pagemtime{$page};
1982                 my $src=$pagesources{$page};
1984                 $index{page}{$src}={
1985                         page => $page,
1986                         ctime => $pagectime{$page},
1987                         mtime => $pagemtime{$page},
1988                         dest => $renderedfiles{$page},
1989                         links => $links{$page},
1990                 };
1992                 if (exists $depends{$page}) {
1993                         $index{page}{$src}{depends} = $depends{$page};
1994                 }
1996                 if (exists $depends_simple{$page}) {
1997                         $index{page}{$src}{depends_simple} = $depends_simple{$page};
1998                 }
2000                 if (exists $typedlinks{$page} && %{$typedlinks{$page}}) {
2001                         $index{page}{$src}{typedlinks} = $typedlinks{$page};
2002                 }
2004                 if (exists $pagestate{$page}) {
2005                         $index{page}{$src}{state}=$pagestate{$page};
2006                 }
2007         }
2009         $index{state}={};
2010         foreach my $id (@plugins) {
2011                 $index{state}{$id}={}; # used to detect disabled plugins
2012                 foreach my $key (keys %{$wikistate{$id}}) {
2013                         $index{state}{$id}{$key}=$wikistate{$id}{$key};
2014                 }
2015         }
2016         
2017         $index{lastrev}=$lastrev;
2018         $index{underlayfiles}=\@underlayfiles;
2020         $index{version}="3";
2021         my $ret=Storable::nstore_fd(\%index, $out);
2022         return if ! defined $ret || ! $ret;
2023         close $out || error("failed saving to $newfile: $!", $cleanup);
2024         rename($newfile, "$config{wikistatedir}/indexdb") ||
2025                 error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
2026         
2027         return 1;
2030 sub template_file ($) {
2031         my $name=shift;
2032         
2033         my $tpage=($name =~ s/^\///) ? $name : "templates/$name";
2034         my $template;
2035         if ($name !~ /\.tmpl$/ && exists $pagesources{$tpage}) {
2036                 $template=srcfile($pagesources{$tpage}, 1);
2037                 $name.=".tmpl";
2038         }
2039         else {
2040                 $template=srcfile($tpage, 1);
2041         }
2043         if (defined $template) {
2044                 return $template, $tpage, 1 if wantarray;
2045                 return $template;
2046         }
2047         else {
2048                 $name=~s:/::; # avoid path traversal
2049                 foreach my $dir ($config{templatedir},
2050                                  "$installdir/share/ikiwiki/templates") {
2051                         if (-e "$dir/$name") {
2052                                 $template="$dir/$name";
2053                                 last;
2054                         }
2055                 }
2056                 if (defined $template) {        
2057                         return $template, $tpage if wantarray;
2058                         return $template;
2059                 }
2060         }
2062         return;
2065 sub template_depends ($$;@) {
2066         my $name=shift;
2067         my $page=shift;
2068         
2069         my ($filename, $tpage, $untrusted)=template_file($name);
2070         if (! defined $filename) {
2071                 error(sprintf(gettext("template %s not found"), $name))
2072         }
2074         if (defined $page && defined $tpage) {
2075                 add_depends($page, $tpage);
2076         }
2078         my @opts=(
2079                 filter => sub {
2080                         my $text_ref = shift;
2081                         ${$text_ref} = decode_utf8(${$text_ref});
2082                         run_hooks(readtemplate => sub {
2083                                 ${$text_ref} = shift->(
2084                                         id => $name,
2085                                         page => $tpage,
2086                                         content => ${$text_ref},
2087                                         untrusted => $untrusted,
2088                                 );
2089                         });
2090                 },
2091                 loop_context_vars => 1,
2092                 die_on_bad_params => 0,
2093                 parent_global_vars => 1,
2094                 filename => $filename,
2095                 @_,
2096                 ($untrusted ? (no_includes => 1) : ()),
2097         );
2098         return @opts if wantarray;
2100         require HTML::Template;
2101         return HTML::Template->new(@opts);
2104 sub template ($;@) {
2105         template_depends(shift, undef, @_);
2108 sub templateactions ($$) {
2109         my $template=shift;
2110         my $page=shift;
2112         my $have_actions=0;
2113         my @actions;
2114         run_hooks(pageactions => sub {
2115                 push @actions, map { { action => $_ } } 
2116                         grep { defined } shift->(page => $page);
2117         });
2118         $template->param(actions => \@actions);
2120         if ($config{cgiurl} && exists $hooks{auth}) {
2121                 $template->param(prefsurl => cgiurl(do => "prefs"));
2122                 $have_actions=1;
2123         }
2125         if ($have_actions || @actions) {
2126                 $template->param(have_actions => 1);
2127         }
2130 sub hook (@) {
2131         my %param=@_;
2132         
2133         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
2134                 error 'hook requires type, call, and id parameters';
2135         }
2137         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
2138         
2139         $hooks{$param{type}}{$param{id}}=\%param;
2140         return 1;
2143 sub run_hooks ($$) {
2144         # Calls the given sub for each hook of the given type,
2145         # passing it the hook function to call.
2146         my $type=shift;
2147         my $sub=shift;
2149         if (exists $hooks{$type}) {
2150                 my (@first, @middle, @last);
2151                 foreach my $id (keys %{$hooks{$type}}) {
2152                         if ($hooks{$type}{$id}{first}) {
2153                                 push @first, $id;
2154                         }
2155                         elsif ($hooks{$type}{$id}{last}) {
2156                                 push @last, $id;
2157                         }
2158                         else {
2159                                 push @middle, $id;
2160                         }
2161                 }
2162                 foreach my $id (@first, @middle, @last) {
2163                         $sub->($hooks{$type}{$id}{call});
2164                 }
2165         }
2167         return 1;
2170 sub rcs_update () {
2171         $hooks{rcs}{rcs_update}{call}->(@_);
2174 sub rcs_prepedit ($) {
2175         $hooks{rcs}{rcs_prepedit}{call}->(@_);
2178 sub rcs_commit (@) {
2179         $hooks{rcs}{rcs_commit}{call}->(@_);
2182 sub rcs_commit_staged (@) {
2183         $hooks{rcs}{rcs_commit_staged}{call}->(@_);
2186 sub rcs_add ($) {
2187         $hooks{rcs}{rcs_add}{call}->(@_);
2190 sub rcs_remove ($) {
2191         $hooks{rcs}{rcs_remove}{call}->(@_);
2194 sub rcs_rename ($$) {
2195         $hooks{rcs}{rcs_rename}{call}->(@_);
2198 sub rcs_recentchanges ($) {
2199         $hooks{rcs}{rcs_recentchanges}{call}->(@_);
2202 sub rcs_diff ($;$) {
2203         $hooks{rcs}{rcs_diff}{call}->(@_);
2206 sub rcs_getctime ($) {
2207         $hooks{rcs}{rcs_getctime}{call}->(@_);
2210 sub rcs_getmtime ($) {
2211         $hooks{rcs}{rcs_getmtime}{call}->(@_);
2214 sub rcs_receive () {
2215         $hooks{rcs}{rcs_receive}{call}->();
2218 sub add_depends ($$;$) {
2219         my $page=shift;
2220         my $pagespec=shift;
2221         my $deptype=shift || $DEPEND_CONTENT;
2223         # Is the pagespec a simple page name?
2224         if ($pagespec =~ /$config{wiki_file_regexp}/ &&
2225             $pagespec !~ /[\s*?()!]/) {
2226                 $depends_simple{$page}{lc $pagespec} |= $deptype;
2227                 return 1;
2228         }
2230         # Add explicit dependencies for influences.
2231         my $sub=pagespec_translate($pagespec);
2232         return unless defined $sub;
2233         foreach my $p (keys %pagesources) {
2234                 my $r=$sub->($p, location => $page);
2235                 my $i=$r->influences;
2236                 my $static=$r->influences_static;
2237                 foreach my $k (keys %$i) {
2238                         next unless $r || $static || $k eq $page;
2239                         $depends_simple{$page}{lc $k} |= $i->{$k};
2240                 }
2241                 last if $static;
2242         }
2244         $depends{$page}{$pagespec} |= $deptype;
2245         return 1;
2248 sub deptype (@) {
2249         my $deptype=0;
2250         foreach my $type (@_) {
2251                 if ($type eq 'presence') {
2252                         $deptype |= $DEPEND_PRESENCE;
2253                 }
2254                 elsif ($type eq 'links') { 
2255                         $deptype |= $DEPEND_LINKS;
2256                 }
2257                 elsif ($type eq 'content') {
2258                         $deptype |= $DEPEND_CONTENT;
2259                 }
2260         }
2261         return $deptype;
2264 my $file_prune_regexp;
2265 sub file_pruned ($) {
2266         my $file=shift;
2268         if (defined $config{include} && length $config{include}) {
2269                 return 0 if $file =~ m/$config{include}/;
2270         }
2272         if (! defined $file_prune_regexp) {
2273                 $file_prune_regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
2274                 $file_prune_regexp=qr/$file_prune_regexp/;
2275         }
2276         return $file =~ m/$file_prune_regexp/;
2279 sub define_gettext () {
2280         # If translation is needed, redefine the gettext function to do it.
2281         # Otherwise, it becomes a quick no-op.
2282         my $gettext_obj;
2283         my $getobj;
2284         if ((exists $ENV{LANG} && length $ENV{LANG}) ||
2285             (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
2286             (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
2287                 $getobj=sub {
2288                         $gettext_obj=eval q{
2289                                 use Locale::gettext q{textdomain};
2290                                 Locale::gettext->domain('ikiwiki')
2291                         };
2292                 };
2293         }
2295         no warnings 'redefine';
2296         *gettext=sub {
2297                 $getobj->() if $getobj;
2298                 if ($gettext_obj) {
2299                         $gettext_obj->get(shift);
2300                 }
2301                 else {
2302                         return shift;
2303                 }
2304         };
2305         *ngettext=sub {
2306                 $getobj->() if $getobj;
2307                 if ($gettext_obj) {
2308                         $gettext_obj->nget(@_);
2309                 }
2310                 else {
2311                         return ($_[2] == 1 ? $_[0] : $_[1])
2312                 }
2313         };
2316 sub gettext {
2317         define_gettext();
2318         gettext(@_);
2321 sub ngettext {
2322         define_gettext();
2323         ngettext(@_);
2326 sub yesno ($) {
2327         my $val=shift;
2329         return (defined $val && (lc($val) eq gettext("yes") || lc($val) eq "yes" || $val eq "1"));
2332 sub inject {
2333         # Injects a new function into the symbol table to replace an
2334         # exported function.
2335         my %params=@_;
2337         # This is deep ugly perl foo, beware.
2338         no strict;
2339         no warnings;
2340         if (! defined $params{parent}) {
2341                 $params{parent}='::';
2342                 $params{old}=\&{$params{name}};
2343                 $params{name}=~s/.*:://;
2344         }
2345         my $parent=$params{parent};
2346         foreach my $ns (grep /^\w+::/, keys %{$parent}) {
2347                 $ns = $params{parent} . $ns;
2348                 inject(%params, parent => $ns) unless $ns eq '::main::';
2349                 *{$ns . $params{name}} = $params{call}
2350                         if exists ${$ns}{$params{name}} &&
2351                            \&{${$ns}{$params{name}}} == $params{old};
2352         }
2353         use strict;
2354         use warnings;
2357 sub add_link ($$;$) {
2358         my $page=shift;
2359         my $link=shift;
2360         my $type=shift;
2362         push @{$links{$page}}, $link
2363                 unless grep { $_ eq $link } @{$links{$page}};
2365         if (defined $type) {
2366                 $typedlinks{$page}{$type}{$link} = 1;
2367         }
2370 sub add_autofile ($$$) {
2371         my $file=shift;
2372         my $plugin=shift;
2373         my $generator=shift;
2374         
2375         $autofiles{$file}{plugin}=$plugin;
2376         $autofiles{$file}{generator}=$generator;
2379 sub useragent () {
2380         return LWP::UserAgent->new(
2381                 cookie_jar => $config{cookiejar},
2382                 env_proxy => 1,         # respect proxy env vars
2383                 agent => $config{useragent},
2384         );
2387 sub sortspec_translate ($$) {
2388         my $spec = shift;
2389         my $reverse = shift;
2391         my $code = "";
2392         my @data;
2393         while ($spec =~ m{
2394                 \s*
2395                 (-?)            # group 1: perhaps negated
2396                 \s*
2397                 (               # group 2: a word
2398                         \w+\([^\)]*\)   # command(params)
2399                         |
2400                         [^\s]+          # or anything else
2401                 )
2402                 \s*
2403         }gx) {
2404                 my $negated = $1;
2405                 my $word = $2;
2406                 my $params = undef;
2408                 if ($word =~ m/^(\w+)\((.*)\)$/) {
2409                         # command with parameters
2410                         $params = $2;
2411                         $word = $1;
2412                 }
2413                 elsif ($word !~ m/^\w+$/) {
2414                         error(sprintf(gettext("invalid sort type %s"), $word));
2415                 }
2417                 if (length $code) {
2418                         $code .= " || ";
2419                 }
2421                 if ($negated) {
2422                         $code .= "-";
2423                 }
2425                 if (exists $IkiWiki::SortSpec::{"cmp_$word"}) {
2426                         if (defined $params) {
2427                                 push @data, $params;
2428                                 $code .= "IkiWiki::SortSpec::cmp_$word(\$data[$#data])";
2429                         }
2430                         else {
2431                                 $code .= "IkiWiki::SortSpec::cmp_$word(undef)";
2432                         }
2433                 }
2434                 else {
2435                         error(sprintf(gettext("unknown sort type %s"), $word));
2436                 }
2437         }
2439         if (! length $code) {
2440                 # undefined sorting method... sort arbitrarily
2441                 return sub { 0 };
2442         }
2444         if ($reverse) {
2445                 $code="-($code)";
2446         }
2448         no warnings;
2449         return eval 'sub { '.$code.' }';
2452 sub pagespec_translate ($) {
2453         my $spec=shift;
2455         # Convert spec to perl code.
2456         my $code="";
2457         my @data;
2458         while ($spec=~m{
2459                 \s*             # ignore whitespace
2460                 (               # 1: match a single word
2461                         \!              # !
2462                 |
2463                         \(              # (
2464                 |
2465                         \)              # )
2466                 |
2467                         \w+\([^\)]*\)   # command(params)
2468                 |
2469                         [^\s()]+        # any other text
2470                 )
2471                 \s*             # ignore whitespace
2472         }gx) {
2473                 my $word=$1;
2474                 if (lc $word eq 'and') {
2475                         $code.=' &';
2476                 }
2477                 elsif (lc $word eq 'or') {
2478                         $code.=' |';
2479                 }
2480                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
2481                         $code.=' '.$word;
2482                 }
2483                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
2484                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
2485                                 push @data, $2;
2486                                 $code.="IkiWiki::PageSpec::match_$1(\$page, \$data[$#data], \@_)";
2487                         }
2488                         else {
2489                                 push @data, qq{unknown function in pagespec "$word"};
2490                                 $code.="IkiWiki::ErrorReason->new(\$data[$#data])";
2491                         }
2492                 }
2493                 else {
2494                         push @data, $word;
2495                         $code.=" IkiWiki::PageSpec::match_glob(\$page, \$data[$#data], \@_)";
2496                 }
2497         }
2499         if (! length $code) {
2500                 $code="IkiWiki::FailReason->new('empty pagespec')";
2501         }
2503         no warnings;
2504         return eval 'sub { my $page=shift; '.$code.' }';
2507 sub pagespec_match ($$;@) {
2508         my $page=shift;
2509         my $spec=shift;
2510         my @params=@_;
2512         # Backwards compatability with old calling convention.
2513         if (@params == 1) {
2514                 unshift @params, 'location';
2515         }
2517         my $sub=pagespec_translate($spec);
2518         return IkiWiki::ErrorReason->new("syntax error in pagespec \"$spec\"")
2519                 if ! defined $sub;
2520         return $sub->($page, @params);
2523 # e.g. @pages = sort_pages("title", \@pages, reverse => "yes")
2525 # Not exported yet, but could be in future if it is generally useful.
2526 # Note that this signature is not the same as IkiWiki::SortSpec::sort_pages,
2527 # which is "more internal".
2528 sub sort_pages ($$;@) {
2529         my $sort = shift;
2530         my $list = shift;
2531         my %params = @_;
2532         $sort = sortspec_translate($sort, $params{reverse});
2533         return IkiWiki::SortSpec::sort_pages($sort, @$list);
2536 sub pagespec_match_list ($$;@) {
2537         my $page=shift;
2538         my $pagespec=shift;
2539         my %params=@_;
2541         # Backwards compatability with old calling convention.
2542         if (ref $page) {
2543                 print STDERR "warning: a plugin (".caller().") is using pagespec_match_list in an obsolete way, and needs to be updated\n";
2544                 $params{list}=$page;
2545                 $page=$params{location}; # ugh!
2546         }
2548         my $sub=pagespec_translate($pagespec);
2549         error "syntax error in pagespec \"$pagespec\""
2550                 if ! defined $sub;
2551         my $sort=sortspec_translate($params{sort}, $params{reverse})
2552                 if defined $params{sort};
2554         my @candidates;
2555         if (exists $params{list}) {
2556                 @candidates=exists $params{filter}
2557                         ? grep { ! $params{filter}->($_) } @{$params{list}}
2558                         : @{$params{list}};
2559         }
2560         else {
2561                 @candidates=exists $params{filter}
2562                         ? grep { ! $params{filter}->($_) } keys %pagesources
2563                         : keys %pagesources;
2564         }
2565         
2566         # clear params, remainder is passed to pagespec
2567         $depends{$page}{$pagespec} |= ($params{deptype} || $DEPEND_CONTENT);
2568         my $num=$params{num};
2569         delete @params{qw{num deptype reverse sort filter list}};
2570         
2571         # when only the top matches will be returned, it's efficient to
2572         # sort before matching to pagespec,
2573         if (defined $num && defined $sort) {
2574                 @candidates=IkiWiki::SortSpec::sort_pages(
2575                         $sort, @candidates);
2576         }
2577         
2578         my @matches;
2579         my $firstfail;
2580         my $count=0;
2581         my $accum=IkiWiki::SuccessReason->new();
2582         foreach my $p (@candidates) {
2583                 my $r=$sub->($p, %params, location => $page);
2584                 error(sprintf(gettext("cannot match pages: %s"), $r))
2585                         if $r->isa("IkiWiki::ErrorReason");
2586                 unless ($r || $r->influences_static) {
2587                         $r->remove_influence($p);
2588                 }
2589                 $accum |= $r;
2590                 if ($r) {
2591                         push @matches, $p;
2592                         last if defined $num && ++$count == $num;
2593                 }
2594         }
2596         # Add simple dependencies for accumulated influences.
2597         my $i=$accum->influences;
2598         foreach my $k (keys %$i) {
2599                 $depends_simple{$page}{lc $k} |= $i->{$k};
2600         }
2602         # when all matches will be returned, it's efficient to
2603         # sort after matching
2604         if (! defined $num && defined $sort) {
2605                 return IkiWiki::SortSpec::sort_pages(
2606                         $sort, @matches);
2607         }
2608         else {
2609                 return @matches;
2610         }
2613 sub pagespec_valid ($) {
2614         my $spec=shift;
2616         return defined pagespec_translate($spec);
2619 sub glob2re ($) {
2620         my $re=quotemeta(shift);
2621         $re=~s/\\\*/.*/g;
2622         $re=~s/\\\?/./g;
2623         return qr/^$re$/i;
2626 package IkiWiki::FailReason;
2628 use overload (
2629         '""'    => sub { $_[0][0] },
2630         '0+'    => sub { 0 },
2631         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
2632         '&'     => sub { $_[0]->merge_influences($_[1], 1); $_[0] },
2633         '|'     => sub { $_[1]->merge_influences($_[0]); $_[1] },
2634         fallback => 1,
2635 );
2637 our @ISA = 'IkiWiki::SuccessReason';
2639 package IkiWiki::SuccessReason;
2641 # A blessed array-ref:
2643 # [0]: human-readable reason for success (or, in FailReason subclass, failure)
2644 # [1]{""}:
2645 #      - if absent or false, the influences of this evaluation are "static",
2646 #        see the influences_static method
2647 #      - if true, they are dynamic (not static)
2648 # [1]{any other key}:
2649 #      the dependency types of influences, as returned by the influences method
2651 use overload (
2652         # in string context, it's the human-readable reason
2653         '""'    => sub { $_[0][0] },
2654         # in boolean context, SuccessReason is 1 and FailReason is 0
2655         '0+'    => sub { 1 },
2656         # negating a result gives the opposite result with the same influences
2657         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
2658         # A & B = (A ? B : A) with the influences of both
2659         '&'     => sub { $_[1]->merge_influences($_[0], 1); $_[1] },
2660         # A | B = (A ? A : B) with the influences of both
2661         '|'     => sub { $_[0]->merge_influences($_[1]); $_[0] },
2662         fallback => 1,
2663 );
2665 # SuccessReason->new("human-readable reason", page => deptype, ...)
2667 sub new {
2668         my $class = shift;
2669         my $value = shift;
2670         return bless [$value, {@_}], $class;
2673 # influences(): return a reference to a copy of the hash
2674 # { page => dependency type } describing the pages that indirectly influenced
2675 # this result, but would not cause a dependency through ikiwiki's core
2676 # dependency logic.
2678 # See [[todo/dependency_types]] for extensive discussion of what this means.
2680 # influences(page => deptype, ...): remove all influences, replace them
2681 # with the arguments, and return a reference to a copy of the new influences.
2683 sub influences {
2684         my $this=shift;
2685         $this->[1]={@_} if @_;
2686         my %i=%{$this->[1]};
2687         delete $i{""};
2688         return \%i;
2691 # True if this result has the same influences whichever page it matches,
2692 # For instance, whether bar matches backlink(foo) is influenced only by
2693 # the set of links in foo, so its only influence is { foo => DEPEND_LINKS },
2694 # which does not mention bar anywhere.
2696 # False if this result would have different influences when matching
2697 # different pages. For instance, when testing whether link(foo) matches bar,
2698 # { bar => DEPEND_LINKS } is an influence on that result, because changing
2699 # bar's links could change the outcome; so its influences are not the same
2700 # as when testing whether link(foo) matches baz.
2702 # Static influences are one of the things that make pagespec_match_list
2703 # more efficient than repeated calls to pagespec_match.
2705 sub influences_static {
2706         return ! $_[0][1]->{""};
2709 # Change the influences of $this to be the influences of "$this & $other"
2710 # or "$this | $other".
2712 # If both $this and $other are either successful or have influences,
2713 # or this is an "or" operation, the result has all the influences from
2714 # either of the arguments. It has dynamic influences if either argument
2715 # has dynamic influences.
2717 # If this is an "and" operation, and at least one argument is a
2718 # FailReason with no influences, the result has no influences, and they
2719 # are not dynamic. For instance, link(foo) matching bar is influenced
2720 # by bar, but enabled(ddate) has no influences. Suppose ddate is disabled;
2721 # then (link(foo) and enabled(ddate)) not matching bar is not influenced by
2722 # bar, because it would be false however often you edit bar.
2724 sub merge_influences {
2725         my $this=shift;
2726         my $other=shift;
2727         my $anded=shift;
2729         # This "if" is odd because it needs to avoid negating $this
2730         # or $other, which would alter the objects in-place. Be careful.
2731         if (! $anded || (($this || %{$this->[1]}) &&
2732                          ($other || %{$other->[1]}))) {
2733                 foreach my $influence (keys %{$other->[1]}) {
2734                         $this->[1]{$influence} |= $other->[1]{$influence};
2735                 }
2736         }
2737         else {
2738                 # influence blocker
2739                 $this->[1]={};
2740         }
2743 # Change $this so it is not considered to be influenced by $torm.
2745 sub remove_influence {
2746         my $this=shift;
2747         my $torm=shift;
2749         delete $this->[1]{$torm};
2752 package IkiWiki::ErrorReason;
2754 our @ISA = 'IkiWiki::FailReason';
2756 package IkiWiki::PageSpec;
2758 sub derel ($$) {
2759         my $path=shift;
2760         my $from=shift;
2762         if ($path =~ m!^\.(/|$)!) {
2763                 if ($1) {
2764                         $from=~s#/?[^/]+$## if defined $from;
2765                         $path=~s#^\./##;
2766                         $path="$from/$path" if defined $from && length $from;
2767                 }
2768                 else {
2769                         $path = $from;
2770                         $path = "" unless defined $path;
2771                 }
2772         }
2774         return $path;
2777 my %glob_cache;
2779 sub match_glob ($$;@) {
2780         my $page=shift;
2781         my $glob=shift;
2782         my %params=@_;
2783         
2784         $glob=derel($glob, $params{location});
2786         # Instead of converting the glob to a regex every time,
2787         # cache the compiled regex to save time.
2788         my $re=$glob_cache{$glob};
2789         unless (defined $re) {
2790                 $glob_cache{$glob} = $re = IkiWiki::glob2re($glob);
2791         }
2792         if ($page =~ $re) {
2793                 if (! IkiWiki::isinternal($page) || $params{internal}) {
2794                         return IkiWiki::SuccessReason->new("$glob matches $page");
2795                 }
2796                 else {
2797                         return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
2798                 }
2799         }
2800         else {
2801                 return IkiWiki::FailReason->new("$glob does not match $page");
2802         }
2805 sub match_internal ($$;@) {
2806         return match_glob(shift, shift, @_, internal => 1)
2809 sub match_page ($$;@) {
2810         my $page=shift;
2811         my $match=match_glob($page, shift, @_);
2812         if ($match) {
2813                 my $source=exists $IkiWiki::pagesources{$page} ?
2814                         $IkiWiki::pagesources{$page} :
2815                         $IkiWiki::delpagesources{$page};
2816                 my $type=defined $source ? IkiWiki::pagetype($source) : undef;
2817                 if (! defined $type) {  
2818                         return IkiWiki::FailReason->new("$page is not a page");
2819                 }
2820         }
2821         return $match;
2824 sub match_link ($$;@) {
2825         my $page=shift;
2826         my $link=lc(shift);
2827         my %params=@_;
2829         $link=derel($link, $params{location});
2830         my $from=exists $params{location} ? $params{location} : '';
2831         my $linktype=$params{linktype};
2832         my $qualifier='';
2833         if (defined $linktype) {
2834                 $qualifier=" with type $linktype";
2835         }
2837         my $links = $IkiWiki::links{$page};
2838         return IkiWiki::FailReason->new("$page has no links", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
2839                 unless $links && @{$links};
2840         my $bestlink = IkiWiki::bestlink($from, $link);
2841         foreach my $p (@{$links}) {
2842                 next unless (! defined $linktype || exists $IkiWiki::typedlinks{$page}{$linktype}{$p});
2844                 if (length $bestlink) {
2845                         if ($bestlink eq IkiWiki::bestlink($page, $p)) {
2846                                 return IkiWiki::SuccessReason->new("$page links to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
2847                         }
2848                 }
2849                 else {
2850                         if (match_glob($p, $link, %params)) {
2851                                 return IkiWiki::SuccessReason->new("$page links to page $p$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
2852                         }
2853                         my ($p_rel)=$p=~/^\/?(.*)/;
2854                         $link=~s/^\///;
2855                         if (match_glob($p_rel, $link, %params)) {
2856                                 return IkiWiki::SuccessReason->new("$page links to page $p_rel$qualifier, matching $link", $page => $IkiWiki::DEPEND_LINKS, "" => 1)
2857                         }
2858                 }
2859         }
2860         return IkiWiki::FailReason->new("$page does not link to $link$qualifier", $page => $IkiWiki::DEPEND_LINKS, "" => 1);
2863 sub match_backlink ($$;@) {
2864         my $page=shift;
2865         my $testpage=shift;
2866         my %params=@_;
2867         if ($testpage eq '.') {
2868                 $testpage = $params{'location'}
2869         }
2870         my $ret=match_link($testpage, $page, @_);
2871         $ret->influences($testpage => $IkiWiki::DEPEND_LINKS);
2872         return $ret;
2875 sub match_created_before ($$;@) {
2876         my $page=shift;
2877         my $testpage=shift;
2878         my %params=@_;
2879         
2880         $testpage=derel($testpage, $params{location});
2882         if (exists $IkiWiki::pagectime{$testpage}) {
2883                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
2884                         return IkiWiki::SuccessReason->new("$page created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
2885                 }
2886                 else {
2887                         return IkiWiki::FailReason->new("$page not created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
2888                 }
2889         }
2890         else {
2891                 return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
2892         }
2895 sub match_created_after ($$;@) {
2896         my $page=shift;
2897         my $testpage=shift;
2898         my %params=@_;
2899         
2900         $testpage=derel($testpage, $params{location});
2902         if (exists $IkiWiki::pagectime{$testpage}) {
2903                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
2904                         return IkiWiki::SuccessReason->new("$page created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
2905                 }
2906                 else {
2907                         return IkiWiki::FailReason->new("$page not created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
2908                 }
2909         }
2910         else {
2911                 return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
2912         }
2915 sub match_creation_day ($$;@) {
2916         my $page=shift;
2917         my $d=shift;
2918         if ($d !~ /^\d+$/) {
2919                 return IkiWiki::ErrorReason->new("invalid day $d");
2920         }
2921         if ((localtime($IkiWiki::pagectime{$page}))[3] == $d) {
2922                 return IkiWiki::SuccessReason->new('creation_day matched');
2923         }
2924         else {
2925                 return IkiWiki::FailReason->new('creation_day did not match');
2926         }
2929 sub match_creation_month ($$;@) {
2930         my $page=shift;
2931         my $m=shift;
2932         if ($m !~ /^\d+$/) {
2933                 return IkiWiki::ErrorReason->new("invalid month $m");
2934         }
2935         if ((localtime($IkiWiki::pagectime{$page}))[4] + 1 == $m) {
2936                 return IkiWiki::SuccessReason->new('creation_month matched');
2937         }
2938         else {
2939                 return IkiWiki::FailReason->new('creation_month did not match');
2940         }
2943 sub match_creation_year ($$;@) {
2944         my $page=shift;
2945         my $y=shift;
2946         if ($y !~ /^\d+$/) {
2947                 return IkiWiki::ErrorReason->new("invalid year $y");
2948         }
2949         if ((localtime($IkiWiki::pagectime{$page}))[5] + 1900 == $y) {
2950                 return IkiWiki::SuccessReason->new('creation_year matched');
2951         }
2952         else {
2953                 return IkiWiki::FailReason->new('creation_year did not match');
2954         }
2957 sub match_user ($$;@) {
2958         shift;
2959         my $user=shift;
2960         my %params=@_;
2961         
2962         if (! exists $params{user}) {
2963                 return IkiWiki::ErrorReason->new("no user specified");
2964         }
2966         my $regexp=IkiWiki::glob2re($user);
2967         
2968         if (defined $params{user} && $params{user}=~$regexp) {
2969                 return IkiWiki::SuccessReason->new("user is $user");
2970         }
2971         elsif (! defined $params{user}) {
2972                 return IkiWiki::FailReason->new("not logged in");
2973         }
2974         else {
2975                 return IkiWiki::FailReason->new("user is $params{user}, not $user");
2976         }
2979 sub match_admin ($$;@) {
2980         shift;
2981         shift;
2982         my %params=@_;
2983         
2984         if (! exists $params{user}) {
2985                 return IkiWiki::ErrorReason->new("no user specified");
2986         }
2988         if (defined $params{user} && IkiWiki::is_admin($params{user})) {
2989                 return IkiWiki::SuccessReason->new("user is an admin");
2990         }
2991         elsif (! defined $params{user}) {
2992                 return IkiWiki::FailReason->new("not logged in");
2993         }
2994         else {
2995                 return IkiWiki::FailReason->new("user is not an admin");
2996         }
2999 sub match_ip ($$;@) {
3000         shift;
3001         my $ip=shift;
3002         my %params=@_;
3003         
3004         if (! exists $params{ip}) {
3005                 return IkiWiki::ErrorReason->new("no IP specified");
3006         }
3007         
3008         my $regexp=IkiWiki::glob2re(lc $ip);
3010         if (defined $params{ip} && lc $params{ip}=~$regexp) {
3011                 return IkiWiki::SuccessReason->new("IP is $ip");
3012         }
3013         else {
3014                 return IkiWiki::FailReason->new("IP is $params{ip}, not $ip");
3015         }
3018 package IkiWiki::SortSpec;
3020 # This is in the SortSpec namespace so that the $a and $b that sort() uses
3021 # are easily available in this namespace, for cmp functions to use them.
3022 sub sort_pages {
3023         my $f=shift;
3024         sort $f @_
3027 sub cmp_title {
3028         IkiWiki::pagetitle(IkiWiki::basename($a))
3029         cmp
3030         IkiWiki::pagetitle(IkiWiki::basename($b))
3033 sub cmp_path { IkiWiki::pagetitle($a) cmp IkiWiki::pagetitle($b) }
3034 sub cmp_mtime { $IkiWiki::pagemtime{$b} <=> $IkiWiki::pagemtime{$a} }
3035 sub cmp_age { $IkiWiki::pagectime{$b} <=> $IkiWiki::pagectime{$a} }