#!/usr/bin/perl -T use warnings; use strict; use File::Find; use Memoize; use File::Spec; BEGIN { $blosxom::version="is a proper perl module too much to ask?"; do "/usr/bin/markdown"; } $ENV{PATH}="/usr/local/bin:/usr/bin:/bin"; my ($srcdir, $destdir, %links, %oldlinks, %oldpagemtime, %renderedfiles, %pagesources); my $wiki_link_regexp=qr/\[\[([^\s]+)\]\]/; my $wiki_file_regexp=qr/(^[-A-Za-z0-9_.:\/+]+$)/; my $wiki_file_prune_regexp=qr!((^|/).svn/|\.\.|^\.|\/\.|\.html?$)!; my $verbose=0; my $wikiname="wiki"; my $default_pagetype=".mdwn"; my $cgi=0; my $url=""; my $cgiurl=""; my $historyurl=""; my $svn=1; sub usage { #{{{ die "usage: ikiwiki [options] source dest\n"; } #}}} sub error ($) { #{{{ if ($cgi) { print "Content-type: text/html\n\n"; print "Error: @_\n"; exit 1; } else { die @_; } } #}}} sub debug ($) { #{{{ print "@_\n" if $verbose; } #}}} sub mtime ($) { #{{{ my $page=shift; return (stat($page))[9]; } #}}} sub possibly_foolish_untaint ($) { #{{{ my $tainted=shift; my ($untainted)=$tainted=~/(.*)/; return $untainted; } #}}} 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 readfile ($) { #{{{ my $file=shift; local $/=undef; open (IN, "$file") || error("failed to read $file: $!"); my $ret=; close IN; return $ret; } #}}} sub writefile ($$) { #{{{ my $file=shift; my $content=shift; my $dir=dirname($file); 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 (OUT, ">$file") || error("failed to write $file: $!"); print OUT $content; close OUT; } #}}} sub findlinks ($) { #{{{ my $content=shift; my @links; while ($content =~ /$wiki_link_regexp/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 $noimagelink=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 "?$link" } $bestlink=File::Spec->abs2rel($bestlink, dirname($page)); if (! $noimagelink && isinlinableimage($bestlink)) { return ""; } return "$link"; } #}}} sub linkify ($$) { #{{{ my $content=shift; my $file=shift; $content =~ s/$wiki_link_regexp/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, "$p_trimmed"; } } $content.="

Links: ".join(" ", sort @links)."

\n" if @links; return $content; } #}}} sub indexlink () { #{{{ return "$wikiname/ "; } #}}} 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="$dir/ $pagelink"; } else { $pagelink=$dir; } $path.="../"; } $path=~s/\.\.\/$/index.html/; $pagelink=indexlink()." $pagelink"; my @actions; if (length $cgiurl) { push @actions, "Edit"; push @actions, "RecentChanges"; } if (length $historyurl) { my $url=$historyurl; $url=~s/\[\[\]\]/$pagesources{$page}/g; push @actions, "History"; } $content="\n$title\n\n". "

$pagelink

