3 $ENV{PATH}="/usr/local/bin:/usr/bin:/bin";
12 my (%links, %oldlinks, %oldpagemtime, %renderedfiles, %pagesources);
14 # Holds global config settings, also used by some modules.
16 wiki_file_prune_regexp => qr{((^|/).svn/|\.\.|^\.|\/\.|\.html?$)},
17 wiki_link_regexp => qr/\[\[([^\s\]]+)\]\]/,
18 wiki_file_regexp => qr/(^[-A-Za-z0-9_.:\/+]+$)/,
21 default_pageext => ".mdwn",
34 templatedir => "/usr/share/ikiwiki/templates",
40 "setup|s=s" => \$config{setup},
41 "wikiname=s" => \$config{wikiname},
42 "verbose|v!" => \$config{verbose},
43 "rebuild!" => \$config{rebuild},
44 "wrapper=s" => sub { $config{wrapper}=$_[1] ? $_[1] : "ikiwiki-wrap" },
45 "wrappermode=i" => \$config{wrappermode},
46 "svn!" => \$config{svn},
47 "anonok!" => \$config{anonok},
48 "cgi!" => \$config{cgi},
49 "url=s" => \$config{url},
50 "cgiurl=s" => \$config{cgiurl},
51 "historyurl=s" => \$config{historyurl},
52 "diffurl=s" => \$config{diffurl},
54 $config{wiki_file_prune_regexp}=qr/$config{wiki_file_prune_regexp}|$_[1]/;
56 "adminuser=s@" => sub { push @{$config{adminuser}}, $_[1] },
57 "templatedir=s" => sub { $config{templatedir}=possibly_foolish_untaint($_[1]) },
60 if (! $config{setup}) {
61 usage() unless @ARGV == 2;
62 $config{srcdir} = possibly_foolish_untaint(shift);
63 $config{destdir} = possibly_foolish_untaint(shift);
68 sub checkoptions { #{{{
69 if ($config{cgi} && ! length $config{url}) {
70 error("Must specify url to wiki with --url when using --cgi");
72 $config{wikistatedir}="$config{srcdir}/.ikiwiki"
73 unless exists $config{wikistatedir};
77 die "usage: ikiwiki [options] source dest\n";
82 print "Content-type: text/html\n\n";
83 print misctemplate("Error", "<p>Error: @_</p>");
89 return unless $config{verbose};
101 return (stat($page))[9];
104 sub possibly_foolish_untaint { #{{{
106 my ($untainted)=$tainted=~/(.*)/;
110 sub basename ($) { #{{{
117 sub dirname ($) { #{{{
124 sub pagetype ($) { #{{{
127 if ($page =~ /\.mdwn$/) {
135 sub pagename ($) { #{{{
138 my $type=pagetype($file);
140 $page=~s/\Q$type\E*$// unless $type eq 'unknown';
144 sub htmlpage ($) { #{{{
147 return $page.".html";
150 sub readfile ($) { #{{{
154 error("cannot read a symlink ($file)");
158 open (IN, "$file") || error("failed to read $file: $!");
164 sub writefile ($$) { #{{{
169 error("cannot write to a symlink ($file)");
172 my $dir=dirname($file);
175 foreach my $s (split(m!/+!, $dir)) {
178 mkdir($d) || error("failed to create directory $d: $!");
183 open (OUT, ">$file") || error("failed to write $file: $!");
188 sub findlinks ($$) { #{{{
193 while ($content =~ /(?<!\\)$config{wiki_link_regexp}/g) {
196 # Discussion links are a special case since they're not in the text
197 # of the page, but on its template.
198 return @links, "$page/discussion";
201 sub bestlink ($$) { #{{{
202 # Given a page and the text of a link on the page, determine which
203 # existing page that link best points to. Prefers pages under a
204 # subdirectory with the same name as the source page, failing that
205 # goes down the directory tree to the base looking for matching
213 $l.="/" if length $l;
216 if (exists $links{$l}) {
217 #debug("for $page, \"$link\", use $l");
220 } while $cwd=~s!/?[^/]+$!!;
222 #print STDERR "warning: page $page, broken link: $link\n";
226 sub isinlinableimage ($) { #{{{
229 $file=~/\.(png|gif|jpg|jpeg)$/;
235 my $noimageinline=shift; # don't turn links into inline html images
236 my $forcesubpage=shift; # force a link to a subpage
239 if (! $forcesubpage) {
240 $bestlink=bestlink($page, $link);
243 $bestlink="$page/".lc($link);
246 return $link if length $bestlink && $page eq $bestlink;
248 # TODO BUG: %renderedfiles may not have it, if the linked to page
249 # was also added and isn't yet rendered! Note that this bug is
250 # masked by the bug mentioned below that makes all new files
252 if (! grep { $_ eq $bestlink } values %renderedfiles) {
253 $bestlink=htmlpage($bestlink);
255 if (! grep { $_ eq $bestlink } values %renderedfiles) {
256 return "<a href=\"$config{cgiurl}?do=create&page=$link&from=$page\">?</a>$link"
259 $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
261 if (! $noimageinline && isinlinableimage($bestlink)) {
262 return "<img src=\"$bestlink\">";
264 return "<a href=\"$bestlink\">$link</a>";
267 sub linkify ($$) { #{{{
271 $content =~ s{(\\?)$config{wiki_link_regexp}}{
272 $1 ? "[[$2]]" : htmllink($page, $2)
278 sub htmlize ($$) { #{{{
282 if (! $INC{"/usr/bin/markdown"}) {
284 $blosxom::version="is a proper perl module too much to ask?";
286 do "/usr/bin/markdown";
289 if ($type eq '.mdwn') {
290 return Markdown::Markdown($content);
293 error("htmlization of $type not supported");
297 sub backlinks ($) { #{{{
301 foreach my $p (keys %links) {
302 next if bestlink($page, $p) eq $page;
303 if (grep { length $_ && bestlink($p, $_) eq $page } @{$links{$p}}) {
304 my $href=File::Spec->abs2rel(htmlpage($p), dirname($page));
306 # Trim common dir prefixes from both pages.
308 my $page_trimmed=$page;
310 1 while (($dir)=$page_trimmed=~m!^([^/]+/)!) &&
312 $p_trimmed=~s/^\Q$dir\E// &&
313 $page_trimmed=~s/^\Q$dir\E//;
315 push @links, { url => $href, page => $p_trimmed };
319 return sort { $a->{page} cmp $b->{page} } @links;
322 sub parentlinks ($) { #{{{
329 foreach my $dir (reverse split("/", $page)) {
332 unshift @ret, { url => "$path$dir.html", page => $dir };
338 unshift @ret, { url => length $path ? $path : ".", page => $config{wikiname} };
342 sub indexlink () { #{{{
343 return "<a href=\"$config{url}\">$config{wikiname}</a>";
346 sub finalize ($$$) { #{{{
351 my $title=basename($page);
354 my $template=HTML::Template->new(blind_cache => 1,
355 filename => "$config{templatedir}/page.tmpl");
357 if (length $config{cgiurl}) {
358 $template->param(editurl => "$config{cgiurl}?do=edit&page=$page");
359 $template->param(prefsurl => "$config{cgiurl}?do=prefs");
361 $template->param(recentchangesurl => "$config{cgiurl}?do=recentchanges");
365 if (length $config{historyurl}) {
366 my $u=$config{historyurl};
367 $u=~s/\[\[file\]\]/$pagesources{$page}/g;
368 $template->param(historyurl => $u);
373 wikiname => $config{wikiname},
374 parentlinks => [parentlinks($page)],
376 backlinks => [backlinks($page)],
377 discussionlink => htmllink($page, "Discussion", 1, 1),
378 mtime => scalar(gmtime($mtime)),
381 return $template->output;
384 sub check_overwrite ($$) { #{{{
385 # Important security check. Make sure to call this before saving
386 # any files to the source directory.
390 if (! exists $renderedfiles{$src} && -e $dest && ! $config{rebuild}) {
391 error("$dest already exists and was rendered from ".
392 join(" ",(grep { $renderedfiles{$_} eq $dest } keys
394 ", before, so not rendering from $src");
398 sub render ($) { #{{{
401 my $type=pagetype($file);
402 my $content=readfile("$config{srcdir}/$file");
403 if ($type ne 'unknown') {
404 my $page=pagename($file);
406 $links{$page}=[findlinks($content, $page)];
408 $content=linkify($content, $page);
409 $content=htmlize($type, $content);
410 $content=finalize($content, $page,
411 mtime("$config{srcdir}/$file"));
413 check_overwrite("$config{destdir}/".htmlpage($page), $page);
414 writefile("$config{destdir}/".htmlpage($page), $content);
415 $oldpagemtime{$page}=time;
416 $renderedfiles{$page}=htmlpage($page);
420 check_overwrite("$config{destdir}/$file", $file);
421 writefile("$config{destdir}/$file", $content);
422 $oldpagemtime{$file}=time;
423 $renderedfiles{$file}=$file;
427 sub lockwiki () { #{{{
428 # Take an exclusive lock on the wiki to prevent multiple concurrent
429 # run issues. The lock will be dropped on program exit.
430 if (! -d $config{wikistatedir}) {
431 mkdir($config{wikistatedir});
433 open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
434 error ("cannot write to $config{wikistatedir}/lockfile: $!");
435 if (! flock(WIKILOCK, 2 | 4)) {
436 debug("wiki seems to be locked, waiting for lock");
437 my $wait=600; # arbitrary, but don't hang forever to
438 # prevent process pileup
440 return if flock(WIKILOCK, 2 | 4);
443 error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
447 sub unlockwiki () { #{{{
451 sub loadindex () { #{{{
452 open (IN, "$config{wikistatedir}/index") || return;
454 $_=possibly_foolish_untaint($_);
456 my ($mtime, $file, $rendered, @links)=split(' ', $_);
457 my $page=pagename($file);
458 $pagesources{$page}=$file;
459 $oldpagemtime{$page}=$mtime;
460 $oldlinks{$page}=[@links];
461 $links{$page}=[@links];
462 $renderedfiles{$page}=$rendered;
467 sub saveindex () { #{{{
468 if (! -d $config{wikistatedir}) {
469 mkdir($config{wikistatedir});
471 open (OUT, ">$config{wikistatedir}/index") ||
472 error("cannot write to $config{wikistatedir}/index: $!");
473 foreach my $page (keys %oldpagemtime) {
474 print OUT "$oldpagemtime{$page} $pagesources{$page} $renderedfiles{$page} ".
475 join(" ", @{$links{$page}})."\n"
476 if $oldpagemtime{$page};
481 sub rcs_update () { #{{{
482 if (-d "$config{srcdir}/.svn") {
483 if (system("svn", "update", "--quiet", $config{srcdir}) != 0) {
484 warn("svn update failed\n");
489 sub rcs_prepedit ($) { #{{{
490 # Prepares to edit a file under revision control. Returns a token
491 # that must be passed into rcs_commit when the file is ready
493 # The file is relative to the srcdir.
496 if (-d "$config{srcdir}/.svn") {
497 # For subversion, return the revision of the file when
499 my $rev=svn_info("Revision", "$config{srcdir}/$file");
500 return defined $rev ? $rev : "";
504 sub rcs_commit ($$$) { #{{{
505 # Tries to commit the page; returns undef on _success_ and
506 # a version of the page with the rcs's conflict markers on failure.
507 # The file is relative to the srcdir.
512 if (-d "$config{srcdir}/.svn") {
513 # Check to see if the page has been changed by someone
514 # else since rcs_prepedit was called.
515 my ($oldrev)=$rcstoken=~/^([0-9]+)$/; # untaint
516 my $rev=svn_info("Revision", "$config{srcdir}/$file");
517 if (defined $rev && defined $oldrev && $rev != $oldrev) {
518 # Merge their changes into the file that we've
520 chdir($config{srcdir}); # svn merge wants to be here
521 if (system("svn", "merge", "--quiet", "-r$oldrev:$rev",
522 "$config{srcdir}/$file") != 0) {
523 warn("svn merge -r$oldrev:$rev failed\n");
527 if (system("svn", "commit", "--quiet", "-m",
528 possibly_foolish_untaint($message),
529 "$config{srcdir}") != 0) {
530 my $conflict=readfile("$config{srcdir}/$file");
531 if (system("svn", "revert", "--quiet", "$config{srcdir}/$file") != 0) {
532 warn("svn revert failed\n");
537 return undef # success
540 sub rcs_add ($) { #{{{
541 # filename is relative to the root of the srcdir
544 if (-d "$config{srcdir}/.svn") {
545 my $parent=dirname($file);
546 while (! -d "$config{srcdir}/$parent/.svn") {
548 $parent=dirname($file);
551 if (system("svn", "add", "--quiet", "$config{srcdir}/$file") != 0) {
552 warn("svn add failed\n");
557 sub svn_info ($$) { #{{{
561 my $info=`LANG=C svn info $file`;
562 my ($ret)=$info=~/^$field: (.*)$/m;
566 sub rcs_recentchanges ($) { #{{{
570 eval q{use CGI 'escapeHTML'};
571 eval q{use Date::Parse};
572 eval q{use Time::Duration};
574 if (-d "$config{srcdir}/.svn") {
575 my $svn_url=svn_info("URL", $config{srcdir});
577 # FIXME: currently assumes that the wiki is somewhere
578 # under trunk in svn, doesn't support other layouts.
579 my ($svn_base)=$svn_url=~m!(/trunk(?:/.*)?)$!;
581 my $div=qr/^--------------------+$/;
582 my $infoline=qr/^r(\d+)\s+\|\s+([^\s]+)\s+\|\s+(\d+-\d+-\d+\s+\d+:\d+:\d+\s+[-+]?\d+).*/;
584 my ($rev, $user, $when, @pages, @message);
585 foreach (`LANG=C svn log --limit $num -v '$svn_url'`) {
587 if ($state eq 'start' && /$div/) {
590 elsif ($state eq 'header' && /$infoline/) {
593 $when=concise(ago(time - str2time($3)));
595 elsif ($state eq 'header' && /^\s+[A-Z]\s+\Q$svn_base\E\/([^ ]+)(?:$|\s)/) {
597 my $diffurl=$config{diffurl};
598 $diffurl=~s/\[\[file\]\]/$file/g;
599 $diffurl=~s/\[\[r1\]\]/$rev - 1/eg;
600 $diffurl=~s/\[\[r2\]\]/$rev/g;
602 link => htmllink("", pagename($file), 1),
606 elsif ($state eq 'header' && /^$/) {
609 elsif ($state eq 'body' && /$div/) {
610 my $committype="web";
611 if (defined $message[0] &&
612 $message[0]->{line}=~/^web commit by (\w+):?(.*)/) {
614 $message[0]->{line}=$2;
620 push @ret, { rev => $rev,
621 user => htmllink("", $user, 1),
622 committype => $committype,
623 when => $when, message => [@message],
626 return @ret if @ret >= $num;
629 $rev=$user=$when=undef;
632 elsif ($state eq 'body') {
633 push @message, {line => escapeHTML($_)},
645 my $dir=dirname($file);
646 while (rmdir($dir)) {
651 sub refresh () { #{{{
652 # find existing pages
655 eval q{use File::Find};
659 if (/$config{wiki_file_prune_regexp}/) {
661 $File::Find::prune=1;
664 elsif (! -d $_ && ! -l $_) {
665 my ($f)=/$config{wiki_file_regexp}/; # untaint
667 warn("skipping bad filename $_\n");
670 $f=~s/^\Q$config{srcdir}\E\/?//;
672 $exists{pagename($f)}=1;
680 # check for added or removed pages
682 foreach my $file (@files) {
683 my $page=pagename($file);
684 if (! $oldpagemtime{$page}) {
685 debug("new page $page");
688 $pagesources{$page}=$file;
692 foreach my $page (keys %oldpagemtime) {
693 if (! $exists{$page}) {
694 debug("removing old page $page");
695 push @del, $pagesources{$page};
696 prune($config{destdir}."/".$renderedfiles{$page});
697 delete $renderedfiles{$page};
698 $oldpagemtime{$page}=0;
699 delete $pagesources{$page};
703 # render any updated files
704 foreach my $file (@files) {
705 my $page=pagename($file);
707 if (! exists $oldpagemtime{$page} ||
708 mtime("$config{srcdir}/$file") > $oldpagemtime{$page}) {
709 debug("rendering changed file $file");
715 # if any files were added or removed, check to see if each page
716 # needs an update due to linking to them
717 # TODO: inefficient; pages may get rendered above and again here;
718 # problem is the bestlink may have changed and we won't know until
721 FILE: foreach my $file (@files) {
722 my $page=pagename($file);
723 foreach my $f (@add, @del) {
725 foreach my $link (@{$links{$page}}) {
726 if (bestlink($page, $link) eq $p) {
727 debug("rendering $file, which links to $p");
737 # handle backlinks; if a page has added/removed links, update the
739 # TODO: inefficient; pages may get rendered above and again here;
740 # problem is the backlinks could be wrong in the first pass render
744 foreach my $file (keys %rendered, @del) {
745 my $page=pagename($file);
746 if (exists $links{$page}) {
747 foreach my $link (map { bestlink($page, $_) } @{$links{$page}}) {
749 ! exists $oldlinks{$page} ||
750 ! grep { $_ eq $link } @{$oldlinks{$page}}) {
751 $linkchanged{$link}=1;
755 if (exists $oldlinks{$page}) {
756 foreach my $link (map { bestlink($page, $_) } @{$oldlinks{$page}}) {
758 ! exists $links{$page} ||
759 ! grep { $_ eq $link } @{$links{$page}}) {
760 $linkchanged{$link}=1;
765 foreach my $link (keys %linkchanged) {
766 my $linkfile=$pagesources{$link};
767 if (defined $linkfile) {
768 debug("rendering $linkfile, to update its backlinks");
775 sub gen_wrapper () { #{{{
776 eval q{use Cwd 'abs_path'};
777 $config{srcdir}=abs_path($config{srcdir});
778 $config{destdir}=abs_path($config{destdir});
779 my $this=abs_path($0);
781 error("$this doesn't seem to be executable");
784 if ($config{setup}) {
785 error("cannot create a wrapper that uses a setup file");
788 my @params=($config{srcdir}, $config{destdir},
789 "--wikiname=$config{wikiname}",
790 "--templatedir=$config{templatedir}");
791 push @params, "--verbose" if $config{verbose};
792 push @params, "--rebuild" if $config{rebuild};
793 push @params, "--nosvn" if !$config{svn};
794 push @params, "--cgi" if $config{cgi};
795 push @params, "--url=$config{url}" if length $config{url};
796 push @params, "--cgiurl=$config{cgiurl}" if length $config{cgiurl};
797 push @params, "--historyurl=$config{historyurl}" if length $config{historyurl};
798 push @params, "--diffurl=$config{diffurl}" if length $config{diffurl};
799 push @params, "--anonok" if $config{anonok};
800 push @params, "--adminuser=$_" foreach @{$config{adminuser}};
801 my $params=join(" ", @params);
803 foreach my $p ($this, $this, @params) {
809 push @envsave, qw{REMOTE_ADDR QUERY_STRING REQUEST_METHOD REQUEST_URI
810 CONTENT_TYPE CONTENT_LENGTH GATEWAY_INTERFACE
811 HTTP_COOKIE} if $config{cgi};
813 foreach my $var (@envsave) {
815 if ((s=getenv("$var")))
816 asprintf(&newenviron[i++], "%s=%s", "$var", s);
820 open(OUT, ">ikiwiki-wrap.c") || error("failed to write ikiwiki-wrap.c: $!");;
822 /* A wrapper for ikiwiki, can be safely made suid. */
829 extern char **environ;
831 int main (int argc, char **argv) {
832 /* Sanitize environment. */
834 char *newenviron[$#envsave+3];
837 newenviron[i++]="HOME=$ENV{HOME}";
841 if (argc == 2 && strcmp(argv[1], "--params") == 0) {
842 printf("$params\\n");
847 perror("failed to run $this");
852 if (system("gcc", "ikiwiki-wrap.c", "-o", possibly_foolish_untaint($config{wrapper})) != 0) {
853 error("failed to compile ikiwiki-wrap.c");
855 unlink("ikiwiki-wrap.c");
856 if (defined $config{wrappermode} &&
857 ! chmod(oct($config{wrappermode}), possibly_foolish_untaint($config{wrapper}))) {
858 error("chmod $config{wrapper}: $!");
860 print "successfully generated $config{wrapper}\n";
863 sub misctemplate ($$) { #{{{
867 my $template=HTML::Template->new(
868 filename => "$config{templatedir}/misc.tmpl"
872 indexlink => indexlink(),
873 wikiname => $config{wikiname},
874 pagebody => $pagebody,
876 return $template->output;
879 sub cgi_recentchanges ($) { #{{{
882 my $template=HTML::Template->new(
883 filename => "$config{templatedir}/recentchanges.tmpl"
886 title => "RecentChanges",
887 indexlink => indexlink(),
888 wikiname => $config{wikiname},
889 changelog => [rcs_recentchanges(100)],
891 print $q->header, $template->output;
894 sub userinfo_get ($$) { #{{{
898 eval q{use Storable};
899 my $userdata=eval{ Storable::lock_retrieve("$config{wikistatedir}/userdb") };
900 if (! defined $userdata || ! ref $userdata ||
901 ! exists $userdata->{$user} || ! ref $userdata->{$user} ||
902 ! exists $userdata->{$user}->{$field}) {
905 return $userdata->{$user}->{$field};
908 sub userinfo_set ($$$) { #{{{
913 eval q{use Storable};
914 my $userdata=eval{ Storable::lock_retrieve("$config{wikistatedir}/userdb") };
915 if (! defined $userdata || ! ref $userdata ||
916 ! exists $userdata->{$user} || ! ref $userdata->{$user}) {
920 $userdata->{$user}->{$field}=$value;
921 my $oldmask=umask(077);
922 my $ret=Storable::lock_store($userdata, "$config{wikistatedir}/userdb");
927 sub userinfo_setall ($$) { #{{{
931 eval q{use Storable};
932 my $userdata=eval{ Storable::lock_retrieve("$config{wikistatedir}/userdb") };
933 if (! defined $userdata || ! ref $userdata) {
936 $userdata->{$user}=$info;
937 my $oldmask=umask(077);
938 my $ret=Storable::lock_store($userdata, "$config{wikistatedir}/userdb");
943 sub cgi_signin ($$) { #{{{
947 eval q{use CGI::FormBuilder};
948 my $form = CGI::FormBuilder->new(
950 fields => [qw(do page from name password confirm_password email)],
954 confirm_password => {
955 perl => q{eq $form->field("password")},
962 action => $q->request_uri,
964 template => (-e "$config{templatedir}/signin.tmpl" ?
965 "$config{templatedir}/signin.tmpl" : "")
968 $form->field(name => "name", required => 0);
969 $form->field(name => "do", type => "hidden");
970 $form->field(name => "page", type => "hidden");
971 $form->field(name => "from", type => "hidden");
972 $form->field(name => "password", type => "password", required => 0);
973 $form->field(name => "confirm_password", type => "password", required => 0);
974 $form->field(name => "email", required => 0);
975 if ($q->param("do") ne "signin") {
976 $form->text("You need to log in first.");
979 if ($form->submitted) {
980 # Set required fields based on how form was submitted.
982 "Login" => [qw(name password)],
983 "Register" => [qw(name password confirm_password email)],
984 "Mail Password" => [qw(name)],
986 foreach my $opt (@{$required{$form->submitted}}) {
987 $form->field(name => $opt, required => 1);
990 # Validate password differently depending on how
991 # form was submitted.
992 if ($form->submitted eq 'Login') {
996 length $form->field("name") &&
997 shift eq userinfo_get($form->field("name"), 'password');
1000 $form->field(name => "name", validate => '/^\w+$/');
1003 $form->field(name => "password", validate => 'VALUE');
1005 # And make sure the entered name exists when logging
1006 # in or sending email, and does not when registering.
1007 if ($form->submitted eq 'Register') {
1013 ! userinfo_get($name, "regdate");
1023 userinfo_get($name, "regdate");
1029 # First time settings.
1030 $form->field(name => "name", comment => "use FirstnameLastName");
1031 $form->field(name => "confirm_password", comment => "(only needed");
1032 $form->field(name => "email", comment => "for registration)");
1033 if ($session->param("name")) {
1034 $form->field(name => "name", value => $session->param("name"));
1038 if ($form->submitted && $form->validate) {
1039 if ($form->submitted eq 'Login') {
1040 $session->param("name", $form->field("name"));
1041 if (defined $form->field("do") &&
1042 $form->field("do") ne 'signin') {
1044 "$config{cgiurl}?do=".$form->field("do").
1045 "&page=".$form->field("page").
1046 "&from=".$form->field("from"));;
1049 print $q->redirect($config{url});
1052 elsif ($form->submitted eq 'Register') {
1053 my $user_name=$form->field('name');
1054 if (userinfo_setall($user_name, {
1055 'email' => $form->field('email'),
1056 'password' => $form->field('password'),
1059 $form->field(name => "confirm_password", type => "hidden");
1060 $form->field(name => "email", type => "hidden");
1061 $form->text("Registration successful. Now you can Login.");
1062 print $session->header();
1063 print misctemplate($form->title, $form->render(submit => ["Login"]));
1066 error("Error saving registration.");
1069 elsif ($form->submitted eq 'Mail Password') {
1070 my $user_name=$form->field("name");
1071 my $template=HTML::Template->new(
1072 filename => "$config{templatedir}/passwordmail.tmpl"
1075 user_name => $user_name,
1076 user_password => userinfo_get($user_name, "password"),
1077 wikiurl => $config{url},
1078 wikiname => $config{wikiname},
1079 REMOTE_ADDR => $ENV{REMOTE_ADDR},
1082 eval q{use Mail::Sendmail};
1083 my ($fromhost) = $config{cgiurl} =~ m!/([^/]+)!;
1085 To => userinfo_get($user_name, "email"),
1086 From => "$config{wikiname} admin <".(getpwuid($>))[0]."@".$fromhost.">",
1087 Subject => "$config{wikiname} information",
1088 Message => $template->output,
1089 ) or error("Failed to send mail");
1091 $form->text("Your password has been emailed to you.");
1092 $form->field(name => "name", required => 0);
1093 print $session->header();
1094 print misctemplate($form->title, $form->render(submit => ["Login", "Register", "Mail Password"]));
1098 print $session->header();
1099 print misctemplate($form->title, $form->render(submit => ["Login", "Register", "Mail Password"]));
1103 sub is_admin ($) { #{{{
1104 my $user_name=shift;
1106 return grep { $_ eq $user_name } @{$config{adminuser}};
1109 sub glob_match ($$) { #{{{
1113 # turn glob into safe regexp
1114 $glob=quotemeta($glob);
1122 sub globlist_match ($$) { #{{{
1124 my @globlist=split(" ", shift);
1126 # check any negated globs first
1127 foreach my $glob (@globlist) {
1128 return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
1131 foreach my $glob (@globlist) {
1132 return 1 if glob_match($page, $glob);
1138 sub page_locked ($$;$) { #{{{
1143 my $user=$session->param("name");
1144 return if length $user && is_admin($user);
1146 foreach my $admin (@{$config{adminuser}}) {
1147 my $locked_pages=userinfo_get($admin, "locked_pages");
1148 if (globlist_match($page, userinfo_get($admin, "locked_pages"))) {
1149 return 1 if $nonfatal;
1150 error(htmllink("", $page, 1)." is locked by ".
1151 htmllink("", $admin, 1)." and cannot be edited.");
1158 sub cgi_prefs ($$) { #{{{
1162 eval q{use CGI::FormBuilder};
1163 my $form = CGI::FormBuilder->new(
1164 title => "preferences",
1165 fields => [qw(do name password confirm_password email locked_pages)],
1169 confirm_password => {
1170 perl => q{eq $form->field("password")},
1177 action => $q->request_uri,
1178 template => (-e "$config{templatedir}/prefs.tmpl" ?
1179 "$config{templatedir}/prefs.tmpl" : "")
1181 my @buttons=("Save Preferences", "Logout", "Cancel");
1183 my $user_name=$session->param("name");
1184 $form->field(name => "do", type => "hidden");
1185 $form->field(name => "name", disabled => 1,
1186 value => $user_name, force => 1);
1187 $form->field(name => "password", type => "password");
1188 $form->field(name => "confirm_password", type => "password");
1189 $form->field(name => "locked_pages", size => 50,
1190 comment => "(".htmllink("", "GlobList", 1).")");
1192 if (! is_admin($user_name)) {
1193 $form->field(name => "locked_pages", type => "hidden");
1196 if (! $form->submitted) {
1197 $form->field(name => "email", force => 1,
1198 value => userinfo_get($user_name, "email"));
1199 $form->field(name => "locked_pages", force => 1,
1200 value => userinfo_get($user_name, "locked_pages"));
1203 if ($form->submitted eq 'Logout') {
1205 print $q->redirect($config{url});
1208 elsif ($form->submitted eq 'Cancel') {
1209 print $q->redirect($config{url});
1212 elsif ($form->submitted eq "Save Preferences" && $form->validate) {
1213 foreach my $field (qw(password email locked_pages)) {
1214 if (length $form->field($field)) {
1215 userinfo_set($user_name, $field, $form->field($field)) || error("failed to set $field");
1218 $form->text("Preferences saved.");
1221 print $session->header();
1222 print misctemplate($form->title, $form->render(submit => \@buttons));
1225 sub cgi_editpage ($$) { #{{{
1229 eval q{use CGI::FormBuilder};
1230 my $form = CGI::FormBuilder->new(
1231 fields => [qw(do rcsinfo from page content comments)],
1237 required => [qw{content}],
1240 action => $q->request_uri,
1242 template => "$config{templatedir}/editpage.tmpl"
1244 my @buttons=("Save Page", "Preview", "Cancel");
1246 my ($page)=$form->param('page')=~/$config{wiki_file_regexp}/;
1247 if (! defined $page || ! length $page || $page ne $q->param('page') ||
1248 $page=~/$config{wiki_file_prune_regexp}/ || $page=~/^\//) {
1249 error("bad page name");
1253 my $file=$page.$config{default_pageext};
1255 if (exists $pagesources{lc($page)}) {
1256 $file=$pagesources{lc($page)};
1260 $form->field(name => "do", type => 'hidden');
1261 $form->field(name => "from", type => 'hidden');
1262 $form->field(name => "rcsinfo", type => 'hidden');
1263 $form->field(name => "page", value => "$page", force => 1);
1264 $form->field(name => "comments", type => "text", size => 80);
1265 $form->field(name => "content", type => "textarea", rows => 20,
1267 $form->tmpl_param("can_commit", $config{svn});
1268 $form->tmpl_param("indexlink", indexlink());
1269 $form->tmpl_param("helponformattinglink",
1270 htmllink("", "HelpOnFormatting", 1));
1271 if (! $form->submitted) {
1272 $form->field(name => "rcsinfo", value => rcs_prepedit($file),
1276 if ($form->submitted eq "Cancel") {
1277 print $q->redirect("$config{url}/".htmlpage($page));
1280 elsif ($form->submitted eq "Preview") {
1281 $form->tmpl_param("page_preview",
1282 htmlize($config{default_pageext},
1283 linkify($form->field('content'), $page)));
1286 $form->tmpl_param("page_preview", "");
1288 $form->tmpl_param("page_conflict", "");
1290 if (! $form->submitted || $form->submitted eq "Preview" ||
1291 ! $form->validate) {
1292 if ($form->field("do") eq "create") {
1293 if (exists $pagesources{lc($page)}) {
1294 # hmm, someone else made the page in the
1296 print $q->redirect("$config{url}/".htmlpage($page));
1302 my ($from)=$form->param('from')=~/$config{wiki_file_regexp}/;
1303 if (! defined $from || ! length $from ||
1304 $from ne $form->param('from') ||
1305 $from=~/$config{wiki_file_prune_regexp}/ || $from=~/^\//) {
1306 @page_locs=$best_loc=$page;
1312 if ($page eq 'discussion') {
1313 $best_loc="$from/$page";
1316 $best_loc=$dir.$page;
1319 push @page_locs, $dir.$page;
1320 push @page_locs, "$from/$page";
1321 while (length $dir) {
1323 push @page_locs, $dir.$page;
1327 ! exists $pagesources{lc($_)} &&
1328 ! page_locked($_, $session, 1)
1332 $form->tmpl_param("page_select", 1);
1333 $form->field(name => "page", type => 'select',
1334 options => \@page_locs, value => $best_loc);
1335 $form->title("creating $page");
1337 elsif ($form->field("do") eq "edit") {
1338 page_locked($page, $session);
1339 if (! defined $form->field('content') ||
1340 ! length $form->field('content')) {
1342 if (exists $pagesources{lc($page)}) {
1343 $content=readfile("$config{srcdir}/$pagesources{lc($page)}");
1344 $content=~s/\n/\r\n/g;
1346 $form->field(name => "content", value => $content,
1349 $form->tmpl_param("page_select", 0);
1350 $form->field(name => "page", type => 'hidden');
1351 $form->title("editing $page");
1354 print $form->render(submit => \@buttons);
1358 page_locked($page, $session);
1360 my $content=$form->field('content');
1361 $content=~s/\r\n/\n/g;
1362 $content=~s/\r/\n/g;
1363 writefile("$config{srcdir}/$file", $content);
1365 my $message="web commit ";
1366 if (length $session->param("name")) {
1367 $message.="by ".$session->param("name");
1370 $message.="from $ENV{REMOTE_ADDR}";
1372 if (defined $form->field('comments') &&
1373 length $form->field('comments')) {
1374 $message.=": ".$form->field('comments');
1381 # prevent deadlock with post-commit hook
1383 # presumably the commit will trigger an update
1385 my $conflict=rcs_commit($file, $message,
1386 $form->field("rcsinfo"));
1388 if (defined $conflict) {
1389 $form->field(name => "rcsinfo", value => rcs_prepedit($file),
1391 $form->tmpl_param("page_conflict", 1);
1392 $form->field("content", value => $conflict, force => 1);
1393 $form->field("do", "edit)");
1394 $form->tmpl_param("page_select", 0);
1395 $form->field(name => "page", type => 'hidden');
1396 $form->title("editing $page");
1397 print $form->render(submit => \@buttons);
1407 # The trailing question mark tries to avoid broken
1408 # caches and get the most recent version of the page.
1409 print $q->redirect("$config{url}/".htmlpage($page)."?updated");
1415 eval q{use CGI::Session};
1419 my $do=$q->param('do');
1420 if (! defined $do || ! length $do) {
1421 error("\"do\" parameter missing");
1424 # This does not need a session.
1425 if ($do eq 'recentchanges') {
1426 cgi_recentchanges($q);
1430 CGI::Session->name("ikiwiki_session");
1432 my $oldmask=umask(077);
1433 my $session = CGI::Session->new("driver:db_file", $q,
1434 { FileName => "$config{wikistatedir}/sessions.db" });
1437 # Everything below this point needs the user to be signed in.
1438 if ((! $config{anonok} && ! defined $session->param("name") ||
1439 ! defined $session->param("name") ||
1440 ! userinfo_get($session->param("name"), "regdate")) || $do eq 'signin') {
1441 cgi_signin($q, $session);
1443 # Force session flush with safe umask.
1444 my $oldmask=umask(077);
1451 if ($do eq 'create' || $do eq 'edit') {
1452 cgi_editpage($q, $session);
1454 elsif ($do eq 'prefs') {
1455 cgi_prefs($q, $session);
1458 error("unknown do parameter");
1462 sub setup () { # {{{
1463 my $setup=possibly_foolish_untaint($config{setup});
1464 delete $config{setup};
1465 open (IN, $setup) || error("read $setup: $!\n");
1468 ($code)=$code=~/(.*)/s;
1477 setup() if $config{setup};
1479 if ($config{wrapper}) {
1483 memoize('pagename');
1484 memoize('bestlink');
1485 loadindex() unless $config{rebuild};
1490 rcs_update() if $config{svn};