git.oblomov.eu Git - ikiwiki/blob - 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         if (! -d $config{wikistatedir}) {
 399                 mkdir($config{wikistatedir});
 400         }
 401         open (OUT, ">$config{wikistatedir}/index") ||
 402                 error("cannot write to $config{wikistatedir}/index: $!");
 403         foreach my $page (keys %oldpagemtime) {
 404                 next unless $oldpagemtime{$page};
 405                 my $line="mtime=$oldpagemtime{$page} ".
 406                         "ctime=$pagectime{$page} ".
 407                         "src=$pagesources{$page} ".
 408                         "dest=$renderedfiles{$page}";
 409                 $line.=" link=$_" foreach @{$links{$page}};
 410                 if (exists $depends{$page}) {
 411                         $line.=" depends=$_" foreach split " ", $depends{$page};
 412                 }
 413                 print OUT $line."\n";
 414         }
 415         close OUT;
 416 } #}}}
 417
 418 sub template_params (@) { #{{{
 419         my $filename=shift;
 420
 421         require HTML::Template;
 422         return filter => sub {
 423                         my $text_ref = shift;
 424                         $$text_ref=&Encode::decode_utf8($$text_ref);
 425                 },
 426                 filename => "$config{templatedir}/$filename", @_;
 427 } #}}}
 428
 429 sub template ($;@) { #{{{
 430         HTML::Template->new(template_params(@_));
 431 } #}}}
 432
 433 sub misctemplate ($$) { #{{{
 434         my $title=shift;
 435         my $pagebody=shift;
 436
 437         my $template=template("misc.tmpl");
 438         $template->param(
 439                 title => $title,
 440                 indexlink => indexlink(),
 441                 wikiname => $config{wikiname},
 442                 pagebody => $pagebody,
 443                 styleurl => styleurl(),
 444                 baseurl => "$config{url}/",
 445         );
 446         return $template->output;
 447 }#}}}
 448
 449 sub glob_match ($$) { #{{{
 450         my $page=shift;
 451         my $glob=shift;
 452
 453         if ($glob =~ /^link\((.+)\)$/) {
 454                 my $rev = $links{$page} or return undef;
 455                 foreach my $p (@$rev) {
 456                         return 1 if lc $p eq $1;
 457                 }
 458                 return 0;
 459         } elsif ($glob =~ /^backlink\((.+)\)$/) {
 460                 my $rev = $links{$1} or return undef;
 461                 foreach my $p (@$rev) {
 462                         return 1 if lc $p eq $page;
 463                 }
 464                 return 0;
 465         } else {
 466                 # turn glob into safe regexp
 467                 $glob=quotemeta($glob);
 468                 $glob=~s/\\\*/.*/g;
 469                 $glob=~s/\\\?/./g;
 470                 $glob=~s!\\/!/!g;
 471
 472                 return $page=~/^$glob$/i;
 473         }
 474 } #}}}
 475
 476 sub globlist_match ($$) { #{{{
 477         my $page=shift;
 478         my @globlist=split(" ", shift);
 479
 480         # check any negated globs first
 481         foreach my $glob (@globlist) {
 482                 return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
 483         }
 484
 485         foreach my $glob (@globlist) {
 486                 return 1 if glob_match($page, $glob);
 487         }
 488
 489         return 0;
 490 } #}}}
 491
 492 sub hook (@) { # {{{
 493         my %param=@_;
 494
 495         if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
 496                 error "hook requires type, call, and id parameters";
 497         }
 498
 499         $hooks{$param{type}}{$param{id}}=\%param;
 500 } # }}}
 501
 502 sub run_hooks ($$) { # {{{
 503         # Calls the given sub for each hook of the given type,
 504         # passing it the hook function to call.
 505         my $type=shift;
 506         my $sub=shift;
 507
 508         if (exists $hooks{$type}) {
 509                 foreach my $id (keys %{$hooks{$type}}) {
 510                         $sub->($hooks{$type}{$id}{call});
 511                 }
 512         }
 513 } #}}}
 514
 515 1