\n". "@actions\n
\n". $content. "\n\n"; return $content; } #}}} sub render ($) { #{{{ my $file=shift; my $type=pagetype($file); my $content=readfile("$srcdir/$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); writefile("$destdir/".htmlpage($page), $content); $oldpagemtime{$page}=time; $renderedfiles{$page}=htmlpage($page); } else { $links{$file}=[]; writefile("$destdir/$file", $content); $oldpagemtime{$file}=time; $renderedfiles{$file}=$file; } } #}}} sub loadindex () { #{{{ open (IN, "$srcdir/.ikiwiki/index") || return; while () { $_=possibly_foolish_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 () { #{{{ if (! -d "$srcdir/.ikiwiki") { mkdir("$srcdir/.ikiwiki"); } open (OUT, ">$srcdir/.ikiwiki/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 rcs_update () { #{{{ if (-d "$srcdir/.svn") { if (system("svn", "update", "--quiet", $srcdir) != 0) { warn("svn update failed\n"); } } } #}}} sub rcs_commit ($) { #{{{ my $message=shift; if (-d "$srcdir/.svn") { if (system("svn", "commit", "--quiet", "-m", possibly_foolish_untaint($message), $srcdir) != 0) { warn("svn commit failed\n"); } } } #}}} sub rcs_add ($) { #{{{ my $file=shift; if (-d "$srcdir/.svn") { my $parent=dirname($file); while (! -d "$srcdir/$parent/.svn") { $file=$parent; $parent=dirname($file); } if (system("svn", "add", "--quiet", "$srcdir/$file") != 0) { warn("svn add failed\n"); } } } #}}} sub rcs_recentchanges ($) { #{{{ my $num=shift; my @ret; eval q{use Date::Parse}; eval q{use Time::Duration}; if (-d "$srcdir/.svn") { my $info=`LANG=C svn info $srcdir`; my ($svn_url)=$info=~/^URL: (.*)$/m; # FIXME: currently assumes that the wiki is somewhere # under trunk in svn, doesn't support other layouts. my ($svn_base)=$svn_url=~m!(/trunk(?:/.*)?)$!; my $div=qr/^--------------------+$/; my $infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/; my $state='start'; my ($rev, $user, $when, @pages, $message); foreach (`LANG=C svn log -v '$svn_url'`) { chomp; if ($state eq 'start' && /$div/) { $state='header'; } elsif ($state eq 'header' && /$infoline/) { $rev=$1; $user=$2; $when=concise(ago(time - str2time($3))); } elsif ($state eq 'header' && /^\s+[A-Z]\s+\Q$svn_base\E\/(.+)$/) { push @pages, pagename($1) if length $1; } elsif ($state eq 'header' && /^$/) { $state='body'; } elsif ($state eq 'body' && /$div/) { push @ret, { rev => $rev, user => $user, when => $when, message => $message, pages => [@pages] } if @pages; return @ret if @ret >= $num; $state='header'; $message=$rev=$user=$when=undef; @pages=(); } elsif ($state eq 'body') { $message.="$_
\n"; } } } return @ret; } #}}} 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 (/$wiki_file_prune_regexp/) { $File::Find::prune=1; } elsif (! -d $_) { my ($f)=/$wiki_file_regexp/; # 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 ($svn, $rebuild)=@_; eval q{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 @params=($srcdir, $destdir, "--wikiname=$wikiname"); push @params, "--verbose" if $verbose; push @params, "--rebuild" if $rebuild; push @params, "--nosvn" if !$svn; push @params, "--cgi" if $cgi; push @params, "--url=$url" if $url; push @params, "--cgiurl=$cgiurl" if $cgiurl; push @params, "--historyurl=$historyurl" if $historyurl; my $params=join(" ", @params); my $call=''; foreach my $p ($this, $this, @params) { $call.=qq{"$p", }; } $call.="NULL"; my @envsave; push @envsave, qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE HTTP_COOKIE} if $cgi; my $envsave=""; foreach my $var (@envsave) { $envsave.=<<"EOF" if ((s=getenv("$var"))) asprintf(&newenviron[i++], "%s=%s", "$var", s); EOF } open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");; print OUT <<"EOF"; /* A wrapper for ikiwiki, can be safely made suid. */ #define _GNU_SOURCE #include #include #include #include extern char **environ; int main (int argc, char **argv) { /* Sanitize environment. */ char *s; char *newenviron[$#envsave+3]; int i=0; $envsave newenviron[i++]="HOME=$ENV{HOME}"; newenviron[i]=NULL; environ=newenviron; if (argc == 2 && strcmp(argv[1], "--params") == 0) { printf("$params\\n"); exit(0); } execl($call); 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 cgi_recentchanges ($) { #{{{ my $q=shift; my $list="
    \n"; foreach my $change (rcs_recentchanges(100)) { $list.="
  • "; $list.=join(", ", map { htmllink("", $_, 1) } @{$change->{pages}}); $list.="
    \n"; $list.="changed ".$change->{when}." by ". htmllink("", $change->{user}, 1). ": ".$change->{message}."\n"; $list.="
  • \n"; } $list.="
