suikawiki/script/wiki.cgi

#!/usr/bin/perl
#
# wiki.cgi - This is YukiWiki, yet another Wiki clone.
#
# Copyright (C) 2000-2002 by Hiroshi Yuki.
# <[email protected]>
# http://www.hyuki.com/yukiwiki/
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone.

# Walrus add (debug) start
my $walrus_log;
my $walrus_debugging = 0;
# Walrus add (debug) end

# Libraries.
use strict;
use lib qw(./WalWiki/lib);
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Yuki::RSS;
use Yuki::DiffText qw(difftext);
use Yuki::YukiWikiDB;
use AnyDBM_File;
require 'jcode.pl';
require Jcode;
use Fcntl;
my $version = '2.0.beta1.2002-05-29';
my $walversion;
##############################
#
# You MUST modify following '$modifier_...' variables.
#
my $modifier_mail = '[email protected]';   # Your mail address, like '[email protected]'.
my $modifier_url  = 'http://suika.fam.cx/~wakaba/';     # Your web page, like 'http://digit.que.ne.jp/work/'.
my $modifier_name = '��';       # Your name, like 'Makio Tsukamoto'.
# my $modifier_dbtype = 'AnyDBM_File';  # Fast, not available on some server, page size limited.
# my $modifier_dbtype = 'dbmopen';      # Fast, not available on some server, page size limited.
my $modifier_dbtype = 'YukiWikiDB';     # Slow, available on all environment.
# my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail.
my $modifier_sendmail = ''; # If you don't need mail notification.
my $modifier_dir_data = './wikidata'; # Your data directory.
my $modifier_rss_title = "SuikaWiki $walversion";
my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed.
my $modifier_rss_description = 'This is SuikaWiki';
##############################
#
# You MAY modify following variables.
#
$SuikaWiki::Plugin::plugin_directory = q(./SuikaWiki/Plugin/);
my $file_touch = "$modifier_dir_data/touched.txt";
my $file_resource = "$modifier_dir_data/resource.txt";
my $file_FrontPage = "$modifier_dir_data/frontpage.txt";
my $file_conflict = "$modifier_dir_data/conflict.txt";
my $file_format = "$modifier_dir_data/format.txt";
my $url_cgi = '/~wakaba/-temp/wiki/wiki';       ## MUST be started from '/'
my $url_stylesheet = $url_cgi.'?mycmd=TEXT_CSS;mypage=WikiHTMLStyle';
my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />';
my $maxrecent = 50;
my $cols = 80;
my $rows = 20;
##############################
#
# You MAY, but do NOT NEED modify following variables.
# 
my $dataname = "$modifier_dir_data/wiki";
my $infoname = "$modifier_dir_data/info";
my $diffname = "$modifier_dir_data/diff";
my $editchar = '?';
my $subject_delimiter = ' - ';
my $use_autoimg = 1; # automatically convert image URL into <img> tag.
my $use_exists = 0; # If you can use 'exists' method for your DB.
##############################
my $InterWikiName = 'InterWikiName';
my $RecentChanges = 'RecentChanges';
my $AdminChangePassword = 'AdminChangePassword';
my $CompletedSuccessfully = 'CompletedSuccessfully';
my $FrontPage = 'HomePage';
my $IndexPage = 'IndexPage';
my $SearchPage = 'SearchPage';
my $CreatePage = 'CreatePage';
my $ErrorPage = 'ErrorPage';
my $RssPage = 'RssPage';
my $NAME_OF_WikiPageLicense = 'WikiPageLicense';
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.
##############################
my $bracket_name = '\[\[(\S+?)\]\]';
my $embedded_name = '\[\[(#\S+?)\]\]';
my %fmt;        ## formatter objects
##############################
my $embed_comment = '[[#comment]]';
my $embed_rcomment = '[[#rcomment]]';
my $embed_comment_Name_Prompt = '̾��:';
my $DEFAULT_embed_comment_name = '̵̾������';
my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$';    # Walrus add (5)
my %embed_command = (
        searched        => '^\[\[#searched:([^\]]+)\]\]$',
    form => qw/\[\[\#form(?:\(([A-Za-z0-9-]+)\))?:'((?:[^'\\]|\\.)*)':'((?:[^'\\]|\\.)*)'(?::'((?:[^'\\]|\\.)*)')?\]\]/,
);
##############################
my $info_LastModified = 'LastModified';
my $info_IsFrozen = 'IsFrozen';
my $info_AdminPassword = 'AdminPassword';
##############################
my $kanjicode = 'euc';
my $charset = 'EUC-JP';
my $lang = 'ja';
my %fixedpage = (
    $IndexPage => 1,
    $CreatePage => 1,
    $ErrorPage => 1,
    $RssPage => 1,
    $RecentChanges => 1,
    $SearchPage => 1,
    $AdminChangePassword => 1,
    $CompletedSuccessfully => 1,
    #$FrontPage => 1,
    WikiUserAgentList => 1,
    WikiPluginInfo    => 1,
);
my %form;
my %database;
my %infobase;
my %diffbase;
my %resource;
my %interwiki;
##############################
my %page_command = (
    $IndexPage => 'index',
    $SearchPage => 'searchform',
    $CreatePage => 'create',
    $RssPage => 'rss',
    $AdminChangePassword => 'adminchangepasswordform',
    #$FrontPage => 'FrontPage',
    WikiPluginInfo       => 'x_WikiPluginInfo',
);
my %command_do = (
    read => \&do_read,
    TEXT_CSS => \&do_output_css,
    edit => \&do_edit,
    adminedit => \&do_adminedit,
    adminchangepasswordform => \&do_adminchangepasswordform,
    adminchangepassword => \&do_adminchangepassword,
    write => \&do_write,
    index => \&do_index,
    searchform => \&do_searchform,
    search => \&do_search,
    create => \&do_create,
    createresult => \&do_createresult,
    FrontPage => \&do_FrontPage,
    comment => \&do_comment,
    RandomJump  => \&do_random_jump,
    rss => \&do_rss,
    diff => \&do_diff,
    interwikibox => \&do_interwiki_box, # Walrus add (5)
    wikiform => \&do_wikiform,
    x_WikiPluginInfo  => \&do_wikiplugininfo,
);
##############################
my $walversion = '2.0.beta1.wal.1';          # Walrus add (1)
##############################
# &test_convert;
my $UA = '';  ## User agent name
##############################

sub main {
    $UA = $main::ENV{HTTP_USER_AGENT};
    &init_resource;
    &open_db;
    &init_form;
    &init_InterWikiName;
    if ($command_do{$form{mycmd}}) {
        &{$command_do{$form{mycmd}}};
    } else {
        &do_FrontPage;
    }
    &close_db;
}

sub do_read {
  my $content = $database{$form{mypage}};
  my $lm = &get_info($form{mypage}, $info_LastModified);
  wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
  wiki::useragent::add ($ENV{HTTP_USER_AGENT});
  my ($r, $c) = get_search_result ($form{mypage});
  my $rl = wiki::referer::list_html ($form{mypage});
  my @toc;
  push @toc, qq(-<a href="#wikipage-see-also">See Also</a>) if $c;
  push @toc, qq(-<a href="#wikipage-referer">���ȸ�</a>) if $rl;
    my $cf = 'SuikaWiki/0.9';
    ## Should be support at least:
    ## - 'SuikaWiki/0.9' CRLF
    ## - 'H2H/' ("0.9" / "1.0" / "1.1") CRLF
    ## - "/*" WSP* 'W3C-CSS/' ("1.0" / "2.0") "*/" CRLF
    $cf = $1 if $content =~ s#^(?:/\*\s*|[\#<]\?)?([A-Z][A-Za-z0-9-]+/[0-9.]+(?:[^0-9.\x0D\x0A][^\x0D\x0A]*)?)[\x0D\x0A]+##s;
    if ($cf =~ m!^(?:\#\?)?SuikaWiki/0.9(?:$|\s)!) {
      &print_header ($form{mypage}, -last_modified => $lm,
        -content_format => $cf, -noindex => $cf =~ /obsoleted="yes"/);
      &print_content ($content, content_format => $cf, last_modified => $lm,
        -toc => \@toc);
      print &text_to_html (q([[#comment]])) if $cf !~ /obsoleted="yes"/ && !$fixedpage{$form{mypage}};
    } else {
      &print_header($form{mypage}, -last_modified => $lm);
      print "<pre>@{[&escape($content)]}</pre>";
    }
    if ($c) {
      print qq{<h2 @{[&id_and_name('wikipage-see-also')]}>See also</h2>};
      print $r;
    }
    if ($rl) {
      print qq(<div @{[&id_and_name('wikipage-referer')]}><h2>���ȸ�</h2>\n$rl</div>\n);
    }
  &print_footer($form{mypage}, $lm);
}

sub do_output_css {
  my $content = $database{$form{mypage}};
  if ($content =~ m#^\s*/\*\s*W3C-CSS#) {
    my $lm = &get_info($form{mypage}, $info_LastModified);
      print scalar make_navigate_links ($form{mypage});
    print "Content-Type: text/css; charset=$charset\n";
    print "Last-Modified: $lm\n";
    print "\n";
    print $content;
  } else {
    print "Status: 406 Unsupported Media Type\n";
    &print_header('WikiPageIsNotCSS', -noindex => 1);
    &print_content($database{WikiPageIsNotCSS});
    &print_footer('WikiPageIsNotCSS');
  }
}

sub id_and_name ($) {
    my $name = shift;
    if ($UA =~ m#Mozilla/[12]\.|Microsoft Internet Explorer#) {
      qq{id="$name"><a name="$name"></a};
    } else {
        qq{id="$name"};
    }
}

sub do_edit {
    my ($page) = &unarmor_name(&armor_name($form{mypage}));
    &print_header($page, -noindex => 1);
    if (not &is_editable($page)) {
        &print_message($resource{cantchange});
    } elsif (&is_frozen($page)) {
        &print_message($resource{cantchange});
    } else {
        &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
    }
    wiki::referer::add ($form{mypage}, $ENV{HTTP_REFERER});
    wiki::useragent::add ($ENV{HTTP_USER_AGENT});
    my ($r, $c) = get_search_result ($form{mypage});
    my $rl = wiki::referer::list_html ($form{mypage});
    if ($c) {
      print q{<h2 id="wikipage-see-also">See also</h2>};
      print $r;
    }
    if ($rl) {
      print qq(<div id="wikipage-referer"><h2>���ȸ�</h2>\n$rl</div>\n);
    }
    &print_footer($page);
}

sub do_adminedit {
    my ($page) = &unarmor_name(&armor_name($form{mypage}));
    &print_header($page, -noindex => 1);
    if (not &is_editable($page)) {
        &print_message($resource{cantchange});
    } else {
        &print_message($resource{passwordneeded});
        &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>1);
    }
    &print_footer($page);
}

sub do_adminchangepasswordform {
    &print_header($AdminChangePassword, -noindex => 1);
    &print_passwordform;
    &print_footer($AdminChangePassword);
}

sub do_adminchangepassword {
    if ($form{mynewpassword} ne $form{mynewpassword2}) {
        &print_error($resource{passwordmismatcherror});
    }
    my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword);
    if ($validpassword_crypt) {
        if (not &valid_password($form{myoldpassword})) {
            &send_mail_to_admin(<<"EOD", "AdminChangePassword");
myoldpassword=$form{myoldpassword}
mynewpassword=$form{mynewpassword}
mynewpassword2=$form{mynewpassword2}
EOD
            &print_error($resource{passworderror});
        }
    }
    my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
    my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
    my $salt1 = $token[(time | $$) % scalar(@token)];
    my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
    my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
    &set_info($AdminSpecialPage, $info_AdminPassword, $crypted);

    &print_header($CompletedSuccessfully, -noindex => 1);
    &print_message($resource{passwordchanged});
    &print_footer($CompletedSuccessfully);
}

sub do_index {
    &print_header($IndexPage);
    print qq(<ul>);
    foreach my $page (sort keys %database) {
        if (&is_editable($page)) {
            print qq(<li><a href="$url_cgi?@{[&encode($page)]}">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>);
            # print qq(<li>@{[&get_info($page, $info_IsFrozen)]}</li>);
            # print qq(<li>@{[0 + &is_frozen($page)]}</li>);
        }
    }
    print qq(</ul>);
    &print_footer($IndexPage);
}

sub do_write {
    if (&frozen_reject()) {
        return;
    }

    if (not &is_editable($form{mypage})) {
        &print_header($form{mypage}, -noindex => 1);
        &print_message($resource{cantchange});
        &print_footer($form{mypage});
        return;
    }

    if (&conflict($form{mypage}, $form{mymsg})) {
        return;
    }

    # Making diff
    {
        &open_diff;
        my @msg1 = split(/\n/, $database{$form{mypage}});
        my @msg2 = split(/\n/, $form{mymsg});
        $diffbase{$form{mypage}} = &difftext(\@msg1, \@msg2);
        &close_diff;
    }

    if ($form{mymsg}) {
        $database{$form{mypage}} = $form{mymsg};
        &send_mail_to_admin($form{mypage}, "Modify");
        if ($form{mytouch}) {
            &set_info($form{mypage}, $info_LastModified, '' . localtime);
            &update_recent_changes;
        }
        &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen});
        my $fragment = '';
        $fragment .= qq(;after_edit_cmd=@{[&encode($form{after_edit_cmd})]}) if $form{after_edit_cmd};
        if ($form{__comment_anchor_index}) {
            $fragment .= qq(#anchor-$form{__comment_anchor_index});
        } elsif ($form{__wikiform_anchor_index}) {
            $fragment .= qq(#wikiform-$form{__wikiform_anchor_index});
        }
        &print_header($CompletedSuccessfully, -noindex => 1, -goto => $url_cgi.'?mycmd='.&encode($form{after_edit_cmd}||'read').';mypage='.&encode($form{mypage}).qq(;x-param=@{[time.[0..9]->[rand 10]]}$fragment));
        &print_message($resource{saved});
        &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}");
        &print_footer($CompletedSuccessfully);
    } else {
        &send_mail_to_admin($form{mypage}, "Delete");
        delete $database{$form{mypage}};
        delete $infobase{$form{mypage}};
        if ($form{mytouch}) {
            &update_recent_changes;
        }
        &print_header($form{mypage}, -noindex => 1);
        &print_message($resource{deleted});
        &print_footer($form{mypage});
    }
}

sub do_searchform {
    &print_header($SearchPage);
    &print_searchform("");
    &print_footer($SearchPage);
}

sub do_search {
    my $word = $form{mymsg};
    &print_header($SearchPage);
    &print_searchform(&escape($word));
    print scalar get_search_result ($word, -output_not_found => 1, -match_myself => 1);
    &print_footer($SearchPage);
}

sub get_search_result ($;%) {
  my $word = lc shift;
  my %option = @_;
  my @r;
  foreach my $page (keys %database) {
    next if $page eq $RecentChanges || ($page eq $word && !$option{-match_myself});
    my $content = $database{$page};
    my $cf = 'SuikaWiki/0.9';
    $cf = $1 if $content =~ s/^\#\?([^\x0A\x0D]+)//s;
    next if $cf =~ /obsoleted="yes"/;
    if (index (lc $page, $word) > -1) {
      my $c = $content =~ s/\Q$word\E//gi;
      push @r, [$page, $c+20];
    } elsif (index ($word, lc $page) > -1) {
      my $c = $content =~ s/\Q$word\E//gi;
      push @r, [$page, $c+10];
    } elsif (my $c = $content =~ s/\Q$word\E//gi) {
      push @r, [$page, $c];
    }
  }
  my $em = sub { my $s = shift; $s =~ s#(\Q$word\E)#<em>$1</em>#gi; $s };
  my $r = join "\n", map {qq(<li>[$_->[1]] <a href ="$url_cgi?@{[&encode($_->[0])]}" class="wiki">@{[&$em(&escape($_->[0]))]}</a> <span class="wikipage-summary">@{[&$em(&escape(&get_subjectline($_->[0])))]}</span></li>)} sort {$b->[1] <=> $a->[1] || $a->[0] cmp $b->[0]} @r;
  $r = qq|<ul class="search-result">$r</ul>| if $r;
  get_message ($resource{notfound}) if @r == 0 && $option{-output_not_found};
  wantarray? ($r, scalar @r): $r;
}

sub do_create {
    &print_header($CreatePage);
    print <<"EOD";
<form action="$url_cgi" method="post">
    <input type="hidden" name="mycmd" value="edit">
    <strong>$resource{newpagename}</strong><br>
    <input type="text" name="mypage" value="" size="20">
    <input type="submit" value="$resource{createbutton}"><br>
</form>
EOD
    &print_footer($CreatePage);
}

sub do_random_jump {
  my @list = keys %database;
  my $name = &encode ($list[rand @list]);
  my ($scheme) = 'http';
  $scheme = $1 if $main::ENV{SERVER_PROTOCOL} =~ m#([A-Za-z0-9+.%-]+)#;
  print "Location: $scheme://$main::ENV{SERVER_NAME}:$main::ENV{SERVER_PORT}$url_cgi?$name\n";
  print "\n";
}

sub do_FrontPage {
    open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)");
    my $content = join('', <FILE>);
    &code_convert(\$content, $kanjicode);
    close(FILE);
    &print_header($FrontPage);
    &print_content($content);
    &print_footer($FrontPage);
}

sub print_error {
    my ($msg) = @_;
    &print_header($ErrorPage, -noindex => 1);
    print qq(<p><strong class="error">$msg</strong></p>);
    &print_footer($ErrorPage);
    exit(0);
}

sub print_header ($;%) {
    my ($page, %option) = @_;
    my $bodyclass = "normal";
    if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) {
        $bodyclass = "frozen";
    }
    $bodyclass .= " wiki-page-obsoleted" if $option{-content_format} =~ /obsoleted="yes"/;
    if ($option{-goto}) {
      if ($UA =~ m#Opera|MSIE 2\.#) {
          $option{-goto} =~ tr/;/&/ if $UA =~ m#Opera#;
          print qq{Refresh: 0; url=$option{-goto}\n};
          $option{-goto} = qq(<meta http-equiv="refresh" content="0; url=$option{-goto}">);
      } else {
          $option{-goto} =~ tr/;/&/ if $UA =~ m#Mozilla/[1-4]\.#;
          print qq{Refresh: 0; url="$option{-goto}"\n};
          $option{-goto} = qq(<meta http-equiv="refresh" content="0; url=&quot;@{[&escape($option{-goto})]}&quot;">);
      }
    }
    print qq{Last-Modified: $option{-last_modified}\n} if $option{-last_modified};
    my $meta_ct = '';
    if ($UA =~ m#Mozilla/2#) {
        $meta_ct = qq{text/html; charset=@{[&x_charset($charset)]}};
        print qq{Content-Type: $meta_ct\n};
        $meta_ct = qq{<meta http-equiv="content-type" content="$meta_ct">};
    } elsif ($UA =~ m#Infomosaic#) {
        print qq{Content-Type: text/html\n};
    } else {
        print qq{Content-Type: text/html; charset=$charset\n};
    }
    my $cookedpage = &encode($page);
    my $escapedpage = &escape($page);
    my ($Links, $links) = &make_navigate_links ($page);
    print $Links;
    print <<"EOD";
Content-Language: $lang
Content-Style-Type: text/css

<!--
<!DOCTYPE html
    PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
    "http://www.w3.org/TR/html4/loose.dtd"> + RUBY -->
<html lang="$lang">
<head profile="http://suika.fam.cx/~wakaba/-temp/wiki/wiki?WikiHTMLMetaProfile">
    $meta_ct$option{-goto}
    <title>$escapedpage</title>
    @{[($UA !~ m#Mozilla/[1-4]\.# || $UA =~ m#MSIE (?:[4-9]\.|\d\d)#) ? qq(<link rel="stylesheet" type="text/css" href="@{[&escape($url_stylesheet)]}">) : '']}
    @{[$option{-noindex} ? q(<meta name="ROBOTS" content="NOINDEX">) : '']}
$links
</head>
<body class="$bodyclass">
EOD
  &print_navigate_links ($page);
  print <<EOD;
<h1 class="header">@{[&escape($page)]}</h1>
EOD
}

sub x_charset ($) {
    my $charset = lc shift;
    if ($charset eq 'euc-jp') {
        $charset = 'x-euc-jp';
    } elsif ($charset eq 'shift_jis') {
        $charset = 'x-sjis';
    }
    $charset;
}

sub print_navigate_links (@) {
  my ($page) = @_;
    my $editable = 0;
    my $admineditable = 0;
    if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) {
        $editable = 0;
        #$admineditable = 1;
    } elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) {
        #$admineditable = 1;
        $editable = 1;
    } else {
        $editable = 0;
    }
    my $cookedpage = &encode($page);
  print <<EOH;
<div class="tools">
    @{[ $admineditable
        ? qq(<a title="$resource{admineditthispage}" href="$url_cgi?mycmd=adminedit;mypage=$cookedpage">$resource{admineditbutton}</a> | )
        : qq()
    ]}
    @{[ $editable
        ? #qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">$resource{editbutton} <kbd>E</kbd></a> | )
        qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">�Խ�</a> | )
        : qq()
    ]}
    <a href="$url_cgi?mycmd=read;mypage=$cookedpage;x-param=@{[time.[0..9]->[rand 10]]}">ɽ��</a> | 
    @{[ $admineditable
        ? qq(<a href="$url_cgi?mycmd=diff;mypage=$cookedpage">$resource{diffbutton}</a> | )
        : qq()
    ]}
    <a href="$url_cgi?$CreatePage" class="wiki">����</a> | 
    <a href="$url_cgi?$IndexPage" class="wiki">$resource{indexbutton}</a> | 
    <a href="$url_cgi?$FrontPage" class="wiki">����</a> | 
    <a href="$url_cgi?$SearchPage" class="wiki">$resource{searchbutton}</a> | 
    <a href="$url_cgi?mycmd=RandomJump;x-param=@{[time.[0..9]->[rand 10]]}" class="wiki randomlink">�ɤ���</a> | 
    <a href="$url_cgi?$RecentChanges" class="wiki">�ǿ�</a>