]> sipb.mit.edu Git - ikiwiki.git/blob - IkiWiki.pm
fix undef issue
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4 use warnings;
5 use strict;
6 use Encode;
7 use HTML::Entities;
8 use URI::Escape q{uri_escape_utf8};
9 use POSIX;
10 use open qw{:utf8 :std};
11
12 use vars qw{%config %links %oldlinks %pagemtime %pagectime %pagecase
13             %renderedfiles %oldrenderedfiles %pagesources %destsources
14             %depends %hooks %forcerebuild $gettext_obj};
15
16 use Exporter q{import};
17 our @EXPORT = qw(hook debug error template htmlpage add_depends pagespec_match
18                  bestlink htmllink readfile writefile pagetype srcfile pagename
19                  displaytime will_render gettext urlto targetpage
20                  %config %links %renderedfiles %pagesources %destsources);
21 our $VERSION = 2.00; # plugin interface version, next is ikiwiki version
22 our $version='unknown'; # VERSION_AUTOREPLACE done by Makefile, DNE
23 my $installdir=''; # INSTALLDIR_AUTOREPLACE done by Makefile, DNE
24
25 # Optimisation.
26 use Memoize;
27 memoize("abs2rel");
28 memoize("pagespec_translate");
29 memoize("file_pruned");
30
31 sub defaultconfig () { #{{{
32         return
33         wiki_file_prune_regexps => [qr/\.\./, qr/^\./, qr/\/\./,
34                 qr/\.x?html?$/, qr/\.ikiwiki-new$/,
35                 qr/(^|\/).svn\//, qr/.arch-ids\//, qr/{arch}\//,
36                 qr/(^|\/)_MTN\//,
37                 qr/\.dpkg-tmp$/],
38         wiki_link_regexp => qr{
39                 \[\[                    # beginning of link
40                 (?:
41                         ([^\]\|]+)      # 1: link text
42                         \|              # followed by '|'
43                 )?                      # optional
44                 
45                 ([^\s\]#]+)             # 2: page to link to
46                 (?:
47                         \#              # '#', beginning of anchor
48                         ([^\s\]]+)      # 3: anchor text
49                 )?                      # optional
50                 
51                 \]\]                    # end of link
52         }x,
53         wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
54         web_commit_regexp => qr/^web commit (by (.*?(?=: |$))|from (\d+\.\d+\.\d+\.\d+)):?(.*)/,
55         verbose => 0,
56         syslog => 0,
57         wikiname => "wiki",
58         default_pageext => "mdwn",
59         htmlext => "html",
60         cgi => 0,
61         post_commit => 0,
62         rcs => '',
63         notify => 0,
64         url => '',
65         cgiurl => '',
66         historyurl => '',
67         diffurl => '',
68         rss => 0,
69         atom => 0,
70         discussion => 1,
71         rebuild => 0,
72         refresh => 0,
73         getctime => 0,
74         w3mmode => 0,
75         wrapper => undef,
76         wrappermode => undef,
77         svnrepo => undef,
78         svnpath => "trunk",
79         gitorigin_branch => "origin",
80         gitmaster_branch => "master",
81         srcdir => undef,
82         destdir => undef,
83         pingurl => [],
84         templatedir => "$installdir/share/ikiwiki/templates",
85         underlaydir => "$installdir/share/ikiwiki/basewiki",
86         setup => undef,
87         adminuser => undef,
88         adminemail => undef,
89         plugin => [qw{mdwn inline htmlscrubber passwordauth openid signinedit
90                       lockedit conditional}],
91         libdir => undef,
92         timeformat => '%c',
93         locale => undef,
94         sslcookie => 0,
95         httpauth => 0,
96         userdir => "",
97         usedirs => 1,
98         numbacklinks => 10,
99         account_creation_password => "",
100 } #}}}
101
102 sub checkconfig () { #{{{
103         # locale stuff; avoid LC_ALL since it overrides everything
104         if (defined $ENV{LC_ALL}) {
105                 $ENV{LANG} = $ENV{LC_ALL};
106                 delete $ENV{LC_ALL};
107         }
108         if (defined $config{locale}) {
109                 if (POSIX::setlocale(&POSIX::LC_ALL, $config{locale})) {
110                         $ENV{LANG}=$config{locale};
111                         $gettext_obj=undef;
112                 }
113         }
114
115         if ($config{w3mmode}) {
116                 eval q{use Cwd q{abs_path}};
117                 error($@) if $@;
118                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
119                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
120                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
121                         unless $config{cgiurl} =~ m!file:///!;
122                 $config{url}="file://".$config{destdir};
123         }
124
125         if ($config{cgi} && ! length $config{url}) {
126                 error(gettext("Must specify url to wiki with --url when using --cgi"));
127         }
128         
129         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
130                 unless exists $config{wikistatedir};
131         
132         if ($config{rcs}) {
133                 eval qq{use IkiWiki::Rcs::$config{rcs}};
134                 if ($@) {
135                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
136                 }
137         }
138         else {
139                 require IkiWiki::Rcs::Stub;
140         }
141
142         run_hooks(checkconfig => sub { shift->() });
143
144         return 1;
145 } #}}}
146
147 sub loadplugins () { #{{{
148         if (defined $config{libdir}) {
149                 unshift @INC, possibly_foolish_untaint($config{libdir});
150         }
151
152         loadplugin($_) foreach @{$config{plugin}};
153
154         run_hooks(getopt => sub { shift->() });
155         if (grep /^-/, @ARGV) {
156                 print STDERR "Unknown option: $_\n"
157                         foreach grep /^-/, @ARGV;
158                 usage();
159         }
160
161         return 1;
162 } #}}}
163
164 sub loadplugin ($) { #{{{
165         my $plugin=shift;
166
167         return if grep { $_ eq $plugin} @{$config{disable_plugins}};
168
169         foreach my $dir (defined $config{libdir} ? possibly_foolish_untaint($config{libdir}) : undef,
170                          "$installdir/lib/ikiwiki") {
171                 if (defined $dir && -x "$dir/plugins/$plugin") {
172                         require IkiWiki::Plugin::external;
173                         import IkiWiki::Plugin::external "$dir/plugins/$plugin";
174                         return 1;
175                 }
176         }
177
178         my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
179         eval qq{use $mod};
180         if ($@) {
181                 error("Failed to load plugin $mod: $@");
182         }
183         return 1;
184 } #}}}
185
186 sub error ($;$) { #{{{
187         my $message=shift;
188         my $cleaner=shift;
189         if ($config{cgi}) {
190                 print "Content-type: text/html\n\n";
191                 print misctemplate(gettext("Error"),
192                         "<p>".gettext("Error").": $message</p>");
193         }
194         log_message('err' => $message) if $config{syslog};
195         if (defined $cleaner) {
196                 $cleaner->();
197         }
198         die $message."\n";
199 } #}}}
200
201 sub debug ($) { #{{{
202         return unless $config{verbose};
203         return log_message(debug => @_);
204 } #}}}
205
206 my $log_open=0;
207 sub log_message ($$) { #{{{
208         my $type=shift;
209
210         if ($config{syslog}) {
211                 require Sys::Syslog;
212                 if (! $log_open) {
213                         Sys::Syslog::setlogsock('unix');
214                         Sys::Syslog::openlog('ikiwiki', '', 'user');
215                         $log_open=1;
216                 }
217                 return eval {
218                         Sys::Syslog::syslog($type, "[$config{wikiname}] %s", join(" ", @_));
219                 };
220         }
221         elsif (! $config{cgi}) {
222                 return print "@_\n";
223         }
224         else {
225                 return print STDERR "@_\n";
226         }
227 } #}}}
228
229 sub possibly_foolish_untaint ($) { #{{{
230         my $tainted=shift;
231         my ($untainted)=$tainted=~/(.*)/s;
232         return $untainted;
233 } #}}}
234
235 sub basename ($) { #{{{
236         my $file=shift;
237
238         $file=~s!.*/+!!;
239         return $file;
240 } #}}}
241
242 sub dirname ($) { #{{{
243         my $file=shift;
244
245         $file=~s!/*[^/]+$!!;
246         return $file;
247 } #}}}
248
249 sub pagetype ($) { #{{{
250         my $page=shift;
251         
252         if ($page =~ /\.([^.]+)$/) {
253                 return $1 if exists $hooks{htmlize}{$1};
254         }
255         return;
256 } #}}}
257
258 sub pagename ($) { #{{{
259         my $file=shift;
260
261         my $type=pagetype($file);
262         my $page=$file;
263         $page=~s/\Q.$type\E*$// if defined $type;
264         return $page;
265 } #}}}
266
267 sub targetpage ($$) { #{{{
268         my $page=shift;
269         my $ext=shift;
270         
271         if (! $config{usedirs} || $page =~ /^index$/ ) {
272                 return $page.".".$ext;
273         } else {
274                 return $page."/index.".$ext;
275         }
276 } #}}}
277
278 sub htmlpage ($) { #{{{
279         my $page=shift;
280         
281         return targetpage($page, $config{htmlext});
282 } #}}}
283
284 sub srcfile ($) { #{{{
285         my $file=shift;
286
287         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
288         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
289         error("internal error: $file cannot be found in $config{srcdir} or $config{underlaydir}");
290         return;
291 } #}}}
292
293 sub readfile ($;$$) { #{{{
294         my $file=shift;
295         my $binary=shift;
296         my $wantfd=shift;
297
298         if (-l $file) {
299                 error("cannot read a symlink ($file)");
300         }
301         
302         local $/=undef;
303         open (my $in, "<", $file) || error("failed to read $file: $!");
304         binmode($in) if ($binary);
305         return \*$in if $wantfd;
306         my $ret=<$in>;
307         close $in || error("failed to read $file: $!");
308         return $ret;
309 } #}}}
310
311 sub writefile ($$$;$$) { #{{{
312         my $file=shift; # can include subdirs
313         my $destdir=shift; # directory to put file in
314         my $content=shift;
315         my $binary=shift;
316         my $writer=shift;
317         
318         my $test=$file;
319         while (length $test) {
320                 if (-l "$destdir/$test") {
321                         error("cannot write to a symlink ($test)");
322                 }
323                 $test=dirname($test);
324         }
325         my $newfile="$destdir/$file.ikiwiki-new";
326         if (-l $newfile) {
327                 error("cannot write to a symlink ($newfile)");
328         }
329
330         my $dir=dirname($newfile);
331         if (! -d $dir) {
332                 my $d="";
333                 foreach my $s (split(m!/+!, $dir)) {
334                         $d.="$s/";
335                         if (! -d $d) {
336                                 mkdir($d) || error("failed to create directory $d: $!");
337                         }
338                 }
339         }
340
341         my $cleanup = sub { unlink($newfile) };
342         open (my $out, '>', $newfile) || error("failed to write $newfile: $!", $cleanup);
343         binmode($out) if ($binary);
344         if ($writer) {
345                 $writer->(\*$out, $cleanup);
346         }
347         else {
348                 print $out $content or error("failed writing to $newfile: $!", $cleanup);
349         }
350         close $out || error("failed saving $newfile: $!", $cleanup);
351         rename($newfile, "$destdir/$file") || 
352                 error("failed renaming $newfile to $destdir/$file: $!", $cleanup);
353
354         return 1;
355 } #}}}
356
357 my %cleared;
358 sub will_render ($$;$) { #{{{
359         my $page=shift;
360         my $dest=shift;
361         my $clear=shift;
362
363         # Important security check.
364         if (-e "$config{destdir}/$dest" && ! $config{rebuild} &&
365             ! grep { $_ eq $dest } (@{$renderedfiles{$page}}, @{$oldrenderedfiles{$page}})) {
366                 error("$config{destdir}/$dest independently created, not overwriting with version from $page");
367         }
368
369         if (! $clear || $cleared{$page}) {
370                 $renderedfiles{$page}=[$dest, grep { $_ ne $dest } @{$renderedfiles{$page}}];
371         }
372         else {
373                 foreach my $old (@{$renderedfiles{$page}}) {
374                         delete $destsources{$old};
375                 }
376                 $renderedfiles{$page}=[$dest];
377                 $cleared{$page}=1;
378         }
379         $destsources{$dest}=$page;
380
381         return 1;
382 } #}}}
383
384 sub bestlink ($$) { #{{{
385         my $page=shift;
386         my $link=shift;
387         
388         my $cwd=$page;
389         if ($link=~s/^\/+//) {
390                 # absolute links
391                 $cwd="";
392         }
393
394         do {
395                 my $l=$cwd;
396                 $l.="/" if length $l;
397                 $l.=$link;
398
399                 if (exists $links{$l}) {
400                         return $l;
401                 }
402                 elsif (exists $pagecase{lc $l}) {
403                         return $pagecase{lc $l};
404                 }
405         } while $cwd=~s!/?[^/]+$!!;
406
407         if (length $config{userdir}) {
408                 my $l = "$config{userdir}/".lc($link);
409                 if (exists $links{$l}) {
410                         return $l;
411                 }
412                 elsif (exists $pagecase{lc $l}) {
413                         return $pagecase{lc $l};
414                 }
415         }
416
417         #print STDERR "warning: page $page, broken link: $link\n";
418         return "";
419 } #}}}
420
421 sub isinlinableimage ($) { #{{{
422         my $file=shift;
423         
424         return $file =~ /\.(png|gif|jpg|jpeg)$/i;
425 } #}}}
426
427 sub pagetitle ($;$) { #{{{
428         my $page=shift;
429         my $unescaped=shift;
430
431         if ($unescaped) {
432                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : chr($2)/eg;
433         }
434         else {
435                 $page=~s/(__(\d+)__|_)/$1 eq '_' ? ' ' : "&#$2;"/eg;
436         }
437
438         return $page;
439 } #}}}
440
441 sub titlepage ($) { #{{{
442         my $title=shift;
443         $title=~s/([^-[:alnum:]:+\/.])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
444         return $title;
445 } #}}}
446
447 sub linkpage ($) { #{{{
448         my $link=shift;
449         $link=~s/([^-[:alnum:]:+\/._])/$1 eq ' ' ? '_' : "__".ord($1)."__"/eg;
450         return $link;
451 } #}}}
452
453 sub cgiurl (@) { #{{{
454         my %params=@_;
455
456         return $config{cgiurl}."?".
457                 join("&amp;", map $_."=".uri_escape_utf8($params{$_}), keys %params);
458 } #}}}
459
460 sub baseurl (;$) { #{{{
461         my $page=shift;
462
463         return "$config{url}/" if ! defined $page;
464         
465         $page=htmlpage($page);
466         $page=~s/[^\/]+$//;
467         $page=~s/[^\/]+\//..\//g;
468         return $page;
469 } #}}}
470
471 sub abs2rel ($$) { #{{{
472         # Work around very innefficient behavior in File::Spec if abs2rel
473         # is passed two relative paths. It's much faster if paths are
474         # absolute! (Debian bug #376658; fixed in debian unstable now)
475         my $path="/".shift;
476         my $base="/".shift;
477
478         require File::Spec;
479         my $ret=File::Spec->abs2rel($path, $base);
480         $ret=~s/^// if defined $ret;
481         return $ret;
482 } #}}}
483
484 sub displaytime ($) { #{{{
485         my $time=shift;
486
487         # strftime doesn't know about encodings, so make sure
488         # its output is properly treated as utf8
489         return decode_utf8(POSIX::strftime(
490                         $config{timeformat}, localtime($time)));
491 } #}}}
492
493 sub beautify_url ($) { #{{{
494         my $url=shift;
495
496         $url =~ s!/index.$config{htmlext}$!/!;
497         $url =~ s!^$!./!; # Browsers don't like empty links...
498
499         return $url;
500 } #}}}
501
502 sub urlto ($$) { #{{{
503         my $to=shift;
504         my $from=shift;
505
506         if (! length $to) {
507                 return beautify_url(baseurl($from));
508         }
509
510         if (! $destsources{$to}) {
511                 $to=htmlpage($to);
512         }
513
514         my $link = abs2rel($to, dirname(htmlpage($from)));
515
516         return beautify_url($link);
517 } #}}}
518
519 sub htmllink ($$$;@) { #{{{
520         my $lpage=shift; # the page doing the linking
521         my $page=shift; # the page that will contain the link (different for inline)
522         my $link=shift;
523         my %opts=@_;
524
525         my $bestlink;
526         if (! $opts{forcesubpage}) {
527                 $bestlink=bestlink($lpage, $link);
528         }
529         else {
530                 $bestlink="$lpage/".lc($link);
531         }
532
533         my $linktext;
534         if (defined $opts{linktext}) {
535                 $linktext=$opts{linktext};
536         }
537         else {
538                 $linktext=pagetitle(basename($link));
539         }
540         
541         return "<span class=\"selflink\">$linktext</span>"
542                 if length $bestlink && $page eq $bestlink;
543         
544         if (! $destsources{$bestlink}) {
545                 $bestlink=htmlpage($bestlink);
546
547                 if (! $destsources{$bestlink}) {
548                         return $linktext unless length $config{cgiurl};
549                         return "<span><a href=\"".
550                                 cgiurl(
551                                         do => "create",
552                                         page => pagetitle(lc($link), 1),
553                                         from => $lpage
554                                 ).
555                                 "\">?</a>$linktext</span>"
556                 }
557         }
558         
559         $bestlink=abs2rel($bestlink, dirname(htmlpage($page)));
560         $bestlink=beautify_url($bestlink);
561         
562         if (! $opts{noimageinline} && isinlinableimage($bestlink)) {
563                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
564         }
565
566         if (defined $opts{anchor}) {
567                 $bestlink.="#".$opts{anchor};
568         }
569
570         my @attrs;
571         if (defined $opts{rel}) {
572                 push @attrs, ' rel="'.$opts{rel}.'"';
573         }
574
575         return "<a href=\"$bestlink\"@attrs>$linktext</a>";
576 } #}}}
577
578 sub htmlize ($$$) { #{{{
579         my $page=shift;
580         my $type=shift;
581         my $content=shift;
582
583         if (exists $hooks{htmlize}{$type}) {
584                 $content=$hooks{htmlize}{$type}{call}->(
585                         page => $page,
586                         content => $content,
587                 );
588         }
589         else {
590                 error("htmlization of $type not supported");
591         }
592
593         run_hooks(sanitize => sub {
594                 $content=shift->(
595                         page => $page,
596                         content => $content,
597                 );
598         });
599
600         return $content;
601 } #}}}
602
603 sub linkify ($$$) { #{{{
604         my $lpage=shift; # the page containing the links
605         my $page=shift; # the page the link will end up on (different for inline)
606         my $content=shift;
607
608         $content =~ s{(\\?)$config{wiki_link_regexp}}{
609                 defined $2
610                         ? ( $1 
611                                 ? "[[$2|$3".($4 ? "#$4" : "")."]]" 
612                                 : htmllink($lpage, $page, linkpage($3),
613                                         anchor => $4, linktext => pagetitle($2)))
614                         : ( $1 
615                                 ? "[[$3".($4 ? "#$4" : "")."]]"
616                                 : htmllink($lpage, $page, linkpage($3),
617                                         anchor => $4))
618         }eg;
619         
620         return $content;
621 } #}}}
622
623 my %preprocessing;
624 our $preprocess_preview=0;
625 sub preprocess ($$$;$$) { #{{{
626         my $page=shift; # the page the data comes from
627         my $destpage=shift; # the page the data will appear in (different for inline)
628         my $content=shift;
629         my $scan=shift;
630         my $preview=shift;
631
632         # Using local because it needs to be set within any nested calls
633         # of this function.
634         local $preprocess_preview=$preview if defined $preview;
635
636         my $handle=sub {
637                 my $escape=shift;
638                 my $command=shift;
639                 my $params=shift;
640                 if (length $escape) {
641                         return "[[$command $params]]";
642                 }
643                 elsif (exists $hooks{preprocess}{$command}) {
644                         return "" if $scan && ! $hooks{preprocess}{$command}{scan};
645                         # Note: preserve order of params, some plugins may
646                         # consider it significant.
647                         my @params;
648                         while ($params =~ m{
649                                 (?:(\w+)=)?             # 1: named parameter key?
650                                 (?:
651                                         """(.*?)"""     # 2: triple-quoted value
652                                 |
653                                         "([^"]+)"       # 3: single-quoted value
654                                 |
655                                         (\S+)           # 4: unquoted value
656                                 )
657                                 (?:\s+|$)               # delimiter to next param
658                         }sgx) {
659                                 my $key=$1;
660                                 my $val;
661                                 if (defined $2) {
662                                         $val=$2;
663                                         $val=~s/\r\n/\n/mg;
664                                         $val=~s/^\n+//g;
665                                         $val=~s/\n+$//g;
666                                 }
667                                 elsif (defined $3) {
668                                         $val=$3;
669                                 }
670                                 elsif (defined $4) {
671                                         $val=$4;
672                                 }
673
674                                 if (defined $key) {
675                                         push @params, $key, $val;
676                                 }
677                                 else {
678                                         push @params, $val, '';
679                                 }
680                         }
681                         if ($preprocessing{$page}++ > 3) {
682                                 # Avoid loops of preprocessed pages preprocessing
683                                 # other pages that preprocess them, etc.
684                                 #translators: The first parameter is a
685                                 #translators: preprocessor directive name,
686                                 #translators: the second a page name, the
687                                 #translators: third a number.
688                                 return "[[".sprintf(gettext("%s preprocessing loop detected on %s at depth %i"),
689                                         $command, $page, $preprocessing{$page}).
690                                 "]]";
691                         }
692                         my $ret=$hooks{preprocess}{$command}{call}->(
693                                 @params,
694                                 page => $page,
695                                 destpage => $destpage,
696                                 preview => $preprocess_preview,
697                         );
698                         $preprocessing{$page}--;
699                         return $ret;
700                 }
701                 else {
702                         return "[[$command $params]]";
703                 }
704         };
705         
706         $content =~ s{
707                 (\\?)           # 1: escape?
708                 \[\[            # directive open
709                 (\w+)           # 2: command
710                 \s+
711                 (               # 3: the parameters..
712                         (?:
713                                 (?:\w+=)?               # named parameter key?
714                                 (?:
715                                         """.*?"""       # triple-quoted value
716                                         |
717                                         "[^"]+"         # single-quoted value
718                                         |
719                                         [^\s\]]+        # unquoted value
720                                 )
721                                 \s*                     # whitespace or end
722                                                         # of directive
723                         )
724                 *)              # 0 or more parameters
725                 \]\]            # directive closed
726         }{$handle->($1, $2, $3)}sexg;
727         return $content;
728 } #}}}
729
730 sub filter ($$$) { #{{{
731         my $page=shift;
732         my $destpage=shift;
733         my $content=shift;
734
735         run_hooks(filter => sub {
736                 $content=shift->(page => $page, destpage => $destpage, 
737                         content => $content);
738         });
739
740         return $content;
741 } #}}}
742
743 sub indexlink () { #{{{
744         return "<a href=\"$config{url}\">$config{wikiname}</a>";
745 } #}}}
746
747 my $wikilock;
748
749 sub lockwiki (;$) { #{{{
750         my $wait=@_ ? shift : 1;
751         # Take an exclusive lock on the wiki to prevent multiple concurrent
752         # run issues. The lock will be dropped on program exit.
753         if (! -d $config{wikistatedir}) {
754                 mkdir($config{wikistatedir});
755         }
756         open($wikilock, '>', "$config{wikistatedir}/lockfile") ||
757                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
758         if (! flock($wikilock, 2 | 4)) { # LOCK_EX | LOCK_NB
759                 if ($wait) {
760                         debug("wiki seems to be locked, waiting for lock");
761                         my $wait=600; # arbitrary, but don't hang forever to 
762                                       # prevent process pileup
763                         for (1..$wait) {
764                                 return if flock($wikilock, 2 | 4);
765                                 sleep 1;
766                         }
767                         error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
768                 }
769                 else {
770                         return 0;
771                 }
772         }
773         return 1;
774 } #}}}
775
776 sub unlockwiki () { #{{{
777         return close($wikilock);
778 } #}}}
779
780 my $commitlock;
781
782 sub commit_hook_enabled () { #{{{
783         open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
784                 error("cannot write to $config{wikistatedir}/commitlock: $!");
785         if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
786                 close($commitlock) || error("failed closing commitlock: $!");
787                 return 0;
788         }
789         close($commitlock) || error("failed closing commitlock: $!");
790         return 1;
791 } #}}}
792
793 sub disable_commit_hook () { #{{{
794         open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
795                 error("cannot write to $config{wikistatedir}/commitlock: $!");
796         if (! flock($commitlock, 2)) { # LOCK_EX
797                 error("failed to get commit lock");
798         }
799         return 1;
800 } #}}}
801
802 sub enable_commit_hook () { #{{{
803         return close($commitlock);
804 } #}}}
805
806 sub loadindex () { #{{{
807         open (my $in, "<", "$config{wikistatedir}/index") || return;
808         while (<$in>) {
809                 $_=possibly_foolish_untaint($_);
810                 chomp;
811                 my %items;
812                 $items{link}=[];
813                 $items{dest}=[];
814                 foreach my $i (split(/ /, $_)) {
815                         my ($item, $val)=split(/=/, $i, 2);
816                         push @{$items{$item}}, decode_entities($val);
817                 }
818
819                 next unless exists $items{src}; # skip bad lines for now
820
821                 my $page=pagename($items{src}[0]);
822                 if (! $config{rebuild}) {
823                         $pagesources{$page}=$items{src}[0];
824                         $pagemtime{$page}=$items{mtime}[0];
825                         $oldlinks{$page}=[@{$items{link}}];
826                         $links{$page}=[@{$items{link}}];
827                         $depends{$page}=$items{depends}[0] if exists $items{depends};
828                         $destsources{$_}=$page foreach @{$items{dest}};
829                         $renderedfiles{$page}=[@{$items{dest}}];
830                         $pagecase{lc $page}=$page;
831                 }
832                 $oldrenderedfiles{$page}=[@{$items{dest}}];
833                 $pagectime{$page}=$items{ctime}[0];
834         }
835         return close($in);
836 } #}}}
837
838 sub saveindex () { #{{{
839         run_hooks(savestate => sub { shift->() });
840
841         if (! -d $config{wikistatedir}) {
842                 mkdir($config{wikistatedir});
843         }
844         my $newfile="$config{wikistatedir}/index.new";
845         my $cleanup = sub { unlink($newfile) };
846         open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
847         foreach my $page (keys %pagemtime) {
848                 next unless $pagemtime{$page};
849                 my $line="mtime=$pagemtime{$page} ".
850                         "ctime=$pagectime{$page} ".
851                         "src=$pagesources{$page}";
852                 $line.=" dest=$_" foreach @{$renderedfiles{$page}};
853                 my %count;
854                 $line.=" link=$_" foreach grep { ++$count{$_} == 1 } @{$links{$page}};
855                 if (exists $depends{$page}) {
856                         $line.=" depends=".encode_entities($depends{$page}, " \t\n");
857                 }
858                 print $out $line."\n" || error("failed writing to $newfile: $!", $cleanup);
859         }
860         close $out || error("failed saving to $newfile: $!", $cleanup);
861         rename($newfile, "$config{wikistatedir}/index") ||
862                 error("failed renaming $newfile to $config{wikistatedir}/index", $cleanup);
863         
864         return 1;
865 } #}}}
866
867 sub template_file ($) { #{{{
868         my $template=shift;
869
870         foreach my $dir ($config{templatedir}, "$installdir/share/ikiwiki/templates") {
871                 return "$dir/$template" if -e "$dir/$template";
872         }
873         return;
874 } #}}}
875
876 sub template_params (@) { #{{{
877         my $filename=template_file(shift);
878
879         if (! defined $filename) {
880                 return if wantarray;
881                 return "";
882         }
883
884         my @ret=(
885                 filter => sub {
886                         my $text_ref = shift;
887                         ${$text_ref} = Encode::decode_utf8(${$text_ref});
888                 },
889                 filename => $filename,
890                 loop_context_vars => 1,
891                 die_on_bad_params => 0,
892                 @_
893         );
894         return wantarray ? @ret : {@ret};
895 } #}}}
896
897 sub template ($;@) { #{{{
898         require HTML::Template;
899         return HTML::Template->new(template_params(@_));
900 } #}}}
901
902 sub misctemplate ($$;@) { #{{{
903         my $title=shift;
904         my $pagebody=shift;
905         
906         my $template=template("misc.tmpl");
907         $template->param(
908                 title => $title,
909                 indexlink => indexlink(),
910                 wikiname => $config{wikiname},
911                 pagebody => $pagebody,
912                 baseurl => baseurl(),
913                 @_,
914         );
915         run_hooks(pagetemplate => sub {
916                 shift->(page => "", destpage => "", template => $template);
917         });
918         return $template->output;
919 }#}}}
920
921 sub hook (@) { # {{{
922         my %param=@_;
923         
924         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
925                 error 'hook requires type, call, and id parameters';
926         }
927
928         return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
929         
930         $hooks{$param{type}}{$param{id}}=\%param;
931         return 1;
932 } # }}}
933
934 sub run_hooks ($$) { # {{{
935         # Calls the given sub for each hook of the given type,
936         # passing it the hook function to call.
937         my $type=shift;
938         my $sub=shift;
939
940         if (exists $hooks{$type}) {
941                 my @deferred;
942                 foreach my $id (keys %{$hooks{$type}}) {
943                         if ($hooks{$type}{$id}{last}) {
944                                 push @deferred, $id;
945                                 next;
946                         }
947                         $sub->($hooks{$type}{$id}{call});
948                 }
949                 foreach my $id (@deferred) {
950                         $sub->($hooks{$type}{$id}{call});
951                 }
952         }
953
954         return 1;
955 } #}}}
956
957 sub globlist_to_pagespec ($) { #{{{
958         my @globlist=split(' ', shift);
959
960         my (@spec, @skip);
961         foreach my $glob (@globlist) {
962                 if ($glob=~/^!(.*)/) {
963                         push @skip, $glob;
964                 }
965                 else {
966                         push @spec, $glob;
967                 }
968         }
969
970         my $spec=join(' or ', @spec);
971         if (@skip) {
972                 my $skip=join(' and ', @skip);
973                 if (length $spec) {
974                         $spec="$skip and ($spec)";
975                 }
976                 else {
977                         $spec=$skip;
978                 }
979         }
980         return $spec;
981 } #}}}
982
983 sub is_globlist ($) { #{{{
984         my $s=shift;
985         return ( $s =~ /[^\s]+\s+([^\s]+)/ && $1 ne "and" && $1 ne "or" );
986 } #}}}
987
988 sub safequote ($) { #{{{
989         my $s=shift;
990         $s=~s/[{}]//g;
991         return "q{$s}";
992 } #}}}
993
994 sub add_depends ($$) { #{{{
995         my $page=shift;
996         my $pagespec=shift;
997         
998         if (! exists $depends{$page}) {
999                 $depends{$page}=$pagespec;
1000         }
1001         else {
1002                 $depends{$page}=pagespec_merge($depends{$page}, $pagespec);
1003         }
1004
1005         return 1;
1006 } # }}}
1007
1008 sub file_pruned ($$) { #{{{
1009         require File::Spec;
1010         my $file=File::Spec->canonpath(shift);
1011         my $base=File::Spec->canonpath(shift);
1012         $file =~ s#^\Q$base\E/*##;
1013
1014         my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
1015         return $file =~ m/$regexp/;
1016 } #}}}
1017
1018 sub gettext { #{{{
1019         # Only use gettext in the rare cases it's needed.
1020         if (exists $ENV{LANG} || exists $ENV{LC_ALL} || exists $ENV{LC_MESSAGES}) {
1021                 if (! $gettext_obj) {
1022                         $gettext_obj=eval q{
1023                                 use Locale::gettext q{textdomain};
1024                                 Locale::gettext->domain('ikiwiki')
1025                         };
1026                         if ($@) {
1027                                 print STDERR "$@";
1028                                 $gettext_obj=undef;
1029                                 return shift;
1030                         }
1031                 }
1032                 return $gettext_obj->get(shift);
1033         }
1034         else {
1035                 return shift;
1036         }
1037 } #}}}
1038
1039 sub pagespec_merge ($$) { #{{{
1040         my $a=shift;
1041         my $b=shift;
1042
1043         return $a if $a eq $b;
1044
1045         # Support for old-style GlobLists.
1046         if (is_globlist($a)) {
1047                 $a=globlist_to_pagespec($a);
1048         }
1049         if (is_globlist($b)) {
1050                 $b=globlist_to_pagespec($b);
1051         }
1052
1053         return "($a) or ($b)";
1054 } #}}}
1055
1056 sub pagespec_translate ($) { #{{{
1057         # This assumes that $page is in scope in the function
1058         # that evalulates the translated pagespec code.
1059         my $spec=shift;
1060
1061         # Support for old-style GlobLists.
1062         if (is_globlist($spec)) {
1063                 $spec=globlist_to_pagespec($spec);
1064         }
1065
1066         # Convert spec to perl code.
1067         my $code="";
1068         while ($spec=~m{
1069                 \s*             # ignore whitespace
1070                 (               # 1: match a single word
1071                         \!              # !
1072                 |
1073                         \(              # (
1074                 |
1075                         \)              # )
1076                 |
1077                         \w+\([^\)]*\)   # command(params)
1078                 |
1079                         [^\s()]+        # any other text
1080                 )
1081                 \s*             # ignore whitespace
1082         }igx) {
1083                 my $word=$1;
1084                 if (lc $word eq 'and') {
1085                         $code.=' &&';
1086                 }
1087                 elsif (lc $word eq 'or') {
1088                         $code.=' ||';
1089                 }
1090                 elsif ($word eq "(" || $word eq ")" || $word eq "!") {
1091                         $code.=' '.$word;
1092                 }
1093                 elsif ($word =~ /^(\w+)\((.*)\)$/) {
1094                         if (exists $IkiWiki::PageSpec::{"match_$1"}) {
1095                                 $code.="IkiWiki::PageSpec::match_$1(\$page, ".safequote($2).", \@params)";
1096                         }
1097                         else {
1098                                 $code.=' 0';
1099                         }
1100                 }
1101                 else {
1102                         $code.=" IkiWiki::PageSpec::match_glob(\$page, ".safequote($word).", \@params)";
1103                 }
1104         }
1105
1106         return $code;
1107 } #}}}
1108
1109 sub pagespec_match ($$;@) { #{{{
1110         my $page=shift;
1111         my $spec=shift;
1112         my @params=@_;
1113
1114         # Backwards compatability with old calling convention.
1115         if (@params == 1) {
1116                 unshift @params, 'location';
1117         }
1118
1119         my $ret=eval pagespec_translate($spec);
1120         return IkiWiki::FailReason->new('syntax error') if $@;
1121         return $ret;
1122 } #}}}
1123
1124 package IkiWiki::FailReason;
1125
1126 use overload ( #{{{
1127         '""'    => sub { ${$_[0]} },
1128         '0+'    => sub { 0 },
1129         '!'     => sub { bless $_[0], 'IkiWiki::SuccessReason'},
1130         fallback => 1,
1131 ); #}}}
1132
1133 sub new { #{{{
1134         return bless \$_[1], $_[0];
1135 } #}}}
1136
1137 package IkiWiki::SuccessReason;
1138
1139 use overload ( #{{{
1140         '""'    => sub { ${$_[0]} },
1141         '0+'    => sub { 1 },
1142         '!'     => sub { bless $_[0], 'IkiWiki::FailReason'},
1143         fallback => 1,
1144 ); #}}}
1145
1146 sub new { #{{{
1147         return bless \$_[1], $_[0];
1148 }; #}}}
1149
1150 package IkiWiki::PageSpec;
1151
1152 sub match_glob ($$;@) { #{{{
1153         my $page=shift;
1154         my $glob=shift;
1155         my %params=@_;
1156         
1157         my $from=exists $params{location} ? $params{location} : '';
1158         
1159         # relative matching
1160         if ($glob =~ m!^\./!) {
1161                 $from=~s#/?[^/]+$##;
1162                 $glob=~s#^\./##;
1163                 $glob="$from/$glob" if length $from;
1164         }
1165
1166         # turn glob into safe regexp
1167         $glob=quotemeta($glob);
1168         $glob=~s/\\\*/.*/g;
1169         $glob=~s/\\\?/./g;
1170
1171         if ($page=~/^$glob$/i) {
1172                 return IkiWiki::SuccessReason->new("$glob matches $page");
1173         }
1174         else {
1175                 return IkiWiki::FailReason->new("$glob does not match $page");
1176         }
1177 } #}}}
1178
1179 sub match_link ($$;@) { #{{{
1180         my $page=shift;
1181         my $link=lc(shift);
1182         my %params=@_;
1183
1184         my $from=exists $params{location} ? $params{location} : '';
1185
1186         # relative matching
1187         if ($link =~ m!^\.! && defined $from) {
1188                 $from=~s#/?[^/]+$##;
1189                 $link=~s#^\./##;
1190                 $link="$from/$link" if length $from;
1191         }
1192
1193         my $links = $IkiWiki::links{$page};
1194         return IkiWiki::FailReason->new("$page has no links") unless $links && @{$links};
1195         my $bestlink = IkiWiki::bestlink($from, $link);
1196         foreach my $p (@{$links}) {
1197                 if (length $bestlink) {
1198                         return IkiWiki::SuccessReason->new("$page links to $link")
1199                                 if $bestlink eq IkiWiki::bestlink($page, $p);
1200                 }
1201                 else {
1202                         return IkiWiki::SuccessReason->new("$page links to page matching $link")
1203                                 if match_glob($p, $link, %params);
1204                 }
1205         }
1206         return IkiWiki::FailReason->new("$page does not link to $link");
1207 } #}}}
1208
1209 sub match_backlink ($$;@) { #{{{
1210         return match_link($_[1], $_[0], @_);
1211 } #}}}
1212
1213 sub match_created_before ($$;@) { #{{{
1214         my $page=shift;
1215         my $testpage=shift;
1216
1217         if (exists $IkiWiki::pagectime{$testpage}) {
1218                 if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
1219                         return IkiWiki::SuccessReason->new("$page created before $testpage");
1220                 }
1221                 else {
1222                         return IkiWiki::FailReason->new("$page not created before $testpage");
1223                 }
1224         }
1225         else {
1226                 return IkiWiki::FailReason->new("$testpage has no ctime");
1227         }
1228 } #}}}
1229
1230 sub match_created_after ($$;@) { #{{{
1231         my $page=shift;
1232         my $testpage=shift;
1233
1234         if (exists $IkiWiki::pagectime{$testpage}) {
1235                 if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
1236                         return IkiWiki::SuccessReason->new("$page created after $testpage");
1237                 }
1238                 else {
1239                         return IkiWiki::FailReason->new("$page not created after $testpage");
1240                 }
1241         }
1242         else {
1243                 return IkiWiki::FailReason->new("$testpage has no ctime");
1244         }
1245 } #}}}
1246
1247 sub match_creation_day ($$;@) { #{{{
1248         if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
1249                 return IkiWiki::SuccessReason->new('creation_day matched');
1250         }
1251         else {
1252                 return IkiWiki::FailReason->new('creation_day did not match');
1253         }
1254 } #}}}
1255
1256 sub match_creation_month ($$;@) { #{{{
1257         if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
1258                 return IkiWiki::SuccessReason->new('creation_month matched');
1259         }
1260         else {
1261                 return IkiWiki::FailReason->new('creation_month did not match');
1262         }
1263 } #}}}
1264
1265 sub match_creation_year ($$;@) { #{{{
1266         if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
1267                 return IkiWiki::SuccessReason->new('creation_year matched');
1268         }
1269         else {
1270                 return IkiWiki::FailReason->new('creation_year did not match');
1271         }
1272 } #}}}
1273
1274 sub match_user ($$;@) { #{{{
1275         shift;
1276         my $user=shift;
1277         my %params=@_;
1278
1279         return IkiWiki::FailReason->new('cannot match user')
1280                 unless exists $params{user};
1281         if ($user eq $params{user}) {
1282                 return IkiWiki::SuccessReason->new("user is $user")
1283         }
1284         else {
1285                 return IkiWiki::FailReason->new("user is not $user");
1286         }
1287 } #}}}
1288
1289 1