ikiwiki

   1 #!/usr/bin/perl -T
   2
   3 use warnings;
   4 use strict;
   5 use File::Find;
   6 use Memoize;
   7 use File::Spec;
   8
   9 $ENV{PATH}="/usr/local/bin:/usr/bin:/bin";
  10
  11 BEGIN {
  12         $blosxom::version="is a proper perl module too much to ask?";
  13         do "/usr/bin/markdown";
  14 }
  15
  16 my ($srcdir, $destdir, %links, %oldlinks, %oldpagemtime, %renderedfiles,
  17     %pagesources);
  18 my $link=qr/\[\[([^\s]+)\]\]/;
  19 my $verbose=0;
  20 my $wikiname="wiki";
  21
  22 sub usage {
  23         die "usage: ikiwiki [options] source dest\n";
  24 }
  25
  26 sub error ($) {
  27         die @_;
  28 }
  29
  30 sub debug ($) {
  31         print "@_\n" if $verbose;
  32 }
  33
  34 sub mtime ($) {
  35         my $page=shift;
  36
  37         return (stat($page))[9];
  38 }
  39
  40 sub possibly_foolish_untaint ($) {
  41         my $tainted=shift;
  42         my ($untainted)=$tainted=~/(.*)/;
  43         return $untainted;
  44 }
  45
  46 sub basename {
  47         my $file=shift;
  48
  49         $file=~s!.*/!!;
  50         return $file;
  51 }
  52
  53 sub dirname {
  54         my $file=shift;
  55
  56         $file=~s!/?[^/]+$!!;
  57         return $file;
  58 }
  59
  60 sub pagetype ($) {
  61         my $page=shift;
  62
  63         if ($page =~ /\.mdwn$/) {
  64                 return ".mdwn";
  65         }
  66         else {
  67                 return "unknown";
  68         }
  69 }
  70
  71 sub pagename ($) {
  72         my $file=shift;
  73
  74         my $type=pagetype($file);
  75         my $page=$file;
  76         $page=~s/\Q$type\E*$// unless $type eq 'unknown';
  77         return $page;
  78 }
  79
  80 sub htmlpage ($) {
  81         my $page=shift;
  82
  83         return $page.".html";
  84 }
  85
  86 sub readpage ($) {
  87         my $page=shift;
  88
  89         local $/=undef;
  90         open (PAGE, "$srcdir/$page") || error("failed to read $page: $!");
  91         my $ret=<PAGE>;
  92         close PAGE;
  93         return $ret;
  94 }
  95
  96 sub writepage ($$) {
  97         my $page=shift;
  98         my $content=shift;
  99
 100         my $dir=dirname("$destdir/$page");
 101         if (! -d $dir) {
 102                 my $d="";
 103                 foreach my $s (split(m!/+!, $dir)) {
 104                         $d.="$s/";
 105                         if (! -d $d) {
 106                                 mkdir($d) || error("failed to create directory $d: $!");
 107                         }
 108                 }
 109         }
 110
 111         open (PAGE, ">$destdir/$page") || error("failed to write $page: $!");
 112         print PAGE $content;
 113         close PAGE;
 114 }
 115
 116 sub findlinks {
 117         my $content=shift;
 118
 119         my @links;
 120         while ($content =~ /$link/g) {
 121                 push @links, lc($1);
 122         }
 123         return @links;
 124 }
 125
 126 # Given a page and the text of a link on the page, determine which existing
 127 # page that link best points to. Prefers pages under a subdirectory with
 128 # the same name as the source page, failing that goes down the directory tree
 129 # to the base looking for matching pages.
 130 sub bestlink ($$) {
 131         my $page=shift;
 132         my $link=lc(shift);
 133
 134         my $cwd=$page;
 135         do {
 136                 my $l=$cwd;
 137                 $l.="/" if length $l;
 138                 $l.=$link;
 139
 140                 if (exists $links{$l}) {
 141                         #debug("for $page, \"$link\", use $l");
 142                         return $l;
 143                 }
 144         } while $cwd=~s!/?[^/]+$!!;
 145
 146         #print STDERR "warning: page $page, broken link: $link\n";
 147         return "";
 148 }
 149
 150 sub isinlinableimage ($) {
 151         my $file=shift;
 152
 153         $file=~/\.(png|gif|jpg|jpeg)$/;
 154 }
 155
 156 sub htmllink ($$) {
 157         my $page=shift;
 158         my $link=shift;
 159
 160         my $bestlink=bestlink($page, $link);
 161
 162         return $link if $page eq $bestlink;
 163
 164         # TODO BUG: %renderedfiles may not have it, if the linked to page
 165         # was also added and isn't yet rendered! Note that this bug is
 166         # masked by the bug mentioned below that makes all new files
 167         # be rendered twice.
 168         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 169                 $bestlink=htmlpage($bestlink);
 170         }
 171         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 172                 return "<a href=\"?\">?</a>$link"
 173         }
 174
 175         $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
 176
 177         if (isinlinableimage($bestlink)) {
 178                 return "<img src=\"$bestlink\">";
 179         }
 180         return "<a href=\"$bestlink\">$link</a>";
 181 }
 182
 183 sub linkify ($$) {
 184         my $content=shift;
 185         my $file=shift;
 186
 187         $content =~ s/$link/htmllink(pagename($file), $1)/eg;
 188
 189         return $content;
 190 }
 191
 192 sub htmlize ($$) {
 193         my $type=shift;
 194         my $content=shift;
 195
 196         if ($type eq '.mdwn') {
 197                 return Markdown::Markdown($content);
 198         }
 199         else {
 200                 error("htmlization of $type not supported");
 201         }
 202 }
 203
 204 sub linkbacks ($$) {
 205         my $content=shift;
 206         my $page=shift;
 207
 208         my @links;
 209         foreach my $p (keys %links) {
 210                 next if bestlink($page, $p) eq $page;
 211                 if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
 212                         my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
 213
 214                         # Trim common dir prefixes from both pages.
 215                         my $p_trimmed=$p;
 216                         my $page_trimmed=$page;
 217                         my $dir;
 218                         1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
 219                                 defined $dir &&
 220                                 $p_trimmed=~s/^\Q$dir\E// &&
 221                                 $page_trimmed=~s/^\Q$dir\E//;
 222
 223                         push @links, "<a href=\"$href\">$p_trimmed</a>";
 224                 }
 225         }
 226
 227         $content.="<hr><p>Links: ".join(" ", sort @links)."</p>\n" if @links;
 228         return $content;
 229 }
 230
 231 sub finalize ($$) {
 232         my $content=shift;
 233         my $page=shift;
 234
 235         my $title=basename($page);
 236         $title=~s/_/ /g;
 237
 238         my $pagelink="";
 239         my $path="";
 240         foreach my $dir (reverse split("/", $page)) {
 241                 if (length($pagelink)) {
 242                         $pagelink="<a href=\"$path$dir.html\">$dir</a>/ $pagelink";
 243                 }
 244                 else {
 245                         $pagelink=$dir;
 246                 }
 247                 $path.="../";
 248         }
 249         $path=~s/\.\.\/$/index.html/;
 250         $pagelink="<a href=\"$path\">$wikiname</a>/ $pagelink";
 251
 252         $content="<html>\n<head><title>$title</title></head>\n<body>\n".
 253                   "<h1>$pagelink</h1>\n".
 254                   $content.
 255                   "</body>\n</html>\n";
 256
 257         return $content;
 258 }
 259
 260 sub render ($) {
 261         my $file=shift;
 262
 263         my $type=pagetype($file);
 264         my $content=readpage($file);
 265         if ($type ne 'unknown') {
 266                 my $page=pagename($file);
 267
 268                 $links{$page}=[findlinks($content)];
 269
 270                 $content=linkify($content, $file);
 271                 $content=htmlize($type, $content);
 272                 $content=linkbacks($content, $page);
 273                 $content=finalize($content, $page);
 274
 275                 writepage(htmlpage($page), $content);
 276                 $oldpagemtime{$page}=time;
 277                 $renderedfiles{$page}=htmlpage($page);
 278         }
 279         else {
 280                 $links{$file}=[];
 281                 writepage($file, $content);
 282                 $oldpagemtime{$file}=time;
 283                 $renderedfiles{$file}=$file;
 284         }
 285 }
 286
 287 sub loadindex () {
 288         open (IN, "$srcdir/.index") || return;
 289         while (<IN>) {
 290                 $_=possibly_foolish_untaint($_);
 291                 chomp;
 292                 my ($mtime, $file, $rendered, @links)=split(' ', $_);
 293                 my $page=pagename($file);
 294                 $pagesources{$page}=$file;
 295                 $oldpagemtime{$page}=$mtime;
 296                 $oldlinks{$page}=[@links];
 297                 $links{$page}=[@links];
 298                 $renderedfiles{$page}=$rendered;
 299         }
 300         close IN;
 301 }
 302
 303 sub saveindex () {
 304         open (OUT, ">$srcdir/.index") || error("cannot write to .index: $!");
 305         foreach my $page (keys %oldpagemtime) {
 306         print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
 307                   join(" ", @{$links{$page}})."\n"
 308                         if $oldpagemtime{$page};
 309         }
 310         close OUT;
 311 }
 312
 313 sub prune ($) {
 314         my $file=shift;
 315
 316         unlink($file);
 317         my $dir=dirname($file);
 318         while (rmdir($dir)) {
 319                 $dir=dirname($dir);
 320         }
 321 }
 322
 323 sub refresh () {
 324         # Find existing pages.
 325         my %exists;
 326         my @files;
 327         find({
 328                 no_chdir => 1,
 329                 wanted => sub {
 330                         if (/\/\.svn\//) {
 331                                 $File::Find::prune=1;
 332                         }
 333                         elsif (! -d $_ && ! /\.html$/ && ! /\/\./) {
 334                                 my ($f)=/(^[-A-Za-z0-9_.:\/+]+$)/; # untaint
 335                                 if (! defined $f) {
 336                                         warn("skipping bad filename $_\n");
 337                                 }
 338                                 else {
 339                                         $f=~s/^\Q$srcdir\E\/?//;
 340                                         push @files, $f;
 341                                         $exists{pagename($f)}=1;
 342                                 }
 343                         }
 344                 },
 345         }, $srcdir);
 346
 347         my %rendered;
 348
 349         # check for added or removed pages
 350         my @add;
 351         foreach my $file (@files) {
 352                 my $page=pagename($file);
 353                 if (! $oldpagemtime{$page}) {
 354                         debug("new page $page");
 355                         push @add, $file;
 356                         $links{$page}=[];
 357                         $pagesources{$page}=$file;
 358                 }
 359         }
 360         my @del;
 361         foreach my $page (keys %oldpagemtime) {
 362                 if (! $exists{$page}) {
 363                         debug("removing old page $page");
 364                         push @del, $renderedfiles{$page};
 365                         prune($destdir."/".$renderedfiles{$page});
 366                         delete $renderedfiles{$page};
 367                         $oldpagemtime{$page}=0;
 368                         delete $pagesources{$page};
 369                 }
 370         }
 371
 372         # render any updated files
 373         foreach my $file (@files) {
 374                 my $page=pagename($file);
 375
 376                 if (! exists $oldpagemtime{$page} ||
 377                     mtime("$srcdir/$file") > $oldpagemtime{$page}) {
 378                         debug("rendering changed file $file");
 379                         render($file);
 380                         $rendered{$file}=1;
 381                 }
 382         }
 383
 384         # if any files were added or removed, check to see if each page
 385         # needs an update due to linking to them
 386         # TODO: inefficient; pages may get rendered above and again here;
 387         # problem is the bestlink may have changed and we won't know until
 388         # now
 389         if (@add || @del) {
 390 FILE:           foreach my $file (@files) {
 391                         my $page=pagename($file);
 392                         foreach my $f (@add, @del) {
 393                                 my $p=pagename($f);
 394                                 foreach my $link (@{$links{$page}}) {
 395                                         if (bestlink($page, $link) eq $p) {
 396                                                 debug("rendering $file, which links to $p");
 397                                                 render($file);
 398                                                 $rendered{$file}=1;
 399                                                 next FILE;
 400                                         }
 401                                 }
 402                         }
 403                 }
 404         }
 405
 406         # handle linkbacks; if a page has added/removed links, update the
 407         # pages it links to
 408         # TODO: inefficient; pages may get rendered above and again here;
 409         # problem is the linkbacks could be wrong in the first pass render
 410         # above
 411         if (%rendered) {
 412                 my %linkchanged;
 413                 foreach my $file (keys %rendered, @del) {
 414                         my $page=pagename($file);
 415                         if (exists $links{$page}) {
 416                                 foreach my $link (@{$links{$page}}) {
 417                                         $link=bestlink($page, $link);
 418                                         if (length $link &&
 419                                             ! exists $oldlinks{$page} ||
 420                                             ! grep { $_ eq $link } @{$oldlinks{$page}}) {
 421                                                 $linkchanged{$link}=1;
 422                                         }
 423                                 }
 424                         }
 425                         if (exists $oldlinks{$page}) {
 426                                 foreach my $link (@{$oldlinks{$page}}) {
 427                                         $link=bestlink($page, $link);
 428                                         if (length $link &&
 429                                             ! exists $links{$page} ||
 430                                             ! grep { $_ eq $link } @{$links{$page}}) {
 431                                                 $linkchanged{$link}=1;
 432                                         }
 433                                 }
 434                         }
 435                 }
 436                 foreach my $link (keys %linkchanged) {
 437                         my $linkfile=$pagesources{$link};
 438                         if (defined $linkfile) {
 439                                 debug("rendering $linkfile, to update its linkbacks");
 440                                 render($linkfile);
 441                         }
 442                 }
 443         }
 444 }
 445
 446 # Generates a C wrapper program for running ikiwiki in a specific way.
 447 # The wrapper may be safely made suid.
 448 sub gen_wrapper ($$) {
 449         my ($offline, $rebuild)=@_;
 450
 451         eval {use Cwd 'abs_path'};
 452         $srcdir=abs_path($srcdir);
 453         $destdir=abs_path($destdir);
 454         my $this=abs_path($0);
 455         if (! -x $this) {
 456                 error("$this doesn't seem to be executable");
 457         }
 458
 459         my $call=qq{"$this", "$this", "$srcdir", "$destdir", "--wikiname=$wikiname"};
 460         $call.=', "--verbose"' if $verbose;
 461         $call.=', "--rebuild"' if $rebuild;
 462         $call.=', "--offline"' if $offline;
 463
 464         open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
 465         print OUT <<"EOF";
 466 /* A suid wraper for ikiwiki */
 467 #include <stdio.h>
 468 #include <unistd.h>
 469 #include <stdlib.h>
 470
 471 int main (void) {
 472         clearenv();
 473         execl($call, NULL);
 474         perror("failed to run $this");
 475         exit(1);
 476 }
 477 EOF
 478         close OUT;
 479         if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
 480                 error("failed to compile ikiwiki-wrap.c");
 481         }
 482         unlink("ikiwiki-wrap.c");
 483         print "successfully generated ikiwiki-wrap\n";
 484         exit 0;
 485 }
 486
 487 sub update () {
 488         if (-d "$srcdir/.svn") {
 489                 if (system("svn", "update", "--quiet", $srcdir) != 0) {
 490                         warn("svn update failed\n");
 491                 }
 492         }
 493 }
 494
 495 my $rebuild=0;
 496 my $offline=0;
 497 my $gen_wrapper=0;
 498 if (grep /^-/, @ARGV) {
 499         eval {use Getopt::Long};
 500         GetOptions(
 501                 "wikiname=s" => \$wikiname,
 502                 "verbose|v" => \$verbose,
 503                 "rebuild" => \$rebuild,
 504                 "gen-wrapper" => \$gen_wrapper,
 505                 "offline" => \$offline,
 506         ) || usage();
 507 }
 508 usage() unless @ARGV == 2;
 509 ($srcdir) = possibly_foolish_untaint(shift);
 510 ($destdir) = possibly_foolish_untaint(shift);
 511
 512 gen_wrapper($offline, $rebuild) if $gen_wrapper;
 513 memoize('pagename');
 514 memoize('bestlink');
 515 update() unless $offline;
 516 loadindex() unless $rebuild;
 517 refresh();
 518 saveindex();