improve message
[ikiwiki] / 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 use HTML::Template;
9
10 BEGIN {
11         $blosxom::version="is a proper perl module too much to ask?";
12         do "/usr/bin/markdown";
13 }
14
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?$)!;
21 my $verbose=0;
22 my $wikiname="wiki";
23 my $default_pagetype=".mdwn";
24 my $cgi=0;
25 my $url="";
26 my $cgiurl="";
27 my $historyurl="";
28 my $svn=1;
29 my $anonok=0;
30
31 sub usage { #{{{
32         die "usage: ikiwiki [options] source templates dest\n";
33 } #}}}
34
35 sub error ($) { #{{{
36         if ($cgi) {
37                 print "Content-type: text/html\n\n";
38                 print "Error: @_\n";
39                 exit 1;
40         }
41         else {
42                 die @_;
43         }
44 } #}}}
45
46 sub debug ($) { #{{{
47         print "@_\n" if $verbose;
48 } #}}}
49
50 sub mtime ($) { #{{{
51         my $page=shift;
52         
53         return (stat($page))[9];
54 } #}}}
55
56 sub possibly_foolish_untaint ($) { #{{{
57         my $tainted=shift;
58         my ($untainted)=$tainted=~/(.*)/;
59         return $untainted;
60 } #}}}
61
62 sub basename ($) { #{{{
63         my $file=shift;
64
65         $file=~s!.*/!!;
66         return $file;
67 } #}}}
68
69 sub dirname ($) { #{{{
70         my $file=shift;
71
72         $file=~s!/?[^/]+$!!;
73         return $file;
74 } #}}}
75
76 sub pagetype ($) { #{{{
77         my $page=shift;
78         
79         if ($page =~ /\.mdwn$/) {
80                 return ".mdwn";
81         }
82         else {
83                 return "unknown";
84         }
85 } #}}}
86
87 sub pagename ($) { #{{{
88         my $file=shift;
89
90         my $type=pagetype($file);
91         my $page=$file;
92         $page=~s/\Q$type\E*$// unless $type eq 'unknown';
93         return $page;
94 } #}}}
95
96 sub htmlpage ($) { #{{{
97         my $page=shift;
98
99         return $page.".html";
100 } #}}}
101
102 sub readfile ($) { #{{{
103         my $file=shift;
104
105         local $/=undef;
106         open (IN, "$file") || error("failed to read $file: $!");
107         my $ret=<IN>;
108         close IN;
109         return $ret;
110 } #}}}
111
112 sub writefile ($$) { #{{{
113         my $file=shift;
114         my $content=shift;
115
116         my $dir=dirname($file);
117         if (! -d $dir) {
118                 my $d="";
119                 foreach my $s (split(m!/+!, $dir)) {
120                         $d.="$s/";
121                         if (! -d $d) {
122                                 mkdir($d) || error("failed to create directory $d: $!");
123                         }
124                 }
125         }
126         
127         open (OUT, ">$file") || error("failed to write $file: $!");
128         print OUT $content;
129         close OUT;
130 } #}}}
131
132 sub findlinks ($) { #{{{
133         my $content=shift;
134
135         my @links;
136         while ($content =~ /$wiki_link_regexp/g) {
137                 push @links, lc($1);
138         }
139         return @links;
140 } #}}}
141
142 # Given a page and the text of a link on the page, determine which existing
143 # page that link best points to. Prefers pages under a subdirectory with
144 # the same name as the source page, failing that goes down the directory tree
145 # to the base looking for matching pages.
146 sub bestlink ($$) { #{{{
147         my $page=shift;
148         my $link=lc(shift);
149         
150         my $cwd=$page;
151         do {
152                 my $l=$cwd;
153                 $l.="/" if length $l;
154                 $l.=$link;
155
156                 if (exists $links{$l}) {
157                         #debug("for $page, \"$link\", use $l");
158                         return $l;
159                 }
160         } while $cwd=~s!/?[^/]+$!!;
161
162         #print STDERR "warning: page $page, broken link: $link\n";
163         return "";
164 } #}}}
165
166 sub isinlinableimage ($) { #{{{
167         my $file=shift;
168         
169         $file=~/\.(png|gif|jpg|jpeg)$/;
170 } #}}}
171
172 sub htmllink { #{{{
173         my $page=shift;
174         my $link=shift;
175         my $noimagelink=shift;
176
177         my $bestlink=bestlink($page, $link);
178
179         return $link if $page eq $bestlink;
180         
181         # TODO BUG: %renderedfiles may not have it, if the linked to page
182         # was also added and isn't yet rendered! Note that this bug is
183         # masked by the bug mentioned below that makes all new files
184         # be rendered twice.
185         if (! grep { $_ eq $bestlink } values %renderedfiles) {
186                 $bestlink=htmlpage($bestlink);
187         }
188         if (! grep { $_ eq $bestlink } values %renderedfiles) {
189                 return "<a href=\"$cgiurl?do=create&page=$link&from=$page\">?</a>$link"
190         }
191         
192         $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
193         
194         if (! $noimagelink && isinlinableimage($bestlink)) {
195                 return "<img src=\"$bestlink\">";
196         }
197         return "<a href=\"$bestlink\">$link</a>";
198 } #}}}
199
200 sub linkify ($$) { #{{{
201         my $content=shift;
202         my $file=shift;
203
204         $content =~ s/$wiki_link_regexp/htmllink(pagename($file), $1)/eg;
205         
206         return $content;
207 } #}}}
208
209 sub htmlize ($$) { #{{{
210         my $type=shift;
211         my $content=shift;
212         
213         if ($type eq '.mdwn') {
214                 return Markdown::Markdown($content);
215         }
216         else {
217                 error("htmlization of $type not supported");
218         }
219 } #}}}
220
221 sub backlinks ($) { #{{{
222         my $page=shift;
223
224         my @links;
225         foreach my $p (keys %links) {
226                 next if bestlink($page, $p) eq $page;
227                 if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
228                         my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
229                         
230                         # Trim common dir prefixes from both pages.
231                         my $p_trimmed=$p;
232                         my $page_trimmed=$page;
233                         my $dir;
234                         1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
235                                 defined $dir &&
236                                 $p_trimmed=~s/^\Q$dir\E// &&
237                                 $page_trimmed=~s/^\Q$dir\E//;
238                                        
239                         push @links, { url => $href, page => $p_trimmed };
240                 }
241         }
242
243         return @links;
244 } #}}}
245         
246 sub parentlinks ($) { #{{{
247         my $page=shift;
248         
249         my @ret;
250         my $pagelink="";
251         my $path="";
252         my $skip=1;
253         foreach my $dir (reverse split("/", $page)) {
254                 if (! $skip) {
255                         unshift @ret, { url => "$path$dir.html", page => $dir };
256                 }
257                 else {
258                         $skip=0;
259                 }
260                 $path.="../";
261         }
262         return @ret;
263 } #}}}
264
265 sub indexlink () { #{{{
266         return "<a href=\"$url\">$wikiname</a>/ ";
267 } #}}}
268         
269 sub finalize ($$) { #{{{
270         my $content=shift;
271         my $page=shift;
272
273         my $title=basename($page);
274         $title=~s/_/ /g;
275         
276         my $template=HTML::Template->new(blind_cache => 1,
277                 filename => "$templatedir/page.tmpl");
278         
279         if (length $cgiurl) {
280                 $template->param(editurl => "$cgiurl?do=edit&page=$page");
281                 $template->param(recentchangesurl => "$cgiurl?do=recentchanges");
282         }
283
284         if (length $historyurl) {
285                 my $u=$historyurl;
286                 $u=~s/\[\[\]\]/$pagesources{$page}/g;
287                 $template->param(historyurl => $u);
288         }
289         
290         $template->param(
291                 title => $title,
292                 indexlink => $url,
293                 wikiname => $wikiname,
294                 parentlinks => [parentlinks($page)],
295                 content => $content,
296                 backlinks => [backlinks($page)],
297         );
298         
299         return $template->output;
300 } #}}}
301
302 sub render ($) { #{{{
303         my $file=shift;
304         
305         my $type=pagetype($file);
306         my $content=readfile("$srcdir/$file");
307         if ($type ne 'unknown') {
308                 my $page=pagename($file);
309                 
310                 $links{$page}=[findlinks($content)];
311                 
312                 $content=linkify($content, $file);
313                 $content=htmlize($type, $content);
314                 $content=finalize($content, $page);
315                 
316                 writefile("$destdir/".htmlpage($page), $content);
317                 $oldpagemtime{$page}=time;
318                 $renderedfiles{$page}=htmlpage($page);
319         }
320         else {
321                 $links{$file}=[];
322                 writefile("$destdir/$file", $content);
323                 $oldpagemtime{$file}=time;
324                 $renderedfiles{$file}=$file;
325         }
326 } #}}}
327
328 sub loadindex () { #{{{
329         open (IN, "$srcdir/.ikiwiki/index") || return;
330         while (<IN>) {
331                 $_=possibly_foolish_untaint($_);
332                 chomp;
333                 my ($mtime, $file, $rendered, @links)=split(' ', $_);
334                 my $page=pagename($file);
335                 $pagesources{$page}=$file;
336                 $oldpagemtime{$page}=$mtime;
337                 $oldlinks{$page}=[@links];
338                 $links{$page}=[@links];
339                 $renderedfiles{$page}=$rendered;
340         }
341         close IN;
342 } #}}}
343
344 sub saveindex () { #{{{
345         if (! -d "$srcdir/.ikiwiki") {
346                 mkdir("$srcdir/.ikiwiki");
347         }
348         open (OUT, ">$srcdir/.ikiwiki/index") || error("cannot write to index: $!");
349         foreach my $page (keys %oldpagemtime) {
350                 print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
351                         join(" ", @{$links{$page}})."\n"
352                                 if $oldpagemtime{$page};
353         }
354         close OUT;
355 } #}}}
356
357 sub rcs_update () { #{{{
358         if (-d "$srcdir/.svn") {
359                 if (system("svn", "update", "--quiet", $srcdir) != 0) {
360                         warn("svn update failed\n");
361                 }
362         }
363 } #}}}
364
365 sub rcs_commit ($) { #{{{
366         my $message=shift;
367
368         if (-d "$srcdir/.svn") {
369                 if (system("svn", "commit", "--quiet", "-m",
370                            possibly_foolish_untaint($message), $srcdir) != 0) {
371                         warn("svn commit failed\n");
372                 }
373         }
374 } #}}}
375
376 sub rcs_add ($) { #{{{
377         my $file=shift;
378
379         if (-d "$srcdir/.svn") {
380                 my $parent=dirname($file);
381                 while (! -d "$srcdir/$parent/.svn") {
382                         $file=$parent;
383                         $parent=dirname($file);
384                 }
385                 
386                 if (system("svn", "add", "--quiet", "$srcdir/$file") != 0) {
387                         warn("svn add failed\n");
388                 }
389         }
390 } #}}}
391
392 sub rcs_recentchanges ($) { #{{{
393         my $num=shift;
394         my @ret;
395         
396         eval q{use Date::Parse};
397         eval q{use Time::Duration};
398         
399         if (-d "$srcdir/.svn") {
400                 my $info=`LANG=C svn info $srcdir`;
401                 my ($svn_url)=$info=~/^URL: (.*)$/m;
402
403                 # FIXME: currently assumes that the wiki is somewhere
404                 # under trunk in svn, doesn't support other layouts.
405                 my ($svn_base)=$svn_url=~m!(/trunk(?:/.*)?)$!;
406                 
407                 my $div=qr/^--------------------+$/;
408                 my $infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
409                 my $state='start';
410                 my ($rev, $user, $when, @pages, @message);
411                 foreach (`LANG=C svn log -v '$svn_url'`) {
412                         chomp;
413                         if ($state eq 'start' && /$div/) {
414                                 $state='header';
415                         }
416                         elsif ($state eq 'header' && /$infoline/) {
417                                 $rev=$1;
418                                 $user=$2;
419                                 $when=concise(ago(time - str2time($3)));
420                         }
421                         elsif ($state eq 'header' && /^\s+[A-Z]\s+\Q$svn_base\E\/(.+)$/) {
422                                 push @pages, { link => htmllink("", pagename($1), 1) }
423                                         if length $1;
424                         }
425                         elsif ($state eq 'header' && /^$/) {
426                                 $state='body';
427                         }
428                         elsif ($state eq 'body' && /$div/) {
429                                 push @ret, { rev => $rev, user => $user,
430                                         when => $when, message => [@message],
431                                         pages => [@pages] } if @pages;
432                                 return @ret if @ret >= $num;
433                                 
434                                 $state='header';
435                                 $message=$rev=$user=$when=undef;
436                                 @pages=();
437                         }
438                         elsif ($state eq 'body') {
439                                 push @message, {line => $_},
440                         }
441                 }
442         }
443
444         return @ret;
445 } #}}}
446
447 sub prune ($) { #{{{
448         my $file=shift;
449
450         unlink($file);
451         my $dir=dirname($file);
452         while (rmdir($dir)) {
453                 $dir=dirname($dir);
454         }
455 } #}}}
456
457 sub refresh () { #{{{
458         # Find existing pages.
459         my %exists;
460         my @files;
461         find({
462                 no_chdir => 1,
463                 wanted => sub {
464                         if (/$wiki_file_prune_regexp/) {
465                                 $File::Find::prune=1;
466                         }
467                         elsif (! -d $_) {
468                                 my ($f)=/$wiki_file_regexp/; # untaint
469                                 if (! defined $f) {
470                                         warn("skipping bad filename $_\n");
471                                 }
472                                 else {
473                                         $f=~s/^\Q$srcdir\E\/?//;
474                                         push @files, $f;
475                                         $exists{pagename($f)}=1;
476                                 }
477                         }
478                 },
479         }, $srcdir);
480
481         my %rendered;
482
483         # check for added or removed pages
484         my @add;
485         foreach my $file (@files) {
486                 my $page=pagename($file);
487                 if (! $oldpagemtime{$page}) {
488                         debug("new page $page");
489                         push @add, $file;
490                         $links{$page}=[];
491                         $pagesources{$page}=$file;
492                 }
493         }
494         my @del;
495         foreach my $page (keys %oldpagemtime) {
496                 if (! $exists{$page}) {
497                         debug("removing old page $page");
498                         push @del, $renderedfiles{$page};
499                         prune($destdir."/".$renderedfiles{$page});
500                         delete $renderedfiles{$page};
501                         $oldpagemtime{$page}=0;
502                         delete $pagesources{$page};
503                 }
504         }
505         
506         # render any updated files
507         foreach my $file (@files) {
508                 my $page=pagename($file);
509                 
510                 if (! exists $oldpagemtime{$page} ||
511                     mtime("$srcdir/$file") > $oldpagemtime{$page}) {
512                         debug("rendering changed file $file");
513                         render($file);
514                         $rendered{$file}=1;
515                 }
516         }
517         
518         # if any files were added or removed, check to see if each page
519         # needs an update due to linking to them
520         # TODO: inefficient; pages may get rendered above and again here;
521         # problem is the bestlink may have changed and we won't know until
522         # now
523         if (@add || @del) {
524 FILE:           foreach my $file (@files) {
525                         my $page=pagename($file);
526                         foreach my $f (@add, @del) {
527                                 my $p=pagename($f);
528                                 foreach my $link (@{$links{$page}}) {
529                                         if (bestlink($page, $link) eq $p) {
530                                                 debug("rendering $file, which links to $p");
531                                                 render($file);
532                                                 $rendered{$file}=1;
533                                                 next FILE;
534                                         }
535                                 }
536                         }
537                 }
538         }
539
540         # handle backlinks; if a page has added/removed links, update the
541         # pages it links to
542         # TODO: inefficient; pages may get rendered above and again here;
543         # problem is the backlinks could be wrong in the first pass render
544         # above
545         if (%rendered) {
546                 my %linkchanged;
547                 foreach my $file (keys %rendered, @del) {
548                         my $page=pagename($file);
549                         if (exists $links{$page}) {
550                                 foreach my $link (@{$links{$page}}) {
551                                         $link=bestlink($page, $link);
552                                         if (length $link &&
553                                             ! exists $oldlinks{$page} ||
554                                             ! grep { $_ eq $link } @{$oldlinks{$page}}) {
555                                                 $linkchanged{$link}=1;
556                                         }
557                                 }
558                         }
559                         if (exists $oldlinks{$page}) {
560                                 foreach my $link (@{$oldlinks{$page}}) {
561                                         $link=bestlink($page, $link);
562                                         if (length $link &&
563                                             ! exists $links{$page} ||
564                                             ! grep { $_ eq $link } @{$links{$page}}) {
565                                                 $linkchanged{$link}=1;
566                                         }
567                                 }
568                         }
569                 }
570                 foreach my $link (keys %linkchanged) {
571                         my $linkfile=$pagesources{$link};
572                         if (defined $linkfile) {
573                                 debug("rendering $linkfile, to update its backlinks");
574                                 render($linkfile);
575                         }
576                 }
577         }
578 } #}}}
579
580 # Generates a C wrapper program for running ikiwiki in a specific way.
581 # The wrapper may be safely made suid.
582 sub gen_wrapper ($$) { #{{{
583         my ($svn, $rebuild)=@_;
584
585         eval q{use Cwd 'abs_path'};
586         $srcdir=abs_path($srcdir);
587         $destdir=abs_path($destdir);
588         my $this=abs_path($0);
589         if (! -x $this) {
590                 error("$this doesn't seem to be executable");
591         }
592
593         my @params=($srcdir, $templatedir, $destdir, "--wikiname=$wikiname");
594         push @params, "--verbose" if $verbose;
595         push @params, "--rebuild" if $rebuild;
596         push @params, "--nosvn" if !$svn;
597         push @params, "--cgi" if $cgi;
598         push @params, "--url=$url" if $url;
599         push @params, "--cgiurl=$cgiurl" if $cgiurl;
600         push @params, "--historyurl=$historyurl" if $historyurl;
601         push @params, "--anonok" if $anonok;
602         my $params=join(" ", @params);
603         my $call='';
604         foreach my $p ($this, $this, @params) {
605                 $call.=qq{"$p", };
606         }
607         $call.="NULL";
608         
609         my @envsave;
610         push @envsave, qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI
611                        CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE
612                        HTTP_COOKIE} if $cgi;
613         my $envsave="";
614         foreach my $var (@envsave) {
615                 $envsave.=<<"EOF"
616         if ((s=getenv("$var")))
617                 asprintf(&newenviron[i++], "%s=%s", "$var", s);
618 EOF
619         }
620         
621         open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
622         print OUT <<"EOF";
623 /* A wrapper for ikiwiki, can be safely made suid. */
624 #define _GNU_SOURCE
625 #include <stdio.h>
626 #include <unistd.h>
627 #include <stdlib.h>
628 #include <string.h>
629
630 extern char **environ;
631
632 int main (int argc, char **argv) {
633         /* Sanitize environment. */
634         char *s;
635         char *newenviron[$#envsave+3];
636         int i=0;
637 $envsave
638         newenviron[i++]="HOME=$ENV{HOME}";
639         newenviron[i]=NULL;
640         environ=newenviron;
641
642         if (argc == 2 && strcmp(argv[1], "--params") == 0) {
643                 printf("$params\\n");
644                 exit(0);
645         }
646         
647         execl($call);
648         perror("failed to run $this");
649         exit(1);
650 }
651 EOF
652         close OUT;
653         if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
654                 error("failed to compile ikiwiki-wrap.c");
655         }
656         unlink("ikiwiki-wrap.c");
657         print "successfully generated ikiwiki-wrap\n";
658         exit 0;
659 } #}}}
660
661 sub cgi_recentchanges ($) { #{{{
662         my $q=shift;
663         
664         my $template=HTML::Template->new(
665                 filename => "$templatedir/recentchanges.tmpl");
666         $template->param(
667                 title => "RecentChanges",
668                 indexlink => $url,
669                 wikiname => $wikiname,
670                 changelog => [rcs_recentchanges(100)],
671         );
672         print $q->header, $template->output;
673 } #}}}
674
675 sub cgi_signin ($$) { #{{{
676         my $q=shift;
677         my $session=shift;
678
679         eval q{use CGI::FormBuilder};
680         my $form = CGI::FormBuilder->new(
681                 title => "$wikiname signin",
682                 fields => [qw(do page name password confirm_password email)],
683                 header => 1,
684                 method => 'POST',
685                 validate => {
686                         name => '/^\w+$/',
687                         confirm_password => {
688                                 perl => q{eq $form->field("password")},
689                         },
690                         email => 'EMAIL',
691                 },
692                 required => 'NONE',
693                 javascript => 0,
694                 params => $q,
695                 action => $q->request_uri,
696         );
697         
698         $form->sessionid($session->id);
699         $form->field(name => "name", required => 0);
700         $form->field(name => "do", type => "hidden");
701         $form->field(name => "page", type => "hidden");
702         $form->field(name => "password", type => "password", required => 0);
703         $form->field(name => "confirm_password", type => "password", required => 0);
704         $form->field(name => "email", required => 0);
705         if ($session->param("name")) {
706                 $form->field(name => "name", value => $session->param("name"));
707         }
708         if ($q->param("do") ne "signin") {
709                 $form->text("You need to log in before you can edit pages.");
710         }
711         
712         if ($form->submitted) {
713                 # Set required fields based on how form was submitted.
714                 my %required=(
715                         "Login" => [qw(name password)],
716                         "Register" => [qw(name password confirm_password email)],
717                         "Mail Password" => [qw(name)],
718                 );
719                 foreach my $opt (@{$required{$form->submitted}}) {
720                         $form->field(name => $opt, required => 1);
721                 }
722         
723                 # Validate password differently depending on how form was
724                 # submitted.
725                 if ($form->submitted eq 'Login') {
726                         $form->field(
727                                 name => "password",
728                                 validate => sub {
729                                         # TODO get real user password
730                                         shift eq "foo";
731                                 },
732                         );
733                 }
734                 else {
735                         $form->field(name => "password", validate => 'VALUE');
736                 }
737         }
738         else {
739                 # Comments only shown first time.
740                 $form->field(name => "name", comment => "use FirstnameLastName");
741                 $form->field(name => "confirm_password", comment => "(only needed");
742                 $form->field(name => "email",            comment => "for registration)");
743         }
744
745         if ($form->submitted && $form->validate) {
746                 if ($form->submitted eq 'Login') {
747                         $session->param("name", $form->field("name"));
748                         if (defined $form->field("do")) {
749                                 $q->redirect(
750                                         "$cgiurl?do=".$form->field("do").
751                                         "&page=".$form->field("page"));
752                         }
753                         else {
754                                 $q->redirect($url);
755                         }
756                 }
757                 elsif ($form->submitted eq 'Register') {
758                         # TODO: save registration info
759                         $form->field(name => "confirm_password", type => "hidden");
760                         $form->field(name => "email", type => "hidden");
761                         $form->text("Registration successful. Now you can Login.");
762                         print $form->render(submit => ["Login"]);;
763                 }
764                 elsif ($form->submitted eq 'Mail Password') {
765                         # TODO mail password
766                         $form->text("Your password has been emailed to you.");
767                         print $form->render(submit => ["Login", "Register", "Mail Password"]);;
768                 }
769         }
770         else {
771                 print $form->render(submit => ["Login", "Register", "Mail Password"]);;
772         }
773 } #}}}
774
775 sub cgi () { #{{{
776         eval q{use CGI};
777         eval q{use CGI::Session};
778         
779         my $q=CGI->new;
780         # session id has to be _sessionid for CGI::FormBuilder to work.
781         # TODO: stop having the formbuilder emit cookies and change session
782         # id to something else.
783         CGI::Session->name("_sessionid");
784         my $session = CGI::Session->new(undef, $q,
785                 { Directory=> "$srcdir/.ikiwiki/sessions" });
786         
787         my $do=$q->param('do');
788         if (! defined $do || ! length $do) {
789                 error("\"do\" parameter missing");
790         }
791         
792         if ($do eq 'recentchanges') {
793                 cgi_recentchanges($q);
794                 return;
795         }
796         
797         if ((! $anonok && ! defined $session->param("name")) || $do eq 'signin') {
798                 cgi_signin($q, $session);
799                 return;
800         }
801         
802         my ($page)=$q->param('page')=~/$wiki_file_regexp/;
803         if (! defined $page || ! length $page || $page ne $q->param('page') ||
804             $page=~/$wiki_file_prune_regexp/ || $page=~/^\//) {
805                 error("bad page name");
806         }
807         $page=lc($page);
808         
809         my $action=$q->request_uri;
810         $action=~s/\?.*//;
811         
812         if ($do eq 'create') {
813                 if (exists $pagesources{lc($page)}) {
814                         # hmm, someone else made the page in the meantime?
815                         print $q->redirect("$url/".htmlpage($page));
816                 }
817
818                 my @page_locs;
819                 my ($from)=$q->param('from')=~/$wiki_file_regexp/;
820                 if (! defined $from || ! length $from ||
821                     $from ne $q->param('from') ||
822                     $from=~/$wiki_file_prune_regexp/ || $from=~/^\//) {
823                         @page_locs=$page;
824                 }
825                 else {
826                         my $dir=$from."/";
827                         $dir=~s![^/]+/$!!;
828                         push @page_locs, $dir.$page;
829                         push @page_locs, "$from/$page";
830                         while (length $dir) {
831                                 $dir=~s![^/]+/$!!;
832                                 push @page_locs, $dir.$page;
833                         }
834                 }
835                 
836                 $q->param("do", "save");
837                 print $q->header,
838                       $q->start_html("Creating $page"),
839                       $q->h1(indexlink()." Creating $page"),
840                       $q->start_form(-action => $action),
841                       $q->hidden('do'),
842                       "Select page location:",
843                       $q->popup_menu('page', \@page_locs),
844                       $q->textarea(-name => 'content',
845                                -default => "",
846                                -rows => 20,
847                                -columns => 80),
848                       $q->br,
849                       "Optional comment about this change:",
850                       $q->br,
851                       $q->textfield(-name => "comments", -size => 80),
852                       $q->br,
853                       $q->submit("Save Page"),
854                       $q->end_form,
855                       $q->end_html;
856         }
857         elsif ($do eq 'edit') {
858                 my $content="";
859                 if (exists $pagesources{lc($page)}) {
860                         $content=readfile("$srcdir/$pagesources{lc($page)}");
861                         $content=~s/\n/\r\n/g;
862                 }
863                 $q->param("do", "save");
864                 print $q->header,
865                       $q->start_html("Editing $page"),
866                       $q->h1(indexlink()." Editing $page"),
867                       $q->start_form(-action => $action),
868                       $q->hidden('do'),
869                       $q->hidden('page'),
870                       $q->textarea(-name => 'content',
871                                -default => $content,
872                                -rows => 20,
873                                -columns => 80),
874                       $q->br,
875                       "Optional comment about this change:",
876                       $q->br,
877                       $q->textfield(-name => "comments", -size => 80),
878                       $q->br,
879                       $q->submit("Save Page"),
880                       $q->end_form,
881                       $q->end_html;
882         }
883         elsif ($do eq 'save') {
884                 my $file=$page.$default_pagetype;
885                 my $newfile=1;
886                 if (exists $pagesources{lc($page)}) {
887                         $file=$pagesources{lc($page)};
888                         $newfile=0;
889                 }
890                 
891                 my $content=$q->param('content');
892                 $content=~s/\r\n/\n/g;
893                 $content=~s/\r/\n/g;
894                 writefile("$srcdir/$file", $content);
895                 
896                 my $message="web commit from $ENV{REMOTE_ADDR}";
897                 if (defined $q->param('comments')) {
898                         $message.=": ".$q->param('comments');
899                 }
900                 
901                 if ($svn) {
902                         if ($newfile) {
903                                 rcs_add($file);
904                         }
905                         # presumably the commit will trigger an update
906                         # of the wiki
907                         rcs_commit($message);
908                 }
909                 else {
910                         refresh();
911                 }
912                 
913                 print $q->redirect("$url/".htmlpage($page));
914         }
915         else {
916                 error("unknown do parameter");
917         }
918 } #}}}
919
920 # main {{{
921 my $rebuild=0;
922 my $wrapper=0;
923 if (grep /^-/, @ARGV) {
924         eval {use Getopt::Long};
925         GetOptions(
926                 "wikiname=s" => \$wikiname,
927                 "verbose|v" => \$verbose,
928                 "rebuild" => \$rebuild,
929                 "wrapper" => \$wrapper,
930                 "svn!" => \$svn,
931                 "anonok!" => \$anonok,
932                 "cgi" => \$cgi,
933                 "url=s" => \$url,
934                 "cgiurl=s" => \$cgiurl,
935                 "historyurl=s" => \$historyurl,
936         ) || usage();
937 }
938 usage() unless @ARGV == 3;
939 ($srcdir) = possibly_foolish_untaint(shift);
940 ($templatedir) = possibly_foolish_untaint(shift);
941 ($destdir) = possibly_foolish_untaint(shift);
942
943 if ($cgi && ! length $url) {
944         error("Must specify url to wiki with --url when using --cgi");
945 }
946
947 gen_wrapper($svn, $rebuild) if $wrapper;
948 memoize('pagename');
949 memoize('bestlink');
950 loadindex() unless $rebuild;
951 if ($cgi) {
952         cgi();
953 }
954 else {
955         rcs_update() if $svn;
956         refresh();
957         saveindex();
958 }
959 #}}}