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 %forcerebuild};
  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         run_hooks(getopt => sub { shift->() });
 108         if (grep /^-/, @ARGV) {
 109                 print STDERR "Unknown option: $_\n"
 110                         foreach grep /^-/, @ARGV;
 111                 usage();
 112         }
 113 } #}}}
 114
 115 sub error ($) { #{{{
 116         if ($config{cgi}) {
 117                 print "Content-type: text/html\n\n";
 118                 print misctemplate("Error", "<p>Error: @_</p>");
 119         }
 120         die @_;
 121 } #}}}
 122
 123 sub debug ($) { #{{{
 124         return unless $config{verbose};
 125         if (! $config{cgi}) {
 126                 print "@_\n";
 127         }
 128         else {
 129                 print STDERR "@_\n";
 130         }
 131 } #}}}
 132
 133 sub possibly_foolish_untaint ($) { #{{{
 134         my $tainted=shift;
 135         my ($untainted)=$tainted=~/(.*)/;
 136         return $untainted;
 137 } #}}}
 138
 139 sub basename ($) { #{{{
 140         my $file=shift;
 141
 142         $file=~s!.*/+!!;
 143         return $file;
 144 } #}}}
 145
 146 sub dirname ($) { #{{{
 147         my $file=shift;
 148
 149         $file=~s!/*[^/]+$!!;
 150         return $file;
 151 } #}}}
 152
 153 sub pagetype ($) { #{{{
 154         my $page=shift;
 155
 156         if ($page =~ /\.([^.]+)$/) {
 157                 return $1 if exists $hooks{htmlize}{$1};
 158         }
 159         return undef;
 160 } #}}}
 161
 162 sub pagename ($) { #{{{
 163         my $file=shift;
 164
 165         my $type=pagetype($file);
 166         my $page=$file;
 167         $page=~s/\Q.$type\E*$// if defined $type;
 168         return $page;
 169 } #}}}
 170
 171 sub htmlpage ($) { #{{{
 172         my $page=shift;
 173
 174         return $page.".html";
 175 } #}}}
 176
 177 sub srcfile ($) { #{{{
 178         my $file=shift;
 179
 180         return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
 181         return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
 182         error("internal error: $file cannot be found");
 183 } #}}}
 184
 185 sub readfile ($;$) { #{{{
 186         my $file=shift;
 187         my $binary=shift;
 188
 189         if (-l $file) {
 190                 error("cannot read a symlink ($file)");
 191         }
 192
 193         local $/=undef;
 194         open (IN, $file) || error("failed to read $file: $!");
 195         binmode(IN) if ($binary);
 196         my $ret=<IN>;
 197         close IN;
 198         return $ret;
 199 } #}}}
 200
 201 sub writefile ($$$;$) { #{{{
 202         my $file=shift; # can include subdirs
 203         my $destdir=shift; # directory to put file in
 204         my $content=shift;
 205         my $binary=shift;
 206
 207         my $test=$file;
 208         while (length $test) {
 209                 if (-l "$destdir/$test") {
 210                         error("cannot write to a symlink ($test)");
 211                 }
 212                 $test=dirname($test);
 213         }
 214
 215         my $dir=dirname("$destdir/$file");
 216         if (! -d $dir) {
 217                 my $d="";
 218                 foreach my $s (split(m!/+!, $dir)) {
 219                         $d.="$s/";
 220                         if (! -d $d) {
 221                                 mkdir($d) || error("failed to create directory $d: $!");
 222                         }
 223                 }
 224         }
 225
 226         open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
 227         binmode(OUT) if ($binary);
 228         print OUT $content;
 229         close OUT;
 230 } #}}}
 231
 232 sub bestlink ($$) { #{{{
 233         # Given a page and the text of a link on the page, determine which
 234         # existing page that link best points to. Prefers pages under a
 235         # subdirectory with the same name as the source page, failing that
 236         # goes down the directory tree to the base looking for matching
 237         # pages.
 238         my $page=shift;
 239         my $link=lc(shift);
 240
 241         my $cwd=$page;
 242         do {
 243                 my $l=$cwd;
 244                 $l.="/" if length $l;
 245                 $l.=$link;
 246
 247                 if (exists $links{$l}) {
 248                         #debug("for $page, \"$link\", use $l");
 249                         return $l;
 250                 }
 251         } while $cwd=~s!/?[^/]+$!!;
 252
 253         #print STDERR "warning: page $page, broken link: $link\n";
 254         return "";
 255 } #}}}
 256
 257 sub isinlinableimage ($) { #{{{
 258         my $file=shift;
 259
 260         $file=~/\.(png|gif|jpg|jpeg)$/i;
 261 } #}}}
 262
 263 sub pagetitle ($) { #{{{
 264         my $page=shift;
 265         $page=~s/__(\d+)__/&#$1;/g;
 266         $page=~y/_/ /;
 267         return $page;
 268 } #}}}
 269
 270 sub titlepage ($) { #{{{
 271         my $title=shift;
 272         $title=~y/ /_/;
 273         $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
 274         return $title;
 275 } #}}}
 276
 277 sub cgiurl (@) { #{{{
 278         my %params=@_;
 279
 280         return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
 281 } #}}}
 282
 283 sub styleurl (;$) { #{{{
 284         my $page=shift;
 285
 286         return "$config{url}/style.css" if ! defined $page;
 287
 288         $page=~s/[^\/]+$//;
 289         $page=~s/[^\/]+\//..\//g;
 290         return $page."style.css";
 291 } #}}}
 292
 293 sub abs2rel ($$) {
 294         # Work around very innefficient behavior in File::Spec if abs2rel
 295         # is passed two relative paths. It's much faster if paths are
 296         # absolute!
 297         my $path="/".shift;
 298         my $base="/".shift;
 299
 300         require File::Spec;
 301         my $ret=File::Spec->abs2rel($path, $base);
 302         $ret=~s/^// if defined $ret;
 303         return $ret;
 304 }
 305
 306 sub htmllink ($$$;$$$) { #{{{
 307         my $lpage=shift; # the page doing the linking
 308         my $page=shift; # the page that will contain the link (different for inline)
 309         my $link=shift;
 310         my $noimageinline=shift; # don't turn links into inline html images
 311         my $forcesubpage=shift; # force a link to a subpage
 312         my $linktext=shift; # set to force the link text to something
 313
 314         my $bestlink;
 315         if (! $forcesubpage) {
 316                 $bestlink=bestlink($lpage, $link);
 317         }
 318         else {
 319                 $bestlink="$lpage/".lc($link);
 320         }
 321
 322         $linktext=pagetitle(basename($link)) unless defined $linktext;
 323
 324         return $linktext if length $bestlink && $page eq $bestlink;
 325
 326         # TODO BUG: %renderedfiles may not have it, if the linked to page
 327         # was also added and isn't yet rendered! Note that this bug is
 328         # masked by the bug that makes all new files be rendered twice.
 329         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 330                 $bestlink=htmlpage($bestlink);
 331         }
 332         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 333                 return "<span><a href=\"".
 334                         cgiurl(do => "create", page => $link, from => $page).
 335                         "\">?</a>$linktext</span>"
 336         }
 337
 338         $bestlink=abs2rel($bestlink, dirname($page));
 339
 340         if (! $noimageinline && isinlinableimage($bestlink)) {
 341                 return "<img src=\"$bestlink\" alt=\"$linktext\" />";
 342         }
 343         return "<a href=\"$bestlink\">$linktext</a>";
 344 } #}}}
 345
 346 sub indexlink () { #{{{
 347         return "<a href=\"$config{url}\">$config{wikiname}</a>";
 348 } #}}}
 349
 350 sub lockwiki () { #{{{
 351         # Take an exclusive lock on the wiki to prevent multiple concurrent
 352         # run issues. The lock will be dropped on program exit.
 353         if (! -d $config{wikistatedir}) {
 354                 mkdir($config{wikistatedir});
 355         }
 356         open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
 357                 error ("cannot write to $config{wikistatedir}/lockfile: $!");
 358         if (! flock(WIKILOCK, 2 | 4)) {
 359                 debug("wiki seems to be locked, waiting for lock");
 360                 my $wait=600; # arbitrary, but don't hang forever to
 361                               # prevent process pileup
 362                 for (1..600) {
 363                         return if flock(WIKILOCK, 2 | 4);
 364                         sleep 1;
 365                 }
 366                 error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
 367         }
 368 } #}}}
 369
 370 sub unlockwiki () { #{{{
 371         close WIKILOCK;
 372 } #}}}
 373
 374 sub loadindex () { #{{{
 375         open (IN, "$config{wikistatedir}/index") || return;
 376         while (<IN>) {
 377                 $_=possibly_foolish_untaint($_);
 378                 chomp;
 379                 my %items;
 380                 $items{link}=[];
 381                 foreach my $i (split(/ /, $_)) {
 382                         my ($item, $val)=split(/=/, $i, 2);
 383                         push @{$items{$item}}, $val;
 384                 }
 385
 386                 next unless exists $items{src}; # skip bad lines for now
 387
 388                 my $page=pagename($items{src}[0]);
 389                 if (! $config{rebuild}) {
 390                         $pagesources{$page}=$items{src}[0];
 391                         $oldpagemtime{$page}=$items{mtime}[0];
 392                         $oldlinks{$page}=[@{$items{link}}];
 393                         $links{$page}=[@{$items{link}}];
 394                         $depends{$page}=join(" ", @{$items{depends}})
 395                                 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=$_" foreach split " ", $depends{$page};
 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 glob_match ($$) { #{{{
 458         my $page=shift;
 459         my $glob=shift;
 460
 461         if ($glob =~ /^link\((.+)\)$/) {
 462                 my $rev = $links{$page} or return undef;
 463                 foreach my $p (@$rev) {
 464                         return 1 if lc $p eq $1;
 465                 }
 466                 return 0;
 467         } elsif ($glob =~ /^backlink\((.+)\)$/) {
 468                 my $rev = $links{$1} or return undef;
 469                 foreach my $p (@$rev) {
 470                         return 1 if lc $p eq $page;
 471                 }
 472                 return 0;
 473         } else {
 474                 # turn glob into safe regexp
 475                 $glob=quotemeta($glob);
 476                 $glob=~s/\\\*/.*/g;
 477                 $glob=~s/\\\?/./g;
 478                 $glob=~s!\\/!/!g;
 479
 480                 return $page=~/^$glob$/i;
 481         }
 482 } #}}}
 483
 484 sub globlist_match ($$) { #{{{
 485         my $page=shift;
 486         my @globlist=split(" ", shift);
 487
 488         # check any negated globs first
 489         foreach my $glob (@globlist) {
 490                 return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
 491         }
 492
 493         foreach my $glob (@globlist) {
 494                 return 1 if glob_match($page, $glob);
 495         }
 496
 497         return 0;
 498 } #}}}
 499
 500 sub hook (@) { # {{{
 501         my %param=@_;
 502
 503         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
 504                 error "hook requires type, call, and id parameters";
 505         }
 506
 507         $hooks{$param{type}}{$param{id}}=\%param;
 508 } # }}}
 509
 510 sub run_hooks ($$) { # {{{
 511         # Calls the given sub for each hook of the given type,
 512         # passing it the hook function to call.
 513         my $type=shift;
 514         my $sub=shift;
 515
 516         if (exists $hooks{$type}) {
 517                 foreach my $id (keys %{$hooks{$type}}) {
 518                         $sub->($hooks{$type}{$id}{call});
 519                 }
 520         }
 521 } #}}}
 522
 523 1