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