path: root/ikiwiki

#!/usr/bin/perl -T

use warnings;
use strict;
use File::Find;
use Memoize;
use File::Spec;

$ENV{PATH}="/usr/local/bin:/usr/bin:/bin";

BEGIN {
    $blosxom::version="is a proper perl module too much to ask?";
    do "/usr/bin/markdown";
}

my ($srcdir, $destdir, %links, %oldlinks, %oldpagemtime, %renderedfiles,
    %pagesources);
my $link=qr/\[\[([^\s]+)\]\]/;
my $verbose=0;
my $wikiname="wiki";

sub usage {
    die "usage: ikiwiki [options] source dest\n";
}

sub error ($) {
    die @_;
}

sub debug ($) {
    print "@_\n" if $verbose;
}

sub mtime ($) {
    my $page=shift;
    
    return (stat($page))[9];
}

sub basename {
    my $file=shift;

    $file=~s!.*/!!;
    return $file;
}

sub dirname {
    my $file=shift;

    $file=~s!/?[^/]+$!!;
    return $file;
}

sub pagetype ($) {
    my $page=shift;
    
    if ($page =~ /\.mdwn$/) {
        return ".mdwn";
    }
    else {
        return "unknown";
    }
}

sub pagename ($) {
    my $file=shift;

    my $type=pagetype($file);
    my $page=$file;
    $page=~s/\Q$type\E*$// unless $type eq 'unknown';
    return $page;
}

sub htmlpage ($) {
    my $page=shift;

    return $page.".html";
}

sub readpage ($) {
    my $page=shift;

    local $/=undef;
    open (PAGE, "$srcdir/$page") || error("failed to read $page: $!");
    my $ret=<PAGE>;
    close PAGE;
    return $ret;
}

sub writepage ($$) {
    my $page=shift;
    my $content=shift;

    my $dir=dirname("$destdir/$page");
    if (! -d $dir) {
        my $d="";
        foreach my $s (split(m!/+!, $dir)) {
            $d.="$s/";
            if (! -d $d) {
                mkdir($d) || error("failed to create directory $d: $!");
            }
        }
    }
    
    open (PAGE, ">$destdir/$page") || error("failed to write $page: $!");
    print PAGE $content;
    close PAGE;
}

sub findlinks {
    my $content=shift;

    my @links;
    while ($content =~ /$link/g) {
        push @links, lc($1);
    }
    return @links;
}

# Given a page and the text of a link on the page, determine which existing
# page that link best points to. Prefers pages under a subdirectory with
# the same name as the source page, failing that goes down the directory tree
# to the base looking for matching pages.
sub bestlink ($$) {
    my $page=shift;
    my $link=lc(shift);
    
    my $cwd=$page;
    do {
        my $l=$cwd;
        $l.="/" if length $l;
        $l.=$link;

        if (exists $links{$l}) {
            #debug("for $page, \"$link\", use $l");
            return $l;
        }
    } while $cwd=~s!/?[^/]+$!!;

    #print STDERR "warning: page $page, broken link: $link\n";
    return "";
}

sub isinlinableimage ($) {
    my $file=shift;
    
    $file=~/\.(png|gif|jpg|jpeg)$/;
}

sub htmllink ($$) {
    my $page=shift;
    my $link=shift;

    my $bestlink=bestlink($page, $link);

    return $link if $page eq $bestlink;
    
    # TODO BUG: %renderedfiles may not have it, if the linked to page
    # was also added and isn't yet rendered! Note that this bug is
    # masked by the bug mentioned below that makes all new files
    # be rendered twice.
    if (! grep { $_ eq $bestlink } values %renderedfiles) {
        $bestlink=htmlpage($bestlink);
    }
    if (! grep { $_ eq $bestlink } values %renderedfiles) {
        return "<a href=\"?\">?</a>$link"
    }
    
    $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
    
    if (isinlinableimage($bestlink)) {
        return "<img src=\"$bestlink\">";
    }
    return "<a href=\"$bestlink\">$link</a>";
}

sub linkify ($$) {
    my $content=shift;
    my $file=shift;

    $content =~ s/$link/htmllink(pagename($file), $1)/eg;
    
    return $content;
}

sub htmlize ($$) {
    my $type=shift;
    my $content=shift;
    
    if ($type eq '.mdwn') {
        return Markdown::Markdown($content);
    }
    else {
        error("htmlization of $type not supported");
    }
}

