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