\n"; print $q->header, $q->start_html("RecentChanges"), $q->h1(indexlink()." RecentChanges"), $list, $q->end_form, $q->end_html; } #}}} sub cgi_signin ($$) { #{{{ my $q=shift; my $session=shift; eval q{use CGI::FormBuilder}; my $form = CGI::FormBuilder->new( title => "$wikiname signin", fields => [qw(do page name password confirm_password email)], header => 1, method => 'POST', validate => { name => '/^\w+$/', confirm_password => { perl => q{eq $form->field("password")}, }, email => 'EMAIL', }, required => 'NONE', javascript => 0, params => $q, action => $q->request_uri, ); $form->sessionid($session->id); $form->field(name => "name", required => 0); $form->field(name => "do", type => "hidden"); $form->field(name => "page", type => "hidden"); $form->field(name => "password", type => "password", required => 0); $form->field(name => "confirm_password", type => "password", required => 0); $form->field(name => "email", required => 0); if ($session->param("name")) { $form->field(name => "name", value => $session->param("name")); } if ($q->param("do") ne "signin") { $form->text("You need to log in before you can edit pages."); } if ($form->submitted) { # Set required fields based on how form was submitted. my %required=( "Login" => [qw(name password)], "Register" => [qw(name password confirm_password email)], "Mail Password" => [qw(name)], ); foreach my $opt (@{$required{$form->submitted}}) { $form->field(name => $opt, required => 1); } # Validate password differently depending on how form was # submitted. if ($form->submitted eq 'Login') { $form->field( name => "password", validate => sub { # TODO get real user password shift eq "foo"; }, ); } else { $form->field(name => "password", validate => 'VALUE'); } } else { # Comments only shown first time. $form->field(name => "name", comment => "use FirstnameLastName"); $form->field(name => "confirm_password", comment => "(only needed"); $form->field(name => "email", comment => "for registration)"); } if ($form->submitted && $form->validate) { if ($form->submitted eq 'Login') { $session->param("name", $form->field("name")); if (defined $form->field("do")) { $q->redirect( "$cgiurl?do=".$form->field("do"). "&page=".$form->field("page")); } else { $q->redirect($url); } } elsif ($form->submitted eq 'Register') { # TODO: save registration info $form->field(name => "confirm_password", type => "hidden"); $form->field(name => "email", type => "hidden"); $form->text("Registration successful. Now you can Login."); print $form->render(submit => ["Login"]);; } elsif ($form->submitted eq 'Mail Password') { # TODO mail password $form->text("Your password has been emailed to you."); print $form->render(submit => ["Login", "Register", "Mail Password"]);; } } else { print $form->render(submit => ["Login", "Register", "Mail Password"]);; } } #}}} sub cgi () { #{{{ eval q{use CGI}; eval q{use CGI::Session}; my $q=CGI->new; # session id has to be _sessionid for CGI::FormBuilder to work. # TODO: stop having the formbuilder emit cookies and change session # id to something else. CGI::Session->name("_sessionid"); my $session = CGI::Session->new(undef, $q, { Directory=> "$srcdir/.ikiwiki/sessions" }); my $do=$q->param('do'); if (! defined $do || ! length $do) { error("\"do\" parameter missing"); } if ($do eq 'recentchanges') { cgi_recentchanges($q); return; } if (! defined $session->param("name") || $do eq 'signin') { cgi_signin($q, $session); return; } my ($page)=$q->param('page')=~/$wiki_file_regexp/; if (! defined $page || ! length $page || $page ne $q->param('page') || $page=~/$wiki_file_prune_regexp/ || $page=~/^\//) { error("bad page name"); } $page=lc($page); my $action=$q->request_uri; $action=~s/\?.*//; if ($do eq 'create') { if (exists $pagesources{lc($page)}) { # hmm, someone else made the page in the meantime? print $q->redirect("$url/".htmlpage($page)); } my @page_locs; my ($from)=$q->param('from')=~/$wiki_file_regexp/; if (! defined $from || ! length $from || $from ne $q->param('from') || $from=~/$wiki_file_prune_regexp/ || $from=~/^\//) { @page_locs=$page; } else { my $dir=$from."/"; $dir=~s![^/]+/$!!; push @page_locs, $dir.$page; push @page_locs, "$from/$page"; while (length $dir) { $dir=~s![^/]+/$!!; push @page_locs, $dir.$page; } } $q->param("do", "save"); print $q->header, $q->start_html("Creating $page"), $q->h1(indexlink()." Creating $page"), $q->start_form(-action => $action), $q->hidden('do'), "Select page location:", $q->popup_menu('page', \@page_locs), $q->textarea(-name => 'content', -default => "", -rows => 20, -columns => 80), $q->br, "Optional comment about this change:", $q->br, $q->textfield(-name => "comments", -size => 80), $q->br, $q->submit("Save Page"), $q->end_form, $q->end_html; } elsif ($do eq 'edit') { my $content=""; if (exists $pagesources{lc($page)}) { $content=readfile("$srcdir/$pagesources{lc($page)}"); $content=~s/\n/\r\n/g; } $q->param("do", "save"); print $q->header, $q->start_html("Editing $page"), $q->h1(indexlink()." Editing $page"), $q->start_form(-action => $action), $q->hidden('do'), $q->hidden('page'), $q->textarea(-name => 'content', -default => $content, -rows => 20, -columns => 80), $q->br, "Optional comment about this change:", $q->br, $q->textfield(-name => "comments", -size => 80), $q->br, $q->submit("Save Page"), $q->end_form, $q->end_html; } elsif ($do eq 'save') { my $file=$page.$default_pagetype; my $newfile=1; if (exists $pagesources{lc($page)}) { $file=$pagesources{lc($page)}; $newfile=0; } my $content=$q->param('content'); $content=~s/\r\n/\n/g; $content=~s/\r/\n/g; writefile("$srcdir/$file", $content); my $message="web commit from $ENV{REMOTE_ADDR}"; if (defined $q->param('comments')) { $message.=": ".$q->param('comments'); } if ($svn) { if ($newfile) { rcs_add($file); } # presumably the commit will trigger an update # of the wiki rcs_commit($message); } else { refresh(); } print $q->redirect("$url/".htmlpage($page)); } else { error("unknown do parameter"); } } #}}} # main {{{ my $rebuild=0; my $wrapper=0; if (grep /^-/, @ARGV) { eval {use Getopt::Long}; GetOptions( "wikiname=s" => \$wikiname, "verbose|v" => \$verbose, "rebuild" => \$rebuild, "wrapper" => \$wrapper, "svn!" => \$svn, "cgi" => \$cgi, "url=s" => \$url, "cgiurl=s" => \$cgiurl, "historyurl=s" => \$historyurl, ) || usage(); } usage() unless @ARGV == 2; ($srcdir) = possibly_foolish_untaint(shift); ($destdir) = possibly_foolish_untaint(shift); if ($cgi && ! length $url) { error("Must specify url to wiki with --url when using --cgi"); } gen_wrapper($svn, $rebuild) if $wrapper; memoize('pagename'); memoize('bestlink'); loadindex() unless $rebuild; if ($cgi) { cgi(); } else { rcs_update() if $svn; refresh(); saveindex(); } #}}}