sub linkbacks ($$) {
    my $content=shift;
    my $page=shift;

    my @links;
    foreach my $p (keys %links) {
        next if bestlink($page, $p) eq $page;
        if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
            my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
            
            # Trim common dir prefixes from both pages.
            my $p_trimmed=$p;
            my $page_trimmed=$page;
            my $dir;
            1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
                    defined $dir &&
                    $p_trimmed=~s/^\Q$dir\E// &&
                    $page_trimmed=~s/^\Q$dir\E//;
                       
            push @links, "<a href=\"$href\">$p_trimmed</a>";
        }
    }

    $content.="<hr><p>Links: ".join(" ", sort @links)."</p>\n" if @links;
    return $content;
}

sub finalize ($$) {
    my $content=shift;
    my $page=shift;

    my $title=basename($page);
    $title=~s/_/ /g;
    
    my $pagelink="";
    my $path="";
    foreach my $dir (reverse split("/", $page)) {
        if (length($pagelink)) {
            $pagelink="<a href=\"$path$dir.html\">$dir</a>/ $pagelink";
        }
        else {
            $pagelink=$dir;
        }
        $path.="../";
    }
    $path=~s/\.\.\/$/index.html/;
    $pagelink="<a href=\"$path\">$wikiname</a>/ $pagelink";
    
    $content="<html>\n<head><title>$title</title></head>\n<body>\n".
              "<h1>$pagelink</h1>\n".
              $content.
              "</body>\n</html>\n";
    
    return $content;
}

sub render ($) {
    my $file=shift;
    
    my $type=pagetype($file);
    my $content=readpage($file);
    if ($type ne 'unknown') {
        my $page=pagename($file);
        
        $links{$page}=[findlinks($content)];
        
        $content=linkify($content, $file);
        $content=htmlize($type, $content);
        $content=linkbacks($content, $page);
        $content=finalize($content, $page);
        
        writepage(htmlpage($page), $content);
        $oldpagemtime{$page}=time;
        $renderedfiles{$page}=htmlpage($page);
    }
    else {
        $links{$file}=[];
        writepage($file, $content);
        $oldpagemtime{$file}=time;
        $renderedfiles{$file}=$file;
    }
}

sub loadindex () {
    open (IN, "$srcdir/.index") || return;
    while (<IN>) {
        ($_)=/(.*)/; # untaint
        chomp;
        my ($mtime, $file, $rendered, @links)=split(' ', $_);
        my $page=pagename($file);
        $pagesources{$page}=$file;
        $oldpagemtime{$page}=$mtime;
        $oldlinks{$page}=[@links];
        $links{$page}=[@links];
        $renderedfiles{$page}=$rendered;
    }
    close IN;
}   

sub saveindex () {
    open (OUT, ">$srcdir/.index") || error("cannot write to .index: $!");
    foreach my $page (keys %oldpagemtime) {
    print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
              join(" ", @{$links{$page}})."\n"
            if $oldpagemtime{$page};
    }
    close OUT;
}

sub prune ($) {
    my $file=shift;

    unlink($file);
    my $dir=dirname($file);
    while (rmdir($dir)) {
        $dir=dirname($dir);
    }
}

