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