11 $blosxom::version="is a proper perl module too much to ask?";
12 do "/usr/bin/markdown";
15 $ENV{PATH}="/usr/local/bin:/usr/bin:/bin";
16 my ($srcdir, $templatedir, $destdir, %links, %oldlinks, %oldpagemtime,
17 %renderedfiles, %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/|\.\.|^\.|\/\.|\.html?$)!;
23 my $default_pagetype=".mdwn";
32 die "usage: ikiwiki [options] source templates dest\n";
37 print "Content-type: text/html\n\n";
38 print misctemplate("Error", "<p>Error: @_</p>");
48 print "@_\n" if $verbose;
51 print STDERR "@_\n" if $verbose;
58 return (stat($page))[9];
61 sub possibly_foolish_untaint ($) { #{{{
63 my ($untainted)=$tainted=~/(.*)/;
67 sub basename ($) { #{{{
74 sub dirname ($) { #{{{
81 sub pagetype ($) { #{{{
84 if ($page =~ /\.mdwn$/) {
92 sub pagename ($) { #{{{
95 my $type=pagetype($file);
97 $page=~s/\Q$type\E*$// unless $type eq 'unknown';
101 sub htmlpage ($) { #{{{
104 return $page.".html";
107 sub readfile ($) { #{{{
111 open (IN, "$file") || error("failed to read $file: $!");
117 sub writefile ($$) { #{{{
121 my $dir=dirname($file);
124 foreach my $s (split(m!/+!, $dir)) {
127 mkdir($d) || error("failed to create directory $d: $!");
132 open (OUT, ">$file") || error("failed to write $file: $!");
137 sub findlinks ($) { #{{{
141 while ($content =~ /$wiki_link_regexp/g) {
147 # Given a page and the text of a link on the page, determine which existing
148 # page that link best points to. Prefers pages under a subdirectory with
149 # the same name as the source page, failing that goes down the directory tree
150 # to the base looking for matching pages.
151 sub bestlink ($$) { #{{{
158 $l.="/" if length $l;
161 if (exists $links{$l}) {
162 #debug("for $page, \"$link\", use $l");
165 } while $cwd=~s!/?[^/]+$!!;
167 #print STDERR "warning: page $page, broken link: $link\n";
171 sub isinlinableimage ($) { #{{{
174 $file=~/\.(png|gif|jpg|jpeg)$/;
180 my $noimagelink=shift;
182 my $bestlink=bestlink($page, $link);
184 return $link if $page eq $bestlink;
186 # TODO BUG: %renderedfiles may not have it, if the linked to page
187 # was also added and isn't yet rendered! Note that this bug is
188 # masked by the bug mentioned below that makes all new files
190 if (! grep { $_ eq $bestlink } values %renderedfiles) {
191 $bestlink=htmlpage($bestlink);
193 if (! grep { $_ eq $bestlink } values %renderedfiles) {
194 return "<a href=\"$cgiurl?do=create&page=$link&from=$page\">?</a>$link"
197 $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
199 if (! $noimagelink && isinlinableimage($bestlink)) {
200 return "<img src=\"$bestlink\">";
202 return "<a href=\"$bestlink\">$link</a>";
205 sub linkify ($$) { #{{{
209 $content =~ s/$wiki_link_regexp/htmllink(pagename($file), $1)/eg;
214 sub htmlize ($$) { #{{{
218 if ($type eq '.mdwn') {
219 return Markdown::Markdown($content);
222 error("htmlization of $type not supported");
226 sub backlinks ($) { #{{{
230 foreach my $p (keys %links) {
231 next if bestlink($page, $p) eq $page;
232 if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
233 my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
235 # Trim common dir prefixes from both pages.
237 my $page_trimmed=$page;
239 1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
241 $p_trimmed=~s/^\Q$dir\E// &&
242 $page_trimmed=~s/^\Q$dir\E//;
244 push @links, { url => $href, page => $p_trimmed };
248 return sort { $a->{page} cmp $b->{page} } @links;
251 sub parentlinks ($) { #{{{
258 foreach my $dir (reverse split("/", $page)) {
260 unshift @ret, { url => "$path$dir.html", page => $dir };
267 unshift @ret, { url => $path , page => $wikiname };
271 sub indexlink () { #{{{
272 return "<a href=\"$url\">$wikiname</a>";
275 sub finalize ($$) { #{{{
279 my $title=basename($page);
282 my $template=HTML::Template->new(blind_cache => 1,
283 filename => "$templatedir/page.tmpl");
285 if (length $cgiurl) {
286 $template->param(editurl => "$cgiurl?do=edit&page=$page");
288 $template->param(recentchangesurl => "$cgiurl?do=recentchanges");
292 if (length $historyurl) {
294 $u=~s/\[\[\]\]/$pagesources{$page}/g;
295 $template->param(historyurl => $u);
300 wikiname => $wikiname,
301 parentlinks => [parentlinks($page)],
303 backlinks => [backlinks($page)],
306 return $template->output;
309 # Important security check. Make sure to call this before saving any files
310 # to the source directory.
311 sub check_overwrite ($$) { #{{{
315 if (! exists $renderedfiles{$src} && -e $dest) {
316 error("$dest exists and was not rendered from $src before, not overwriting");
320 sub render ($) { #{{{
323 my $type=pagetype($file);
324 my $content=readfile("$srcdir/$file");
325 if ($type ne 'unknown') {
326 my $page=pagename($file);
328 $links{$page}=[findlinks($content)];
330 $content=linkify($content, $file);
331 $content=htmlize($type, $content);
332 $content=finalize($content, $page);
334 check_overwrite("$destdir/".htmlpage($page), $page);
335 writefile("$destdir/".htmlpage($page), $content);
336 $oldpagemtime{$page}=time;
337 $renderedfiles{$page}=htmlpage($page);
341 check_overwrite("$destdir/$file", $file);
342 writefile("$destdir/$file", $content);
343 $oldpagemtime{$file}=time;
344 $renderedfiles{$file}=$file;
348 sub loadindex () { #{{{
349 open (IN, "$srcdir/.ikiwiki/index") || return;
351 $_=possibly_foolish_untaint($_);
353 my ($mtime, $file, $rendered, @links)=split(' ', $_);
354 my $page=pagename($file);
355 $pagesources{$page}=$file;
356 $oldpagemtime{$page}=$mtime;
357 $oldlinks{$page}=[@links];
358 $links{$page}=[@links];
359 $renderedfiles{$page}=$rendered;
364 sub saveindex () { #{{{
365 if (! -d "$srcdir/.ikiwiki") {
366 mkdir("$srcdir/.ikiwiki");
368 open (OUT, ">$srcdir/.ikiwiki/index") || error("cannot write to index: $!");
369 foreach my $page (keys %oldpagemtime) {
370 print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
371 join(" ", @{$links{$page}})."\n"
372 if $oldpagemtime{$page};
377 sub rcs_update () { #{{{
378 if (-d "$srcdir/.svn") {
379 if (system("svn", "update", "--quiet", $srcdir) != 0) {
380 warn("svn update failed\n");
385 sub rcs_commit ($) { #{{{
388 if (-d "$srcdir/.svn") {
389 if (system("svn", "commit", "--quiet", "-m",
390 possibly_foolish_untaint($message), $srcdir) != 0) {
391 warn("svn commit failed\n");
396 sub rcs_add ($) { #{{{
399 if (-d "$srcdir/.svn") {
400 my $parent=dirname($file);
401 while (! -d "$srcdir/$parent/.svn") {
403 $parent=dirname($file);
406 if (system("svn", "add", "--quiet", "$srcdir/$file") != 0) {
407 warn("svn add failed\n");
412 sub rcs_recentchanges ($) { #{{{
416 eval q{use Date::Parse};
417 eval q{use Time::Duration};
419 if (-d "$srcdir/.svn") {
420 my $info=`LANG=C svn info $srcdir`;
421 my ($svn_url)=$info=~/^URL: (.*)$/m;
423 # FIXME: currently assumes that the wiki is somewhere
424 # under trunk in svn, doesn't support other layouts.
425 my ($svn_base)=$svn_url=~m!(/trunk(?:/.*)?)$!;
427 my $div=qr/^--------------------+$/;
428 my $infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
430 my ($rev, $user, $when, @pages, @message);
431 foreach (`LANG=C svn log -v '$svn_url'`) {
433 if ($state eq 'start' && /$div/) {
436 elsif ($state eq 'header' && /$infoline/) {
439 $when=concise(ago(time - str2time($3)));
441 elsif ($state eq 'header' && /^\s+[A-Z]\s+\Q$svn_base\E\/(.+)$/) {
442 push @pages, { link => htmllink("", pagename($1), 1) }
445 elsif ($state eq 'header' && /^$/) {
448 elsif ($state eq 'body' && /$div/) {
449 push @ret, { rev => $rev, user => $user,
450 when => $when, message => [@message],
451 pages => [@pages] } if @pages;
452 return @ret if @ret >= $num;
455 $rev=$user=$when=undef;
458 elsif ($state eq 'body') {
459 push @message, {line => $_},
471 my $dir=dirname($file);
472 while (rmdir($dir)) {
477 sub refresh () { #{{{
478 # Find existing pages.
484 if (/$wiki_file_prune_regexp/) {
485 $File::Find::prune=1;
488 my ($f)=/$wiki_file_regexp/; # untaint
490 warn("skipping bad filename $_\n");
493 $f=~s/^\Q$srcdir\E\/?//;
495 $exists{pagename($f)}=1;
503 # check for added or removed pages
505 foreach my $file (@files) {
506 my $page=pagename($file);
507 if (! $oldpagemtime{$page}) {
508 debug("new page $page");
511 $pagesources{$page}=$file;
515 foreach my $page (keys %oldpagemtime) {
516 if (! $exists{$page}) {
517 debug("removing old page $page");
518 push @del, $renderedfiles{$page};
519 prune($destdir."/".$renderedfiles{$page});
520 delete $renderedfiles{$page};
521 $oldpagemtime{$page}=0;
522 delete $pagesources{$page};
526 # render any updated files
527 foreach my $file (@files) {
528 my $page=pagename($file);
530 if (! exists $oldpagemtime{$page} ||
531 mtime("$srcdir/$file") > $oldpagemtime{$page}) {
532 debug("rendering changed file $file");
538 # if any files were added or removed, check to see if each page
539 # needs an update due to linking to them
540 # TODO: inefficient; pages may get rendered above and again here;
541 # problem is the bestlink may have changed and we won't know until
544 FILE: foreach my $file (@files) {
545 my $page=pagename($file);
546 foreach my $f (@add, @del) {
548 foreach my $link (@{$links{$page}}) {
549 if (bestlink($page, $link) eq $p) {
550 debug("rendering $file, which links to $p");
560 # handle backlinks; if a page has added/removed links, update the
562 # TODO: inefficient; pages may get rendered above and again here;
563 # problem is the backlinks could be wrong in the first pass render
567 foreach my $file (keys %rendered, @del) {
568 my $page=pagename($file);
569 if (exists $links{$page}) {
570 foreach my $link (@{$links{$page}}) {
571 $link=bestlink($page, $link);
573 ! exists $oldlinks{$page} ||
574 ! grep { $_ eq $link } @{$oldlinks{$page}}) {
575 $linkchanged{$link}=1;
579 if (exists $oldlinks{$page}) {
580 foreach my $link (@{$oldlinks{$page}}) {
581 $link=bestlink($page, $link);
583 ! exists $links{$page} ||
584 ! grep { $_ eq $link } @{$links{$page}}) {
585 $linkchanged{$link}=1;
590 foreach my $link (keys %linkchanged) {
591 my $linkfile=$pagesources{$link};
592 if (defined $linkfile) {
593 debug("rendering $linkfile, to update its backlinks");
600 # Generates a C wrapper program for running ikiwiki in a specific way.
601 # The wrapper may be safely made suid.
602 sub gen_wrapper ($$) { #{{{
603 my ($svn, $rebuild)=@_;
605 eval q{use Cwd 'abs_path'};
606 $srcdir=abs_path($srcdir);
607 $destdir=abs_path($destdir);
608 my $this=abs_path($0);
610 error("$this doesn't seem to be executable");
613 my @params=($srcdir, $templatedir, $destdir, "--wikiname=$wikiname");
614 push @params, "--verbose" if $verbose;
615 push @params, "--rebuild" if $rebuild;
616 push @params, "--nosvn" if !$svn;
617 push @params, "--cgi" if $cgi;
618 push @params, "--url=$url" if $url;
619 push @params, "--cgiurl=$cgiurl" if $cgiurl;
620 push @params, "--historyurl=$historyurl" if $historyurl;
621 push @params, "--anonok" if $anonok;
622 my $params=join(" ", @params);
624 foreach my $p ($this, $this, @params) {
630 push @envsave, qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI
631 CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE
632 HTTP_COOKIE} if $cgi;
634 foreach my $var (@envsave) {
636 if ((s=getenv("$var")))
637 asprintf(&newenviron[i++], "%s=%s", "$var", s);
641 open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
643 /* A wrapper for ikiwiki, can be safely made suid. */
650 extern char **environ;
652 int main (int argc, char **argv) {
653 /* Sanitize environment. */
655 char *newenviron[$#envsave+3];
658 newenviron[i++]="HOME=$ENV{HOME}";
662 if (argc == 2 && strcmp(argv[1], "--params") == 0) {
663 printf("$params\\n");
668 perror("failed to run $this");
673 if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
674 error("failed to compile ikiwiki-wrap.c");
676 unlink("ikiwiki-wrap.c");
677 print "successfully generated ikiwiki-wrap\n";
681 sub misctemplate ($$) { #{{{
685 my $template=HTML::Template->new(
686 filename => "$templatedir/misc.tmpl"
690 indexlink => indexlink(),
691 wikiname => $wikiname,
692 pagebody => $pagebody,
694 return $template->output;
697 sub cgi_recentchanges ($) { #{{{
700 my $template=HTML::Template->new(
701 filename => "$templatedir/recentchanges.tmpl"
704 title => "RecentChanges",
705 indexlink => indexlink(),
706 wikiname => $wikiname,
707 changelog => [rcs_recentchanges(100)],
709 print $q->header, $template->output;
712 sub userinfo_get ($$) { #{{
716 eval q{use Storable};
717 my $userdata=eval{ Storable::lock_retrieve("$srcdir/.ikiwiki/userdb") };
718 if (! defined $userdata || ! ref $userdata ||
719 ! exists $userdata->{$user} || ! ref $userdata->{$user}) {
722 return $userdata->{$user}->{$field};
725 sub userinfo_set ($$) { #{{
729 eval q{use Storable};
730 my $userdata=eval{ Storable::lock_retrieve("$srcdir/.ikiwiki/userdb") };
731 if (! defined $userdata || ! ref $userdata) {
734 $userdata->{$user}=$info;
735 my $oldmask=umask(077);
736 my $ret=Storable::lock_store($userdata, "$srcdir/.ikiwiki/userdb");
741 sub cgi_signin ($$) { #{{{
745 eval q{use CGI::FormBuilder};
746 my $form = CGI::FormBuilder->new(
747 title => "$wikiname signin",
748 fields => [qw(do page name password confirm_password email)],
752 confirm_password => {
753 perl => q{eq $form->field("password")},
760 action => $q->request_uri,
762 template => (-e "$templatedir/signin.tmpl" ? "$templatedir/signin.tmpl" : "")
765 $form->field(name => "name", required => 0);
766 $form->field(name => "do", type => "hidden");
767 $form->field(name => "page", type => "hidden");
768 $form->field(name => "password", type => "password", required => 0);
769 $form->field(name => "confirm_password", type => "password", required => 0);
770 $form->field(name => "email", required => 0);
771 if ($q->param("do") ne "signin") {
772 $form->text("You need to log in before you can edit pages.");
775 if ($form->submitted) {
776 # Set required fields based on how form was submitted.
778 "Login" => [qw(name password)],
779 "Register" => [qw(name password confirm_password email)],
780 "Mail Password" => [qw(name)],
782 foreach my $opt (@{$required{$form->submitted}}) {
783 $form->field(name => $opt, required => 1);
786 # Validate password differently depending on how
787 # form was submitted.
788 if ($form->submitted eq 'Login') {
792 length $form->field("name") &&
793 shift eq userinfo_get($form->field("name"), 'password');
796 $form->field(name => "name", validate => '/^\w+$/');
799 $form->field(name => "password", validate => 'VALUE');
801 # And make sure the entered name exists when logging
802 # in or sending email, and does not when registering.
803 if ($form->submitted eq 'Register') {
809 ! userinfo_get($name, "regdate");
819 userinfo_get($name, "regdate");
825 # First time settings.
826 $form->field(name => "name", comment => "use FirstnameLastName");
827 $form->field(name => "confirm_password", comment => "(only needed");
828 $form->field(name => "email", comment => "for registration)");
829 if ($session->param("name")) {
830 $form->field(name => "name", value => $session->param("name"));
834 if ($form->submitted && $form->validate) {
835 if ($form->submitted eq 'Login') {
836 $session->param("name", $form->field("name"));
837 if (defined $form->field("do") &&
838 $form->field("do") ne 'signin') {
840 "$cgiurl?do=".$form->field("do").
841 "&page=".$form->field("page"));
844 print $q->redirect($url);
847 elsif ($form->submitted eq 'Register') {
848 my $user_name=$form->field('name');
849 if (userinfo_set($user_name, {
850 'email' => $form->field('email'),
851 'password' => $form->field('password'),
854 $form->field(name => "confirm_password", type => "hidden");
855 $form->field(name => "email", type => "hidden");
856 $form->text("Registration successful. Now you can Login.");
857 print $session->header();
858 print misctemplate($form->title, $form->render(submit => ["Login"]));
861 error("Error saving registration.");
864 elsif ($form->submitted eq 'Mail Password') {
865 my $user_name=$form->field("name");
866 my $template=HTML::Template->new(
867 filename => "$templatedir/passwordmail.tmpl"
870 user_name => $user_name,
871 user_password => userinfo_get($user_name, "password"),
873 wikiname => $wikiname,
874 REMOTE_ADDR => $ENV{REMOTE_ADDR},
877 eval q{use Mail::Sendmail};
878 my ($fromhost) = $cgiurl =~ m!/([^/]+)!;
879 print STDERR "$< $> >>> $cgiurl ".(getpwuid($>))[0]."@".$fromhost."\n";
881 To => userinfo_get($user_name, "email"),
882 From => "$wikiname admin <".(getpwuid($>))[0]."@".$fromhost.">",
883 Subject => "$wikiname information",
884 Message => $template->output,
885 ) or error("Failed to send mail");
887 $form->text("Your password has been emailed to you.");
888 $form->field(name => "name", required => 0);
889 print $session->header();
890 print misctemplate($form->title, $form->render(submit => ["Login", "Register", "Mail Password"]));
894 print $session->header();
895 print misctemplate($form->title, $form->render(submit => ["Login", "Register", "Mail Password"]));
899 sub cgi_editpage ($$) { #{{{
903 eval q{use CGI::FormBuilder};
904 my $form = CGI::FormBuilder->new(
905 fields => [qw(do from page content comments)],
912 action => $q->request_uri,
914 template => "$templatedir/editpage.tmpl"
917 my ($page)=$form->param('page')=~/$wiki_file_regexp/;
918 if (! defined $page || ! length $page || $page ne $q->param('page') ||
919 $page=~/$wiki_file_prune_regexp/ || $page=~/^\//) {
920 error("bad page name");
924 $form->field(name => "do", type => 'hidden');
925 $form->field(name => "from", type => 'hidden');
926 $form->field(name => "page", value => "$page", force => 1);
927 $form->field(name => "comments", type => "text", size => 80);
928 $form->field(name => "content", type => "textarea", rows => 20,
931 if (! $form->submitted || ! $form->validate) {
932 if ($form->field("do") eq "create") {
933 if (exists $pagesources{lc($page)}) {
934 # hmm, someone else made the page in the
936 print $q->redirect("$url/".htmlpage($page));
941 my ($from)=$form->param('from')=~/$wiki_file_regexp/;
942 if (! defined $from || ! length $from ||
943 $from ne $form->param('from') ||
944 $from=~/$wiki_file_prune_regexp/ || $from=~/^\//) {
950 push @page_locs, $dir.$page;
951 push @page_locs, "$from/$page";
952 while (length $dir) {
954 push @page_locs, $dir.$page;
958 $form->tmpl_param("page_select", 1);
959 $form->field(name => "page", type => 'select',
960 options => \@page_locs);
961 $form->title("creating $page");
963 elsif ($form->field("do") eq "edit") {
965 if (exists $pagesources{lc($page)}) {
966 $content=readfile("$srcdir/$pagesources{lc($page)}");
967 $content=~s/\n/\r\n/g;
969 $form->tmpl_param("page_select", 0);
970 $form->field(name => "content", value => $content,
972 $form->field(name => "page", type => 'hidden');
973 $form->title("editing $page");
976 $form->tmpl_param("can_commit", $svn);
977 $form->tmpl_param("indexlink", indexlink());
978 print $form->render(submit => ["Save Page"]);
982 my $file=$page.$default_pagetype;
984 if (exists $pagesources{lc($page)}) {
985 $file=$pagesources{lc($page)};
989 my $content=$form->field('content');
990 $content=~s/\r\n/\n/g;
992 writefile("$srcdir/$file", $content);
994 my $message="web commit ";
995 if ($session->param("name")) {
996 $message.="by ".$session->param("name");
999 $message.="from $ENV{REMOTE_ADDR}";
1001 if (defined $form->field('comments') &&
1002 length $form->field('comments')) {
1003 $message.=": ".$form->field('comments');
1010 # presumably the commit will trigger an update
1012 rcs_commit($message);
1018 print $q->redirect("$url/".htmlpage($page));
1024 eval q{use CGI::Session};
1028 my $do=$q->param('do');
1029 if (! defined $do || ! length $do) {
1030 error("\"do\" parameter missing");
1033 # This does not need a session.
1034 if ($do eq 'recentchanges') {
1035 cgi_recentchanges($q);
1039 CGI::Session->name("ikiwiki_session");
1041 my $oldmask=umask(077);
1042 my $session = CGI::Session->new("driver:db_file", $q,
1043 { FileName => "$srcdir/.ikiwiki/sessions.db" });
1046 # Everything below this point needs the user to be signed in.
1047 if ((! $anonok && ! defined $session->param("name") ||
1048 ! userinfo_get($session->param("name"), "regdate")) || $do eq 'signin') {
1049 cgi_signin($q, $session);
1051 # Force session flush with safe umask.
1052 my $oldmask=umask(077);
1059 if ($do eq 'create' || $do eq 'edit') {
1060 cgi_editpage($q, $session);
1063 error("unknown do parameter");
1070 if (grep /^-/, @ARGV) {
1071 eval {use Getopt::Long};
1073 "wikiname=s" => \$wikiname,
1074 "verbose|v" => \$verbose,
1075 "rebuild" => \$rebuild,
1076 "wrapper" => \$wrapper,
1078 "anonok!" => \$anonok,
1081 "cgiurl=s" => \$cgiurl,
1082 "historyurl=s" => \$historyurl,
1085 usage() unless @ARGV == 3;
1086 ($srcdir) = possibly_foolish_untaint(shift);
1087 ($templatedir) = possibly_foolish_untaint(shift);
1088 ($destdir) = possibly_foolish_untaint(shift);
1090 if ($cgi && ! length $url) {
1091 error("Must specify url to wiki with --url when using --cgi");
1094 gen_wrapper($svn, $rebuild) if $wrapper;
1095 memoize('pagename');
1096 memoize('bestlink');
1097 loadindex() unless $rebuild;
1102 rcs_update() if $svn;