]> sipb.mit.edu Git - ikiwiki.git/blob - ikiwiki
use template for page rendering
[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, pagename($1) if length $1;
422                         }
423                         elsif ($state eq 'header' && /^$/) {
424                                 $state='body';
425                         }
426                         elsif ($state eq 'body' && /$div/) {
427                                 push @ret, { rev => $rev, user => $user,
428                                         when => $when, message => $message,
429                                         pages => [@pages] } if @pages;
430                                 return @ret if @ret >= $num;
431                                 
432                                 $state='header';
433                                 $message=$rev=$user=$when=undef;
434                                 @pages=();
435                         }
436                         elsif ($state eq 'body') {
437                                 $message.="$_<br>\n";
438                         }
439                 }
440         }
441
442         return @ret;
443 } #}}}
444
445 sub prune ($) { #{{{
446         my $file=shift;
447
448         unlink($file);
449         my $dir=dirname($file);
450         while (rmdir($dir)) {
451                 $dir=dirname($dir);
452         }
453 } #}}}
454
455 sub refresh () { #{{{
456         # Find existing pages.
457         my %exists;
458         my @files;
459         find({
460                 no_chdir => 1,
461                 wanted => sub {
462                         if (/$wiki_file_prune_regexp/) {
463                                 $File::Find::prune=1;
464                         }
465                         elsif (! -d $_) {
466                                 my ($f)=/$wiki_file_regexp/; # untaint
467                                 if (! defined $f) {
468                                         warn("skipping bad filename $_\n");
469                                 }
470                                 else {
471                                         $f=~s/^\Q$srcdir\E\/?//;
472                                         push @files, $f;
473                                         $exists{pagename($f)}=1;
474                                 }
475                         }
476                 },
477         }, $srcdir);
478
479         my %rendered;
480
481         # check for added or removed pages
482         my @add;
483         foreach my $file (@files) {
484                 my $page=pagename($file);
485                 if (! $oldpagemtime{$page}) {
486                         debug("new page $page");
487                         push @add, $file;
488                         $links{$page}=[];
489                         $pagesources{$page}=$file;
490                 }
491         }
492         my @del;
493         foreach my $page (keys %oldpagemtime) {
494                 if (! $exists{$page}) {
495                         debug("removing old page $page");
496                         push @del, $renderedfiles{$page};
497                         prune($destdir."/".$renderedfiles{$page});
498                         delete $renderedfiles{$page};
499                         $oldpagemtime{$page}=0;
500                         delete $pagesources{$page};
501                 }
502         }
503         
504         # render any updated files
505         foreach my $file (@files) {
506                 my $page=pagename($file);
507                 
508                 if (! exists $oldpagemtime{$page} ||
509                     mtime("$srcdir/$file") > $oldpagemtime{$page}) {
510                         debug("rendering changed file $file");
511                         render($file);
512                         $rendered{$file}=1;
513                 }
514         }
515         
516         # if any files were added or removed, check to see if each page
517         # needs an update due to linking to them
518         # TODO: inefficient; pages may get rendered above and again here;
519         # problem is the bestlink may have changed and we won't know until
520         # now
521         if (@add || @del) {
522 FILE:           foreach my $file (@files) {
523                         my $page=pagename($file);
524                         foreach my $f (@add, @del) {
525                                 my $p=pagename($f);
526                                 foreach my $link (@{$links{$page}}) {
527                                         if (bestlink($page, $link) eq $p) {
528                                                 debug("rendering $file, which links to $p");
529                                                 render($file);
530                                                 $rendered{$file}=1;
531                                                 next FILE;
532                                         }
533                                 }
534                         }
535                 }
536         }
537
538         # handle backlinks; if a page has added/removed links, update the
539         # pages it links to
540         # TODO: inefficient; pages may get rendered above and again here;
541         # problem is the backlinks could be wrong in the first pass render
542         # above
543         if (%rendered) {
544                 my %linkchanged;
545                 foreach my $file (keys %rendered, @del) {
546                         my $page=pagename($file);
547                         if (exists $links{$page}) {
548                                 foreach my $link (@{$links{$page}}) {
549                                         $link=bestlink($page, $link);
550                                         if (length $link &&
551                                             ! exists $oldlinks{$page} ||
552                                             ! grep { $_ eq $link } @{$oldlinks{$page}}) {
553                                                 $linkchanged{$link}=1;
554                                         }
555                                 }
556                         }
557                         if (exists $oldlinks{$page}) {
558                                 foreach my $link (@{$oldlinks{$page}}) {
559                                         $link=bestlink($page, $link);
560                                         if (length $link &&
561                                             ! exists $links{$page} ||
562                                             ! grep { $_ eq $link } @{$links{$page}}) {
563                                                 $linkchanged{$link}=1;
564                                         }
565                                 }
566                         }
567                 }
568                 foreach my $link (keys %linkchanged) {
569                         my $linkfile=$pagesources{$link};
570                         if (defined $linkfile) {
571                                 debug("rendering $linkfile, to update its backlinks");
572                                 render($linkfile);
573                         }
574                 }
575         }
576 } #}}}
577
578 # Generates a C wrapper program for running ikiwiki in a specific way.
579 # The wrapper may be safely made suid.
580 sub gen_wrapper ($$) { #{{{
581         my ($svn, $rebuild)=@_;
582
583         eval q{use Cwd 'abs_path'};
584         $srcdir=abs_path($srcdir);
585         $destdir=abs_path($destdir);
586         my $this=abs_path($0);
587         if (! -x $this) {
588                 error("$this doesn't seem to be executable");
589         }
590
591         my @params=($srcdir, $destdir, "--wikiname=$wikiname");
592         push @params, "--verbose" if $verbose;
593         push @params, "--rebuild" if $rebuild;
594         push @params, "--nosvn" if !$svn;
595         push @params, "--cgi" if $cgi;
596         push @params, "--url=$url" if $url;
597         push @params, "--cgiurl=$cgiurl" if $cgiurl;
598         push @params, "--historyurl=$historyurl" if $historyurl;
599         my $params=join(" ", @params);
600         my $call='';
601         foreach my $p ($this, $this, @params) {
602                 $call.=qq{"$p", };
603         }
604         $call.="NULL";
605         
606         my @envsave;
607         push @envsave, qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI
608                        CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE
609                        HTTP_COOKIE} if $cgi;
610         my $envsave="";
611         foreach my $var (@envsave) {
612                 $envsave.=<<"EOF"
613         if ((s=getenv("$var")))
614                 asprintf(&newenviron[i++], "%s=%s", "$var", s);
615 EOF
616         }
617         
618         open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
619         print OUT <<"EOF";
620 /* A wrapper for ikiwiki, can be safely made suid. */
621 #define _GNU_SOURCE
622 #include <stdio.h>
623 #include <unistd.h>
624 #include <stdlib.h>
625 #include <string.h>
626
627 extern char **environ;
628
629 int main (int argc, char **argv) {
630         /* Sanitize environment. */
631         char *s;
632         char *newenviron[$#envsave+3];
633         int i=0;
634 $envsave
635         newenviron[i++]="HOME=$ENV{HOME}";
636         newenviron[i]=NULL;
637         environ=newenviron;
638
639         if (argc == 2 && strcmp(argv[1], "--params") == 0) {
640                 printf("$params\\n");
641                 exit(0);
642         }
643         
644         execl($call);
645         perror("failed to run $this");
646         exit(1);
647 }
648 EOF
649         close OUT;
650         if (system("gcc", "ikiwiki-wrap.c", "-o", "ikiwiki-wrap") != 0) {
651                 error("failed to compile ikiwiki-wrap.c");
652         }
653         unlink("ikiwiki-wrap.c");
654         print "successfully generated ikiwiki-wrap\n";
655         exit 0;
656 } #}}}
657
658 sub cgi_recentchanges ($) { #{{{
659         my $q=shift;
660         
661         
662         
663         my $list="<ul>\n";
664         foreach my $change (rcs_recentchanges(100)) {
665                 $list.="<li>";
666                 $list.=join(", ", map { htmllink("", $_, 1) } @{$change->{pages}});
667                 $list.="<br>\n";
668                 $list.="changed ".$change->{when}." by ".
669                        htmllink("", $change->{user}, 1).
670                        ": <i>".$change->{message}."</i>\n";
671                 $list.="</li>\n";
672         }
673         $list.="</ul>\n";
674                 
675         print $q->header,
676               $q->start_html("RecentChanges"),
677               $q->h1(indexlink()." RecentChanges"),
678               $list,
679               $q->end_form,
680               $q->end_html;
681 } #}}}
682
683 sub cgi_signin ($$) { #{{{
684         my $q=shift;
685         my $session=shift;
686
687         eval q{use CGI::FormBuilder};
688         my $form = CGI::FormBuilder->new(
689                 title => "$wikiname signin",
690                 fields => [qw(do page name password confirm_password email)],
691                 header => 1,
692                 method => 'POST',
693                 validate => {
694                         name => '/^\w+$/',
695                         confirm_password => {
696                                 perl => q{eq $form->field("password")},
697                         },
698                         email => 'EMAIL',
699                 },
700                 required => 'NONE',
701                 javascript => 0,
702                 params => $q,
703                 action => $q->request_uri,
704         );
705         
706         $form->sessionid($session->id);
707         $form->field(name => "name", required => 0);
708         $form->field(name => "do", type => "hidden");
709         $form->field(name => "page", type => "hidden");
710         $form->field(name => "password", type => "password", required => 0);
711         $form->field(name => "confirm_password", type => "password", required => 0);
712         $form->field(name => "email", required => 0);
713         if ($session->param("name")) {
714                 $form->field(name => "name", value => $session->param("name"));
715         }
716         if ($q->param("do") ne "signin") {
717                 $form->text("You need to log in before you can edit pages.");
718         }
719         
720         if ($form->submitted) {
721                 # Set required fields based on how form was submitted.
722                 my %required=(
723                         "Login" => [qw(name password)],
724                         "Register" => [qw(name password confirm_password email)],
725                         "Mail Password" => [qw(name)],
726                 );
727                 foreach my $opt (@{$required{$form->submitted}}) {
728                         $form->field(name => $opt, required => 1);
729                 }
730         
731                 # Validate password differently depending on how form was
732                 # submitted.
733                 if ($form->submitted eq 'Login') {
734                         $form->field(
735                                 name => "password",
736                                 validate => sub {
737                                         # TODO get real user password
738                                         shift eq "foo";
739                                 },
740                         );
741                 }
742                 else {
743                         $form->field(name => "password", validate => 'VALUE');
744                 }
745         }
746         else {
747                 # Comments only shown first time.
748                 $form->field(name => "name", comment => "use FirstnameLastName");
749                 $form->field(name => "confirm_password", comment => "(only needed");
750                 $form->field(name => "email",            comment => "for registration)");
751         }
752
753         if ($form->submitted && $form->validate) {
754                 if ($form->submitted eq 'Login') {
755                         $session->param("name", $form->field("name"));
756                         if (defined $form->field("do")) {
757                                 $q->redirect(
758                                         "$cgiurl?do=".$form->field("do").
759                                         "&page=".$form->field("page"));
760                         }
761                         else {
762                                 $q->redirect($url);
763                         }
764                 }
765                 elsif ($form->submitted eq 'Register') {
766                         # TODO: save registration info
767                         $form->field(name => "confirm_password", type => "hidden");
768                         $form->field(name => "email", type => "hidden");
769                         $form->text("Registration successful. Now you can Login.");
770                         print $form->render(submit => ["Login"]);;
771                 }
772                 elsif ($form->submitted eq 'Mail Password') {
773                         # TODO mail password
774                         $form->text("Your password has been emailed to you.");
775                         print $form->render(submit => ["Login", "Register", "Mail Password"]);;
776                 }
777         }
778         else {
779                 print $form->render(submit => ["Login", "Register", "Mail Password"]);;
780         }
781 } #}}}
782
783 sub cgi () { #{{{
784         eval q{use CGI};
785         eval q{use CGI::Session};
786         
787         my $q=CGI->new;
788         # session id has to be _sessionid for CGI::FormBuilder to work.
789         # TODO: stop having the formbuilder emit cookies and change session
790         # id to something else.
791         CGI::Session->name("_sessionid");
792         my $session = CGI::Session->new(undef, $q,
793                 { Directory=> "$srcdir/.ikiwiki/sessions" });
794         
795         my $do=$q->param('do');
796         if (! defined $do || ! length $do) {
797                 error("\"do\" parameter missing");
798         }
799         
800         if ($do eq 'recentchanges') {
801                 cgi_recentchanges($q);
802                 return;
803         }
804         
805         if (! defined $session->param("name") || $do eq 'signin') {
806                 cgi_signin($q, $session);
807                 return;
808         }
809         
810         my ($page)=$q->param('page')=~/$wiki_file_regexp/;
811         if (! defined $page || ! length $page || $page ne $q->param('page') ||
812             $page=~/$wiki_file_prune_regexp/ || $page=~/^\//) {
813                 error("bad page name");
814         }
815         $page=lc($page);
816         
817         my $action=$q->request_uri;
818         $action=~s/\?.*//;
819         
820         if ($do eq 'create') {
821                 if (exists $pagesources{lc($page)}) {
822                         # hmm, someone else made the page in the meantime?
823                         print $q->redirect("$url/".htmlpage($page));
824                 }
825
826                 my @page_locs;
827                 my ($from)=$q->param('from')=~/$wiki_file_regexp/;
828                 if (! defined $from || ! length $from ||
829                     $from ne $q->param('from') ||
830                     $from=~/$wiki_file_prune_regexp/ || $from=~/^\//) {
831                         @page_locs=$page;
832                 }
833                 else {
834                         my $dir=$from."/";
835                         $dir=~s![^/]+/$!!;
836                         push @page_locs, $dir.$page;
837                         push @page_locs, "$from/$page";
838                         while (length $dir) {
839                                 $dir=~s![^/]+/$!!;
840                                 push @page_locs, $dir.$page;
841                         }
842                 }
843                 
844                 $q->param("do", "save");
845                 print $q->header,
846                       $q->start_html("Creating $page"),
847                       $q->h1(indexlink()." Creating $page"),
848                       $q->start_form(-action => $action),
849                       $q->hidden('do'),
850                       "Select page location:",
851                       $q->popup_menu('page', \@page_locs),
852                       $q->textarea(-name => 'content',
853                                -default => "",
854                                -rows => 20,
855                                -columns => 80),
856                       $q->br,
857                       "Optional comment about this change:",
858                       $q->br,
859                       $q->textfield(-name => "comments", -size => 80),
860                       $q->br,
861                       $q->submit("Save Page"),
862                       $q->end_form,
863                       $q->end_html;
864         }
865         elsif ($do eq 'edit') {
866                 my $content="";
867                 if (exists $pagesources{lc($page)}) {
868                         $content=readfile("$srcdir/$pagesources{lc($page)}");
869                         $content=~s/\n/\r\n/g;
870                 }
871                 $q->param("do", "save");
872                 print $q->header,
873                       $q->start_html("Editing $page"),
874                       $q->h1(indexlink()." Editing $page"),
875                       $q->start_form(-action => $action),
876                       $q->hidden('do'),
877                       $q->hidden('page'),
878                       $q->textarea(-name => 'content',
879                                -default => $content,
880                                -rows => 20,
881                                -columns => 80),
882                       $q->br,
883                       "Optional comment about this change:",
884                       $q->br,
885                       $q->textfield(-name => "comments", -size => 80),
886                       $q->br,
887                       $q->submit("Save Page"),
888                       $q->end_form,
889                       $q->end_html;
890         }
891         elsif ($do eq 'save') {
892                 my $file=$page.$default_pagetype;
893                 my $newfile=1;
894                 if (exists $pagesources{lc($page)}) {
895                         $file=$pagesources{lc($page)};
896                         $newfile=0;
897                 }
898                 
899                 my $content=$q->param('content');
900                 $content=~s/\r\n/\n/g;
901                 $content=~s/\r/\n/g;
902                 writefile("$srcdir/$file", $content);
903                 
904                 my $message="web commit from $ENV{REMOTE_ADDR}";
905                 if (defined $q->param('comments')) {
906                         $message.=": ".$q->param('comments');
907                 }
908                 
909                 if ($svn) {
910                         if ($newfile) {
911                                 rcs_add($file);
912                         }
913                         # presumably the commit will trigger an update
914                         # of the wiki
915                         rcs_commit($message);
916                 }
917                 else {
918                         refresh();
919                 }
920                 
921                 print $q->redirect("$url/".htmlpage($page));
922         }
923         else {
924                 error("unknown do parameter");
925         }
926 } #}}}
927
928 # main {{{
929 my $rebuild=0;
930 my $wrapper=0;
931 if (grep /^-/, @ARGV) {
932         eval {use Getopt::Long};
933         GetOptions(
934                 "wikiname=s" => \$wikiname,
935                 "verbose|v" => \$verbose,
936                 "rebuild" => \$rebuild,
937                 "wrapper" => \$wrapper,
938                 "svn!" => \$svn,
939                 "cgi" => \$cgi,
940                 "url=s" => \$url,
941                 "cgiurl=s" => \$cgiurl,
942                 "historyurl=s" => \$historyurl,
943         ) || usage();
944 }
945 usage() unless @ARGV == 3;
946 ($srcdir) = possibly_foolish_untaint(shift);
947 ($templatedir) = possibly_foolish_untaint(shift);
948 ($destdir) = possibly_foolish_untaint(shift);
949
950 if ($cgi && ! length $url) {
951         error("Must specify url to wiki with --url when using --cgi");
952 }
953
954 gen_wrapper($svn, $rebuild) if $wrapper;
955 memoize('pagename');
956 memoize('bestlink');
957 loadindex() unless $rebuild;
958 if ($cgi) {
959         cgi();
960 }
961 else {
962         rcs_update() if $svn;
963         refresh();
964         saveindex();
965 }
966 #}}}