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