c0b26e43fb33e77da03b36081effc1090de854bf
[ikiwiki.git] / IkiWiki.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4 use warnings;
5 use strict;
6 use Encode;
7 use open qw{:utf8 :std};
8
9 # Optimisation.
10 use Memoize;
11 memoize("abs2rel");
12
13 use vars qw{%config %links %oldlinks %oldpagemtime %pagectime
14             %renderedfiles %pagesources %depends %hooks};
15
16 sub defaultconfig () { #{{{
17         wiki_file_prune_regexp => qr{((^|/).svn/|\.\.|^\.|\/\.|\.html?$|\.rss$)},
18         wiki_link_regexp => qr/\[\[(?:([^\]\|]+)\|)?([^\s\]]+)\]\]/,
19         wiki_processor_regexp => qr/\[\[(\w+)\s+([^\]]*)\]\]/,
20         wiki_file_regexp => qr/(^[-[:alnum:]_.:\/+]+$)/,
21         verbose => 0,
22         wikiname => "wiki",
23         default_pageext => "mdwn",
24         cgi => 0,
25         rcs => 'svn',
26         notify => 0,
27         url => '',
28         cgiurl => '',
29         historyurl => '',
30         diffurl => '',
31         anonok => 0,
32         rss => 0,
33         discussion => 1,
34         rebuild => 0,
35         refresh => 0,
36         getctime => 0,
37         w3mmode => 0,
38         wrapper => undef,
39         wrappermode => undef,
40         svnrepo => undef,
41         svnpath => "trunk",
42         srcdir => undef,
43         destdir => undef,
44         pingurl => [],
45         templatedir => "/usr/share/ikiwiki/templates",
46         underlaydir => "/usr/share/ikiwiki/basewiki",
47         setup => undef,
48         adminuser => undef,
49         adminemail => undef,
50         plugin => [qw{mdwn inline htmlscrubber}],
51         timeformat => '%c',
52         locale => undef,
53 } #}}}
54    
55 sub checkconfig () { #{{{
56         # locale stuff; avoid LC_ALL since it overrides everything
57         if (defined $ENV{LC_ALL}) {
58                 $ENV{LANG} = $ENV{LC_ALL};
59                 delete $ENV{LC_ALL};
60         }
61         if (defined $config{locale}) {
62                 eval q{use POSIX};
63                 $ENV{LANG} = $config{locale}
64                         if POSIX::setlocale(&POSIX::LC_TIME, $config{locale});
65         }
66
67         if ($config{w3mmode}) {
68                 eval q{use Cwd q{abs_path}};
69                 $config{srcdir}=possibly_foolish_untaint(abs_path($config{srcdir}));
70                 $config{destdir}=possibly_foolish_untaint(abs_path($config{destdir}));
71                 $config{cgiurl}="file:///\$LIB/ikiwiki-w3m.cgi/".$config{cgiurl}
72                         unless $config{cgiurl} =~ m!file:///!;
73                 $config{url}="file://".$config{destdir};
74         }
75
76         if ($config{cgi} && ! length $config{url}) {
77                 error("Must specify url to wiki with --url when using --cgi\n");
78         }
79         if ($config{rss} && ! length $config{url}) {
80                 error("Must specify url to wiki with --url when using --rss\n");
81         }
82         
83         $config{wikistatedir}="$config{srcdir}/.ikiwiki"
84                 unless exists $config{wikistatedir};
85         
86         if ($config{rcs}) {
87                 eval qq{require IkiWiki::Rcs::$config{rcs}};
88                 if ($@) {
89                         error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
90                 }
91         }
92         else {
93                 require IkiWiki::Rcs::Stub;
94         }
95
96         run_hooks(checkconfig => sub { shift->() });
97 } #}}}
98
99 sub loadplugins () { #{{{
100         foreach my $plugin (@{$config{plugin}}) {
101                 my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
102                 eval qq{use $mod};
103                 if ($@) {
104                         error("Failed to load plugin $mod: $@");
105                 }
106         }
107 } #}}}
108
109 sub error ($) { #{{{
110         if ($config{cgi}) {
111                 print "Content-type: text/html\n\n";
112                 print misctemplate("Error", "<p>Error: @_</p>");
113         }
114         die @_;
115 } #}}}
116
117 sub debug ($) { #{{{
118         return unless $config{verbose};
119         if (! $config{cgi}) {
120                 print "@_\n";
121         }
122         else {
123                 print STDERR "@_\n";
124         }
125 } #}}}
126
127 sub possibly_foolish_untaint ($) { #{{{
128         my $tainted=shift;
129         my ($untainted)=$tainted=~/(.*)/;
130         return $untainted;
131 } #}}}
132
133 sub basename ($) { #{{{
134         my $file=shift;
135
136         $file=~s!.*/+!!;
137         return $file;
138 } #}}}
139
140 sub dirname ($) { #{{{
141         my $file=shift;
142
143         $file=~s!/*[^/]+$!!;
144         return $file;
145 } #}}}
146
147 sub pagetype ($) { #{{{
148         my $page=shift;
149         
150         if ($page =~ /\.([^.]+)$/) {
151                 return $1 if exists $hooks{htmlize}{$1};
152         }
153         return undef;
154 } #}}}
155
156 sub pagename ($) { #{{{
157         my $file=shift;
158
159         my $type=pagetype($file);
160         my $page=$file;
161         $page=~s/\Q.$type\E*$// if defined $type;
162         return $page;
163 } #}}}
164
165 sub htmlpage ($) { #{{{
166         my $page=shift;
167
168         return $page.".html";
169 } #}}}
170
171 sub srcfile ($) { #{{{
172         my $file=shift;
173
174         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
175         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
176         error("internal error: $file cannot be found");
177 } #}}}
178
179 sub readfile ($;$) { #{{{
180         my $file=shift;
181         my $binary=shift;
182
183         if (-l $file) {
184                 error("cannot read a symlink ($file)");
185         }
186         
187         local $/=undef;
188         open (IN, $file) || error("failed to read $file: $!");
189         binmode(IN) if ($binary);
190         my $ret=<IN>;
191         close IN;
192         return $ret;
193 } #}}}
194
195 sub writefile ($$$;$) { #{{{
196         my $file=shift; # can include subdirs
197         my $destdir=shift; # directory to put file in
198         my $content=shift;
199         my $binary=shift;
200         
201         my $test=$file;
202         while (length $test) {
203                 if (-l "$destdir/$test") {
204                         error("cannot write to a symlink ($test)");
205                 }
206                 $test=dirname($test);
207         }
208
209         my $dir=dirname("$destdir/$file");
210         if (! -d $dir) {
211                 my $d="";
212                 foreach my $s (split(m!/+!, $dir)) {
213                         $d.="$s/";
214                         if (! -d $d) {
215                                 mkdir($d) || error("failed to create directory $d: $!");
216                         }
217                 }
218         }
219         
220         open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
221         binmode(OUT) if ($binary);
222         print OUT $content;
223         close OUT;
224 } #}}}
225
226 sub bestlink ($$) { #{{{
227         # Given a page and the text of a link on the page, determine which
228         # existing page that link best points to. Prefers pages under a
229         # subdirectory with the same name as the source page, failing that
230         # goes down the directory tree to the base looking for matching
231         # pages.
232         my $page=shift;
233         my $link=lc(shift);
234         
235         my $cwd=$page;
236         do {
237                 my $l=$cwd;
238                 $l.="/" if length $l;
239                 $l.=$link;
240
241                 if (exists $links{$l}) {
242                         #debug("for $page, \"$link\", use $l");
243                         return $l;
244                 }
245         } while $cwd=~s!/?[^/]+$!!;
246
247         #print STDERR "warning: page $page, broken link: $link\n";
248         return "";
249 } #}}}
250
251 sub isinlinableimage ($) { #{{{
252         my $file=shift;
253         
254         $file=~/\.(png|gif|jpg|jpeg)$/i;
255 } #}}}
256
257 sub pagetitle ($) { #{{{
258         my $page=shift;
259         $page=~s/__(\d+)__/&#$1;/g;
260         $page=~y/_/ /;
261         return $page;
262 } #}}}
263
264 sub titlepage ($) { #{{{
265         my $title=shift;
266         $title=~y/ /_/;
267         $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
268         return $title;
269 } #}}}
270
271 sub cgiurl (@) { #{{{
272         my %params=@_;
273
274         return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
275 } #}}}
276
277 sub styleurl (;$) { #{{{
278         my $page=shift;
279
280         return "$config{url}/style.css" if ! defined $page;
281         
282         $page=~s/[^\/]+$//;
283         $page=~s/[^\/]+\//..\//g;
284         return $page."style.css";
285 } #}}}
286
287 sub abs2rel ($$) {
288         # Work around very innefficient behavior in File::Spec if abs2rel
289         # is passed two relative paths. It's much faster if paths are
290         # absolute!
291         my $path="/".shift;
292         my $base="/".shift;
293
294         require File::Spec;
295         my $ret=File::Spec->abs2rel($path, $base);
296         $ret=~s/^// if defined $ret;
297         return $ret;
298 }
299
300 sub htmllink ($$$;$$$) { #{{{
301         my $lpage=shift; # the page doing the linking
302         my $page=shift; # the page that will contain the link (different for inline)
303         my $link=shift;
304         my $noimageinline=shift; # don't turn links into inline html images
305         my $forcesubpage=shift; # force a link to a subpage
306         my $linktext=shift; # set to force the link text to something
307
308         my $bestlink;
309         if (! $forcesubpage) {
310                 $bestlink=bestlink($lpage, $link);
311         }
312         else {
313                 $bestlink="$lpage/".lc($link);
314         }
315
316         $linktext=pagetitle(basename($link)) unless defined $linktext;
317         
318         return $linktext if length $bestlink && $page eq $bestlink;
319         
320         # TODO BUG: %renderedfiles may not have it, if the linked to page
321         # was also added and isn't yet rendered! Note that this bug is
322         # masked by the bug that makes all new files be rendered twice.
323         if (! grep { $_ eq $bestlink } values %renderedfiles) {
324                 $bestlink=htmlpage($bestlink);
325         }
326         if (! grep { $_ eq $bestlink } values %renderedfiles) {
327                 return "<span><a href=\"".
328                         cgiurl(do => "create", page => $link, from => $page).
329                         "\">?</a>$linktext</span>"
330         }
331         
332         $bestlink=abs2rel($bestlink, dirname($page));
333         
334         if (! $noimageinline && isinlinableimage($bestlink)) {
335                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
336         }
337         return "<a href=\"$bestlink\">$linktext</a>";
338 } #}}}
339
340 sub indexlink () { #{{{
341         return "<a href=\"$config{url}\">$config{wikiname}</a>";
342 } #}}}
343
344 sub lockwiki () { #{{{
345         # Take an exclusive lock on the wiki to prevent multiple concurrent
346         # run issues. The lock will be dropped on program exit.
347         if (! -d $config{wikistatedir}) {
348                 mkdir($config{wikistatedir});
349         }
350         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
351                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
352         if (! flock(WIKILOCK, 2 | 4)) {
353                 debug("wiki seems to be locked, waiting for lock");
354                 my $wait=600; # arbitrary, but don't hang forever to 
355                               # prevent process pileup
356                 for (1..600) {
357                         return if flock(WIKILOCK, 2 | 4);
358                         sleep 1;
359                 }
360                 error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
361         }
362 } #}}}
363
364 sub unlockwiki () { #{{{
365         close WIKILOCK;
366 } #}}}
367
368 sub loadindex () { #{{{
369         open (IN, "$config{wikistatedir}/index") || return;
370         while (<IN>) {
371                 $_=possibly_foolish_untaint($_);
372                 chomp;
373                 my %items;
374                 $items{link}=[];
375                 foreach my $i (split(/ /, $_)) {
376                         my ($item, $val)=split(/=/, $i, 2);
377                         push @{$items{$item}}, $val;
378                 }
379
380                 next unless exists $items{src}; # skip bad lines for now
381
382                 my $page=pagename($items{src}[0]);
383                 if (! $config{rebuild}) {
384                         $pagesources{$page}=$items{src}[0];
385                         $oldpagemtime{$page}=$items{mtime}[0];
386                         $oldlinks{$page}=[@{$items{link}}];
387                         $links{$page}=[@{$items{link}}];
388                         $depends{$page}=join(" ", @{$items{depends}})
389                                 if exists $items{depends};
390                         $renderedfiles{$page}=$items{dest}[0];
391                 }
392                 $pagectime{$page}=$items{ctime}[0];
393         }
394         close IN;
395 } #}}}
396
397 sub saveindex () { #{{{
398         run_hooks(savestate => sub { shift->() });
399
400         if (! -d $config{wikistatedir}) {
401                 mkdir($config{wikistatedir});
402         }
403         open (OUT, ">$config{wikistatedir}/index") || 
404                 error("cannot write to $config{wikistatedir}/index: $!");
405         foreach my $page (keys %oldpagemtime) {
406                 next unless $oldpagemtime{$page};
407                 my $line="mtime=$oldpagemtime{$page} ".
408                         "ctime=$pagectime{$page} ".
409                         "src=$pagesources{$page} ".
410                         "dest=$renderedfiles{$page}";
411                 $line.=" link=$_" foreach @{$links{$page}};
412                 if (exists $depends{$page}) {
413                         $line.=" depends=$_" foreach split " ", $depends{$page};
414                 }
415                 print OUT $line."\n";
416         }
417         close OUT;
418 } #}}}
419
420 sub template_params (@) { #{{{
421         my $filename=shift;
422         
423         require HTML::Template;
424         return filter => sub {
425                         my $text_ref = shift;
426                         $$text_ref=&Encode::decode_utf8($$text_ref);
427                 },
428                 filename => "$config{templatedir}/$filename", @_;
429 } #}}}
430
431 sub template ($;@) { #{{{
432         HTML::Template->new(template_params(@_));
433 } #}}}
434
435 sub misctemplate ($$) { #{{{
436         my $title=shift;
437         my $pagebody=shift;
438         
439         my $template=template("misc.tmpl");
440         $template->param(
441                 title => $title,
442                 indexlink => indexlink(),
443                 wikiname => $config{wikiname},
444                 pagebody => $pagebody,
445                 styleurl => styleurl(),
446                 baseurl => "$config{url}/",
447         );
448         return $template->output;
449 }#}}}
450
451 sub glob_match ($$) { #{{{
452         my $page=shift;
453         my $glob=shift;
454
455         if ($glob =~ /^link\((.+)\)$/) {
456                 my $rev = $links{$page} or return undef;
457                 foreach my $p (@$rev) {
458                         return 1 if lc $p eq $1;
459                 }
460                 return 0;
461         } elsif ($glob =~ /^backlink\((.+)\)$/) {
462                 my $rev = $links{$1} or return undef;
463                 foreach my $p (@$rev) {
464                         return 1 if lc $p eq $page;
465                 }
466                 return 0;
467         } else {
468                 # turn glob into safe regexp
469                 $glob=quotemeta($glob);
470                 $glob=~s/\\\*/.*/g;
471                 $glob=~s/\\\?/./g;
472                 $glob=~s!\\/!/!g;
473                 
474                 return $page=~/^$glob$/i;
475         }
476 } #}}}
477
478 sub globlist_match ($$) { #{{{
479         my $page=shift;
480         my @globlist=split(" ", shift);
481
482         # check any negated globs first
483         foreach my $glob (@globlist) {
484                 return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
485         }
486
487         foreach my $glob (@globlist) {
488                 return 1 if glob_match($page, $glob);
489         }
490         
491         return 0;
492 } #}}}
493
494 sub hook (@) { # {{{
495         my %param=@_;
496         
497         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
498                 error "hook requires type, call, and id parameters";
499         }
500         
501         $hooks{$param{type}}{$param{id}}=\%param;
502 } # }}}
503
504 sub run_hooks ($$) { # {{{
505         # Calls the given sub for each hook of the given type,
506         # passing it the hook function to call.
507         my $type=shift;
508         my $sub=shift;
509
510         if (exists $hooks{$type}) {
511                 foreach my $id (keys %{$hooks{$type}}) {
512                         $sub->($hooks{$type}{$id}{call});
513                 }
514         }
515 } #}}}
516
517 1