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 $wiki_link_regexp=qr/\[\[([^\s]+)\]\]/;
  19 my $wiki_file_regexp=qr/(^[-A-Za-z0-9_.:\/+]+$)/;
  20 my $wiki_file_prune_regexp=qr!((^|/).svn/|\.\.)!;
  21 my $verbose=0;
  22 my $wikiname="wiki";
  23 my $default_pagetype=".mdwn";
  24 my $cgi=0;
  25 my $url="";
  26
  27 sub usage {
  28         die "usage: ikiwiki [options] source dest\n";
  29 }
  30
  31 sub error ($) {
  32         if ($cgi) {
  33                 print "Content-type: text/html\n\n";
  34                 print "Error: @_\n";
  35                 exit 1;
  36         }
  37         else {
  38                 die @_;
  39         }
  40 }
  41
  42 sub debug ($) {
  43         print "@_\n" if $verbose;
  44 }
  45
  46 sub mtime ($) {
  47         my $page=shift;
  48
  49         return (stat($page))[9];
  50 }
  51
  52 sub possibly_foolish_untaint ($) {
  53         my $tainted=shift;
  54         my ($untainted)=$tainted=~/(.*)/;
  55         return $untainted;
  56 }
  57
  58 sub basename {
  59         my $file=shift;
  60
  61         $file=~s!.*/!!;
  62         return $file;
  63 }
  64
  65 sub dirname {
  66         my $file=shift;
  67
  68         $file=~s!/?[^/]+$!!;
  69         return $file;
  70 }
  71
  72 sub pagetype ($) {
  73         my $page=shift;
  74
  75         if ($page =~ /\.mdwn$/) {
  76                 return ".mdwn";
  77         }
  78         else {
  79                 return "unknown";
  80         }
  81 }
  82
  83 sub pagename ($) {
  84         my $file=shift;
  85
  86         my $type=pagetype($file);
  87         my $page=$file;
  88         $page=~s/\Q$type\E*$// unless $type eq 'unknown';
  89         return $page;
  90 }
  91
  92 sub htmlpage ($) {
  93         my $page=shift;
  94
  95         return $page.".html";
  96 }
  97
  98 sub readfile ($) {
  99         my $file=shift;
 100
 101         local $/=undef;
 102         open (IN, "$file") || error("failed to read $file: $!");
 103         my $ret=<IN>;
 104         close IN;
 105         return $ret;
 106 }
 107
 108 sub writefile ($$) {
 109         my $file=shift;
 110         my $content=shift;
 111
 112         my $dir=dirname($file);
 113         if (! -d $dir) {
 114                 my $d="";
 115                 foreach my $s (split(m!/+!, $dir)) {
 116                         $d.="$s/";
 117                         if (! -d $d) {
 118                                 mkdir($d) || error("failed to create directory $d: $!");
 119                         }
 120                 }
 121         }
 122
 123         open (OUT, ">$file") || error("failed to write $file: $!");
 124         print OUT $content;
 125         close OUT;
 126 }
 127
 128 sub findlinks {
 129         my $content=shift;
 130
 131         my @links;
 132         while ($content =~ /$wiki_link_regexp/g) {
 133                 push @links, lc($1);
 134         }
 135         return @links;
 136 }
 137
 138 # Given a page and the text of a link on the page, determine which existing
 139 # page that link best points to. Prefers pages under a subdirectory with
 140 # the same name as the source page, failing that goes down the directory tree
 141 # to the base looking for matching pages.
 142 sub bestlink ($$) {
 143         my $page=shift;
 144         my $link=lc(shift);
 145
 146         my $cwd=$page;
 147         do {
 148                 my $l=$cwd;
 149                 $l.="/" if length $l;
 150                 $l.=$link;
 151
 152                 if (exists $links{$l}) {
 153                         #debug("for $page, \"$link\", use $l");
 154                         return $l;
 155                 }
 156         } while $cwd=~s!/?[^/]+$!!;
 157
 158         #print STDERR "warning: page $page, broken link: $link\n";
 159         return "";
 160 }
 161
 162 sub isinlinableimage ($) {
 163         my $file=shift;
 164
 165         $file=~/\.(png|gif|jpg|jpeg)$/;
 166 }
 167
 168 sub htmllink ($$) {
 169         my $page=shift;
 170         my $link=shift;
 171
 172         my $bestlink=bestlink($page, $link);
 173
 174         return $link if $page eq $bestlink;
 175
 176         # TODO BUG: %renderedfiles may not have it, if the linked to page
 177         # was also added and isn't yet rendered! Note that this bug is
 178         # masked by the bug mentioned below that makes all new files
 179         # be rendered twice.
 180         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 181                 $bestlink=htmlpage($bestlink);
 182         }
 183         if (! grep { $_ eq $bestlink } values %renderedfiles) {
 184                 return "<a href=\"?\">?</a>$link"
 185         }
 186
 187         $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
 188
 189         if (isinlinableimage($bestlink)) {
 190                 return "<img src=\"$bestlink\">";
 191         }
 192         return "<a href=\"$bestlink\">$link</a>";
 193 }
 194
 195 sub linkify ($$) {
 196         my $content=shift;
 197         my $file=shift;
 198
 199         $content =~ s/$wiki_link_regexp/htmllink(pagename($file), $1)/eg;
 200
 201         return $content;
 202 }
 203
 204 sub htmlize ($$) {
 205         my $type=shift;
 206         my $content=shift;
 207
 208         if ($type eq '.mdwn') {
 209                 return Markdown::Markdown($content);
 210         }
 211         else {
 212                 error("htmlization of $type not supported");
 213         }
 214 }
 215
 216 sub linkbacks ($$) {
 217         my $content=shift;
 218         my $page=shift;
 219
 220         my @links;
 221         foreach my $p (keys %links) {
 222                 next if bestlink($page, $p) eq $page;
 223                 if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
 224                         my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
 225
 226                         # Trim common dir prefixes from both pages.
 227                         my $p_trimmed=$p;
 228                         my $page_trimmed=$page;
 229                         my $dir;
 230                         1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
 231                                 defined $dir &&
 232                                 $p_trimmed=~s/^\Q$dir\E// &&
 233                                 $page_trimmed=~s/^\Q$dir\E//;
 234
 235                         push @links, "<a href=\"$href\">$p_trimmed</a>";
 236                 }
 237         }
 238
 239         $content.="<hr><p>Links: ".join(" ", sort @links)."</p>\n" if @links;
 240         return $content;
 241 }
 242
 243 sub finalize ($$) {
 244         my $content=shift;
 245         my $page=shift;
 246
 247         my $title=basename($page);
 248         $title=~s/_/ /g;
 249
 250         my $pagelink="";
 251         my $path="";
 252         foreach my $dir (reverse split("/", $page)) {
 253                 if (length($pagelink)) {
 254                         $pagelink="<a href=\"$path$dir.html\">$dir</a>/ $pagelink";
 255                 }
 256                 else {
 257                         $pagelink=$dir;
 258                 }
 259                 $path.="../";
 260         }
 261         $path=~s/\.\.\/$/index.html/;
 262         $pagelink="<a href=\"$path\">$wikiname</a>/ $pagelink";
 263
 264         $content="<html>\n<head><title>$title</title></head>\n<body>\n".
 265                   "<h1>$pagelink</h1>\n".
 266                   $content.
 267                   "</body>\n</html>\n";
 268
 269         return $content;
 270 }
 271
 272 sub render ($) {
 273         my $file=shift;
 274
 275         my $type=pagetype($file);
 276         my $content=readfile("$srcdir/$file");
 277         if ($type ne 'unknown') {
 278                 my $page=pagename($file);
 279
 280                 $links{$page}=[findlinks($content)];
 281
 282                 $content=linkify($content, $file);
 283                 $content=htmlize($type, $content);
 284                 $content=linkbacks($content, $page);
 285                 $content=finalize($content, $page);
 286
 287                 writefile("$destdir/".htmlpage($page), $content);
 288                 $oldpagemtime{$page}=time;
 289                 $renderedfiles{$page}=htmlpage($page);
 290         }
 291         else {
 292                 $links{$file}=[];
 293                 writefile("$destdir/$file", $content);
 294                 $oldpagemtime{$file}=time;
 295                 $renderedfiles{$file}=$file;
 296         }
 297 }
 298
 299 sub loadindex () {
 300         open (IN, "$srcdir/.index") || return;
 301         while (<IN>) {
 302                 $_=possibly_foolish_untaint($_);
 303                 chomp;
 304                 my ($mtime, $file, $rendered, @links)=split(' ', $_);
 305                 my $page=pagename($file);
 306                 $pagesources{$page}=$file;
 307                 $oldpagemtime{$page}=$mtime;
 308                 $oldlinks{$page}=[@links];
 309                 $links{$page}=[@links];
 310                 $renderedfiles{$page}=$rendered;
 311         }
 312         close IN;
 313 }
 314
 315 sub saveindex () {
 316         open (OUT, ">$srcdir/.index") || error("cannot write to .index: $!");
 317         foreach my $page (keys %oldpagemtime) {
 318         print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
 319                   join(" ", @{$links{$page}})."\n"
 320                         if $oldpagemtime{$page};
 321         }
 322         close OUT;
 323 }
 324
 325 sub update () {
 326         if (-d "$srcdir/.svn") {
 327                 if (system("svn", "update", "--quiet", $srcdir) != 0) {
 328                         warn("svn update failed\n");
 329                 }
 330         }
 331 }
 332
 333 sub prune ($) {
 334         my $file=shift;
 335
 336         unlink($file);
 337         my $dir=dirname($file);
 338         while (rmdir($dir)) {
 339                 $dir=dirname($dir);
 340         }
 341 }
 342
 343 sub refresh () {
 344         # Find existing pages.
 345         my %exists;
 346         my @files;
 347         find({
 348                 no_chdir => 1,
 349                 wanted => sub {
 350                         if (/$wiki_file_prune_regexp/) {
 351                                 $File::Find::prune=1;
 352                         }
 353                         elsif (! -d $_ && ! /\.html$/ && ! /\/\./) {
 354                                 my ($f)=/$wiki_file_regexp/; # untaint
 355                                 if (! defined $f) {
 356                                         warn("skipping bad filename $_\n");
 357                                 }
 358                                 else {
 359                                         $f=~s/^\Q$srcdir\E\/?//;
 360                                         push @files, $f;
 361                                         $exists{pagename($f)}=1;
 362                                 }
 363                         }
 364                 },
 365         }, $srcdir);
 366
 367         my %rendered;
 368
 369         # check for added or removed pages
 370         my @add;
 371         foreach my $file (@files) {
 372                 my $page=pagename($file);
 373                 if (! $oldpagemtime{$page}) {
 374                         debug("new page $page");
 375                         push @add, $file;
 376                         $links{$page}=[];
 377                         $pagesources{$page}=$file;
 378                 }
 379         }
 380         my @del;
 381         foreach my $page (keys %oldpagemtime) {
 382                 if (! $exists{$page}) {
 383                         debug("removing old page $page");
 384                         push @del, $renderedfiles{$page};
 385                         prune($destdir."/".$renderedfiles{$page});
 386                         delete $renderedfiles{$page};
 387                         $oldpagemtime{$page}=0;
 388                         delete $pagesources{$page};
 389                 }
 390         }
 391
 392         # render any updated files
 393         foreach my $file (@files) {
 394                 my $page=pagename($file);
 395
 396                 if (! exists $oldpagemtime{$page} ||
 397                     mtime("$srcdir/$file") > $oldpagemtime{$page}) {
 398                         debug("rendering changed file $file");
 399                         render($file);
 400                         $rendered{$file}=1;
 401                 }
 402         }
 403
 404         # if any files were added or removed, check to see if each page
 405         # needs an update due to linking to them
 406         # TODO: inefficient; pages may get rendered above and again here;
 407         # problem is the bestlink may have changed and we won't know until
 408         # now
 409         if (@add || @del) {
 410 FILE:           foreach my $file (@files) {
 411                         my $page=pagename($file);
 412                         foreach my $f (@add, @del) {
 413                                 my $p=pagename($f);
 414                                 foreach my $link (@{$links{$page}}) {
 415                                         if (bestlink($page, $link) eq $p) {
 416                                                 debug("rendering $file, which links to $p");
 417                                                 render($file);
 418                                                 $rendered{$file}=1;
 419                                                 next FILE;
 420                                         }
 421                                 }
 422                         }
 423                 }
 424         }
 425
 426         # handle linkbacks; if a page has added/removed links, update the
 427         # pages it links to
 428         # TODO: inefficient; pages may get rendered above and again here;
 429         # problem is the linkbacks could be wrong in the first pass render
 430         # above
 431         if (%rendered) {
 432                 my %linkchanged;
 433                 foreach my $file (keys %rendered, @del) {
 434                         my $page=pagename($file);
 435                         if (exists $links{$page}) {
 436                                 foreach my $link (@{$links{$page}}) {
 437                                         $link=bestlink($page, $link);
 438                                         if (length $link &&
 439                                             ! exists $oldlinks{$page} ||
 440                                             ! grep { $_ eq $link } @{$oldlinks{$page}}) {
 441                                                 $linkchanged{$link}=1;
 442                                         }
 443                                 }
 444                         }
 445                         if (exists $oldlinks{$page}) {
 446                                 foreach my $link (@{$oldlinks{$page}}) {
 447                                         $link=bestlink($page, $link);
 448                                         if (length $link &&
 449                                             ! exists $links{$page} ||
 450                                             ! grep { $_ eq $link } @{$links{$page}}) {
 451                                                 $linkchanged{$link}=1;
 452                                         }
 453                                 }
 454                         }
 455                 }
 456                 foreach my $link (keys %linkchanged) {
 457                         my $linkfile=$pagesources{$link};
 458                         if (defined $linkfile) {
 459                                 debug("rendering $linkfile, to update its linkbacks");
 460                                 render($linkfile);
 461                         }
 462                 }
 463         }
 464 }
 465
 466 # Generates a C wrapper program for running ikiwiki in a specific way.
 467 # The wrapper may be safely made suid.
 468 sub gen_wrapper ($$) {
 469         my ($offline, $rebuild)=@_;
 470
 471         eval {use Cwd 'abs_path'};
 472         $srcdir=abs_path($srcdir);
 473         $destdir=abs_path($destdir);
 474         my $this=abs_path($0);
 475         if (! -x $this) {
 476                 error("$this doesn't seem to be executable");
 477         }
 478
 479         my $call=qq{"$this", "$this", "$srcdir", "$destdir", "--wikiname=$wikiname"};
 480         $call.=', "--verbose"' if $verbose;
 481         $call.=', "--rebuild"' if $rebuild;
 482         $call.=', "--offline"' if $offline;
 483         $call.=', "--cgi"' if $cgi;
 484         $call.=', "--url='.$url.'"' if $url;
 485
 486         # For CGI we need all these environment variables.
 487         my @envsave=qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI
 488                        CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE};
 489         my $envsave="";
 490         foreach my $var (@envsave) {
 491                 $envsave.=<<"EOF"
 492                 if ((s=getenv("$var")))
 493                         asprintf(&newenviron[i++], "%s=%s", "$var", s);
 494 EOF
 495         }
 496
 497         open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
 498         print OUT <<"EOF";
 499 /* A wrapper for ikiwiki, can be safely made suid. */
 500 #define _GNU_SOURCE
 501 #include <stdio.h>
 502 #include <unistd.h>
 503 #include <stdlib.h>
 504 #include <string.h>
 505
 506 extern char **environ;
 507
 508 int main (void) {
 509         /* Sanitize environment. */
 510         if ($cgi) {
 511                 char *s;
 512                 char *newenviron[$#envsave+2];
 513                 int i=0;
 514                 $envsave;
 515                 newenviron[i]=NULL;
 516                 environ=newenviron;
 517         }
 518         else {
 519                 clearenv();
 520         }
 521
 522         execl($call, NULL);
 523         perror("failed to run $this");
 524         exit(1);
 525 }
 526 EOF
 527         close OUT;
 528         if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
 529                 error("failed to compile ikiwiki-wrap.c");
 530         }
 531         unlink("ikiwiki-wrap.c");
 532         print "successfully generated ikiwiki-wrap\n";
 533         exit 0;
 534 }
 535
 536 sub cgi () {
 537         eval q{use CGI};
 538         my $q=CGI->new;
 539
 540         my $do=$q->param('do');
 541         if (! defined $do || ! length $do) {
 542                 error("\"do\" parameter missing");
 543         }
 544
 545         my ($page)=$q->param('page')=~/$wiki_file_regexp/; # untaint
 546         if (! defined $page || ! length $page || $page ne $q->param('page') ||
 547             $page=~/$wiki_file_prune_regexp/ || $page=~/^\//) {
 548                 error("bad page name");
 549         }
 550
 551         my $action=$q->request_uri;
 552         $action=~s/\?.*//;
 553
 554         if ($do eq 'edit') {
 555                 my $content="";
 556                 if (exists $pagesources{lc($page)}) {
 557                         $content=readfile("$srcdir/$pagesources{lc($page)}");
 558                         $content=~s/\n/\r\n/g;
 559                 }
 560                 $q->param("do", "save");
 561                 print $q->header,
 562                       $q->start_html("$wikiname: Editing $page"),
 563                       $q->h1("$wikiname: Editing $page"),
 564                       $q->start_form(-action => $action),
 565                       $q->hidden('do'),
 566                       $q->hidden('page'),
 567                       $q->textarea(-name => 'content',
 568                                -default => $content,
 569                                -rows => 20,
 570                                -columns => 80),
 571                       $q->p,
 572                       $q->submit("Save Changes"),
 573                       # TODO: Cancel button returns to page.
 574                       # TODO: Preview button.
 575                       # TODO: Commit message field.
 576                       # TODO: Conflict prevention.
 577                       $q->end_form,
 578                       $q->end_html;
 579         }
 580         elsif ($do eq 'save') {
 581                 my $file=$page.$default_pagetype;
 582                 if (exists $pagesources{lc($page)}) {
 583                         $file=$pagesources{lc($page)};
 584                 }
 585
 586                 my $content=$q->param('content');
 587                 $content=~s/\r\n/\n/g;
 588                 $content=~s/\r/\n/g;
 589                 writefile("$srcdir/$file", $content);
 590
 591                 print $q->redirect("$url/".htmlpage($page));
 592         }
 593         else {
 594                 error("unknown do parameter");
 595         }
 596 }
 597
 598 my $rebuild=0;
 599 my $offline=0;
 600 my $wrapper=0;
 601 if (grep /^-/, @ARGV) {
 602         eval {use Getopt::Long};
 603         GetOptions(
 604                 "wikiname=s" => \$wikiname,
 605                 "verbose|v" => \$verbose,
 606                 "rebuild" => \$rebuild,
 607                 "wrapper" => \$wrapper,
 608                 "offline" => \$offline,
 609                 "cgi" => \$cgi,
 610                 "url=s" => \$url,
 611         ) || usage();
 612 }
 613 usage() unless @ARGV == 2;
 614 ($srcdir) = possibly_foolish_untaint(shift);
 615 ($destdir) = possibly_foolish_untaint(shift);
 616
 617 if ($cgi && ! length $url) {
 618         error("Must specify url to wiki with --url when using --cgi");
 619 }
 620
 621 gen_wrapper($offline, $rebuild) if $wrapper;
 622 memoize('pagename');
 623 memoize('bestlink');
 624 loadindex() unless $rebuild;
 625 if ($cgi) {
 626         cgi();
 627 }
 628 else {
 629         update() unless $offline;
 630         refresh();
 631         saveindex();
 632 }