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