sub refresh () {
    # Find existing pages.
    my %exists;
    my @files;
    find({
        no_chdir => 1,
        wanted => sub {
            if (/\/\.svn\//) {
                $File::Find::prune=1;
            }
            elsif (! -d $_ && ! /\.html$/ && ! /\/\./) {
                my ($f)=/(^[-A-Za-z0-9_.:\/+]+$)/; # untaint
                if (! defined $f) {
                    warn("skipping bad filename $_\n");
                }
                else {
                    $f=~s/^\Q$srcdir\E\/?//;
                    push @files, $f;
                    $exists{pagename($f)}=1;
                }
            }
        },
    }, $srcdir);

    my %rendered;

    # check for added or removed pages
    my @add;
    foreach my $file (@files) {
        my $page=pagename($file);
        if (! $oldpagemtime{$page}) {
            debug("new page $page");
            push @add, $file;
            $links{$page}=[];
            $pagesources{$page}=$file;
        }
    }
    my @del;
    foreach my $page (keys %oldpagemtime) {
        if (! $exists{$page}) {
            debug("removing old page $page");
            push @del, $renderedfiles{$page};
            prune($destdir."/".$renderedfiles{$page});
            delete $renderedfiles{$page};
            $oldpagemtime{$page}=0;
            delete $pagesources{$page};
        }
    }
    
    # render any updated files
    foreach my $file (@files) {
        my $page=pagename($file);
        
        if (! exists $oldpagemtime{$page} ||
            mtime("$srcdir/$file") > $oldpagemtime{$page}) {
                debug("rendering changed file $file");
            render($file);
            $rendered{$file}=1;
        }
    }
    
    # if any files were added or removed, check to see if each page
    # needs an update due to linking to them
    # TODO: inefficient; pages may get rendered above and again here;
    # problem is the bestlink may have changed and we won't know until
    # now
    if (@add || @del) {
FILE:       foreach my $file (@files) {
            my $page=pagename($file);
            foreach my $f (@add, @del) {
                my $p=pagename($f);
                foreach my $link (@{$links{$page}}) {
                    if (bestlink($page, $link) eq $p) {
                        debug("rendering $file, which links to $p");
                        render($file);
                        $rendered{$file}=1;
                        next FILE;
                    }
                }
            }
        }
    }

    # handle linkbacks; if a page has added/removed links, update the
    # pages it links to
    # TODO: inefficient; pages may get rendered above and again here;
    # problem is the linkbacks could be wrong in the first pass render
    # above
    if (%rendered) {
        my %linkchanged;
        foreach my $file (keys %rendered, @del) {
            my $page=pagename($file);
            if (exists $links{$page}) {
                foreach my $link (@{$links{$page}}) {
                    $link=bestlink($page, $link);
                    if (length $link &&
                        ! exists $oldlinks{$page} ||
                        ! grep { $_ eq $link } @{$oldlinks{$page}}) {
                        $linkchanged{$link}=1;
                    }
                }
            }
            if (exists $oldlinks{$page}) {
                foreach my $link (@{$oldlinks{$page}}) {
                    $link=bestlink($page, $link);
                    if (length $link &&
                        ! exists $links{$page} ||
                        ! grep { $_ eq $link } @{$links{$page}}) {
                        $linkchanged{$link}=1;
                    }
                }
            }
        }
        foreach my $link (keys %linkchanged) {
                my $linkfile=$pagesources{$link};
            if (defined $linkfile) {
                debug("rendering $linkfile, to update its linkbacks");
                render($linkfile);
            }
        }
    }
}

# Generates a C wrapper program for running ikiwiki in a specific way.
# The wrapper may be safely made suid.
sub gen_wrapper ($$) {
    my ($offline, $rebuild)=@_;

    eval {use Cwd 'abs_path'};
    $srcdir=abs_path($srcdir);
    $destdir=abs_path($destdir);
    my $this=abs_path($0);
    if (! -x $this) {
        error("$this doesn't seem to be executable");
    }
    
    my $call=qq{"$this", "$this", "$srcdir", "$destdir", "--wikiname=$wikiname"};
    $call.=', "--verbose"' if $verbose;
    $call.=', "--rebuild"' if $rebuild;
    $call.=', "--offline"' if $offline;
    
    open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
    print OUT <<"EOF";
/* A suid wraper for ikiwiki */
#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>

int main (void) {
    unsetenv("PERLIO_DEBUG"); /* CAN-2005-0155 */
    execl($call, NULL);
    perror("failed to run $this");
    exit(1);
}
EOF
    close OUT;
    if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
        error("failed to compile ikiwiki-wrap.c");
    }
    unlink("ikiwiki-wrap.c");
    print "successfully generated ikiwiki-wrap\n";
    exit 0;
}

sub update () {
    if (-d "$srcdir/.svn") {
        if (system("svn", "update", "--quiet", $srcdir) != 0) {
            warn("svn update failed\n");
        }
    }
}

my $rebuild=0;
my $offline=0;
my $gen_wrapper=0;
if (grep /^-/, @ARGV) {
    eval {use Getopt::Long};
    GetOptions(
        "wikiname=s" => \$wikiname,
        "verbose|v" => \$verbose,
        "rebuild" => \$rebuild,
        "gen-wrapper" => \$gen_wrapper,
        "offline" => \$offline,
    ) || usage();
}
usage() unless @ARGV == 2;
($srcdir) = shift =~ /(.*)/; # untaint
($destdir) = shift =~ /(.*)/; # untaint

gen_wrapper($offline, $rebuild) if $gen_wrapper;
memoize('pagename');
memoize('bestlink');
update() unless $offline;
loadindex() unless $rebuild;
refresh();
saveindex();