#!/bin/perl
##!perl
#
# wiki.cgi - This is YukiWiki, yet another Wiki clone.
#
# Copyright (C) 2000-2002 by Hiroshi Yuki.
#
# 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.
#
##############################
# Libraries.
use strict;
use lib qw(.);
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Yuki::RSS;
use Yuki::DiffText qw(difftext);
use Yuki::YukiWikiDB;
require 'jcode.pl';
# use Jcode;
use Fcntl;
# Check if the server can use 'AnyDBM_File' or not.
eval 'use AnyDBM_File';
my $error_AnyDBM_File = $@;
my $version = '2.0.5';
##############################
#
# You MUST modify following '$modifier_...' variables.
#
my $modifier_mail = 'tsuruoka@is.s.u-tokyo.ac.jp'; # Your mail address.
my $modifier_url = 'http://www-tsujii.is.s.u-tokyo.ac.jp/~tsuruoka/'; # Your web page.
my $modifier_name = 'Yoshimasa Tsuruoka'; # Your name.
#my $modifier_dbtype = 'AnyDBM_File';
#my $modifier_dbtype = 'dbmopen';
my $modifier_dbtype = 'YukiWikiDB';
# my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail.
my $modifier_sendmail = ''; # If you don't need mail notification.
my $modifier_dir_data = '.'; # Your data directory (not URL, but DIRECTORY).
my $modifier_url_data = '.'; # Your data URL (not DIRECTORY, but URL).
my $modifier_rss_title = "YukiWiki $version";
my $modifier_rss_link = 'http://www.hyuki.com/yukiwiki/wiki.cgi';
my $modifier_rss_description = 'This is YukiWiki, yet another Wiki clone';
##############################
#
# You MAY modify following variables.
#
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 = 'wiki.cgi';
my $url_stylesheet = "$modifier_url_data/wiki.css";
my $icontag = qq();
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 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 = 'FrontPage';
my $IndexPage = 'IndexPage';
my $SearchPage = 'SearchPage';
my $CreatePage = 'CreatePage';
my $ErrorPage = 'ErrorPage';
my $RssPage = 'RssPage';
my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.
##############################
my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]+)+)\b';
my $bracket_name = '\[\[(\S+?)\]\]';
my $embedded_name = '\[\[(#\S+?)\]\]';
my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]';
my $interwiki_name = '([^:]+):([^:].*)';
##############################
my $embed_comment = '[[#comment]]';
my $embed_rcomment = '[[#rcomment]]';
##############################
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,
);
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',
);
my %command_do = (
read => \&do_read,
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,
rss => \&do_rss,
diff => \&do_diff,
);
##############################
# &test_convert;
&main;
exit(0);
##############################
sub main {
&init_resource;
&check_modifiers;
&open_db;
&init_form;
&init_InterWikiName;
if ($command_do{$form{mycmd}}) {
&{$command_do{$form{mycmd}}};
} else {
&do_FrontPage;
}
&close_db;
}
sub do_read {
&print_header($form{mypage});
&print_content($database{$form{mypage}});
&print_footer($form{mypage});
}
sub do_edit {
my ($page) = &unarmor_name(&armor_name($form{mypage}));
&print_header($page);
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);
}
&print_footer($page);
}
sub do_adminedit {
my ($page) = &unarmor_name(&armor_name($form{mypage}));
&print_header($page);
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);
&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);
&print_message($resource{passwordchanged});
&print_footer($CompletedSuccessfully);
}
sub do_index {
&print_header($IndexPage);
print qq(
);
foreach my $page (sort keys %database) {
if (&is_editable($page)) {
print qq(
'));
# XXXXX
#######
} else {
push(@result, &inline($_));
}
}
push(@result, splice(@saved));
if ($option{toc}) {
# Convert @toc (table of contents) to HTML.
# This part is taken from Makio Tsukamoto's WalWiki.
my (@tocsaved, @tocresult);
foreach (@toc) {
if (/^(-{1,3})(.*)/) {
&back_push('ul', length($1), \@tocsaved, \@tocresult);
push(@tocresult, '
' . $2 . '
');
}
}
push(@tocresult, splice(@tocsaved));
return join("\n", @tocresult, @result);
} else {
return join("\n", @result);
}
}
sub back_push {
my ($tag, $level, $savedref, $resultref, $attr) = @_;
while (@$savedref > $level) {
push(@$resultref, shift(@$savedref));
}
if ($savedref->[0] ne "$tag>") {
push(@$resultref, splice(@$savedref));
}
while (@$savedref < $level) {
unshift(@$savedref, "$tag>");
push(@$resultref, "<$tag$attr>");
}
}
sub inline {
my ($line) = @_;
$line = &escape($line);
$line =~ s|'''([^']+?)'''|$1|g; # Italic
$line =~ s|''([^']+?)''|$1|g; # Bold
$line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|$1|g; # Date
$line =~ s!
(
((mailto|http|https|ftp):([^\x00-\x20()<>\x7F-\xFF])*) # Direct http://...
|
($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]]
|
($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]]
|
($wiki_name) # LocalLinkLikeThis
)
!
&make_link($1)
!gex;
return $line;
}
sub make_link {
my $chunk = shift;
if ($chunk =~ /^(http|https|ftp):/) {
if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) {
return qq();
} else {
return qq($chunk);
}
} elsif ($chunk =~ /^(mailto):(.*)/) {
return qq($2);
} elsif ($chunk =~ /^$interwiki_definition$/) {
return qq($chunk);
} elsif ($chunk =~ /^$embedded_name$/) {
return &embedded_to_html($chunk);
} else {
$chunk = &unarmor_name($chunk);
$chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly.
my $cookedchunk = &encode($chunk);
my $escapedchunk = &escape($chunk);
if ($chunk =~ /^$interwiki_name$/) {
my ($intername, $localname) = ($1, $2);
my $remoteurl = $interwiki{$intername};
if ($remoteurl) {
$remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e;
return qq($escapedchunk);
} else {
return $escapedchunk;
}
} elsif ($database{$chunk}) {
my $subject = &escape(&get_subjectline($chunk, delimiter => ''));
return qq($escapedchunk);
} elsif ($page_command{$chunk}) {
return qq($escapedchunk);
} else {
return qq($escapedchunk$editchar);
}
}
}
sub print_message {
my ($msg) = @_;
print qq(
$msg
);
}
sub init_form {
if (param()) {
foreach my $var (param()) {
$form{$var} = param($var);
}
} else {
$ENV{QUERY_STRING} = $FrontPage;
}
my $query = &decode($ENV{QUERY_STRING});
if ($page_command{$query}) {
$form{mycmd} = $page_command{$query};
$form{mypage} = $query;
} elsif ($query =~ /^($wiki_name)$/) {
$form{mycmd} = 'read';
$form{mypage} = $1;
} elsif ($database{$query}) {
$form{mycmd} = 'read';
$form{mypage} = $query;
}
# mypreview_edit -> do_edit, with preview.
# mypreview_adminedit -> do_adminedit, with preview.
# mypreview_write -> do_write, without preview.
foreach (keys %form) {
if (/^mypreview_(.*)$/) {
$form{mycmd} = $1;
$form{mypreview} = 1;
}
}
#
# $form{mycmd} is frozen here.
#
$form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
$form{myname} = &code_convert(\$form{myname}, $kanjicode);
}
sub update_recent_changes {
my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}";
my @oldupdates = split(/\r?\n/, $database{$RecentChanges});
my @updates;
foreach (@oldupdates) {
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
my $name = &unarmor_name($1);
if (&is_exist_page($name) and ($name ne $form{mypage})) {
push(@updates, $_);
}
}
if (&is_exist_page($form{mypage})) {
unshift(@updates, $update);
}
splice(@updates, $maxrecent + 1);
$database{$RecentChanges} = join("\n", @updates);
if ($file_touch) {
open(FILE, "> $file_touch");
print FILE localtime() . "\n";
close(FILE);
}
}
sub get_subjectline {
my ($page, %option) = @_;
if (not &is_editable($page)) {
return "";
} else {
# Delimiter check.
my $delim = $subject_delimiter;
if (defined($option{delimiter})) {
$delim = $option{delimiter};
}
# Get the subject of the page.
my $subject = $database{$page};
$subject =~ s/\r?\n.*//s;
return "$delim$subject";
}
}
sub send_mail_to_admin {
my ($page, $mode) = @_;
return unless $modifier_sendmail;
my $message = <<"EOD";
To: $modifier_mail
From: $modifier_mail
Subject: [Wiki]
MIME-Version: 1.0
Content-Type: text/plain; charset=ISO-2022-JP
Content-Transfer-Encoding: 7bit
--------
MODE = $mode
REMOTE_ADDR = $ENV{REMOTE_ADDR}
REMOTE_HOST = $ENV{REMOTE_HOST}
--------
$page
--------
$database{$page}
--------
EOD
&code_convert(\$message, 'jis');
open(MAIL, "| $modifier_sendmail");
print MAIL $message;
close(MAIL);
}
sub open_db {
if ($modifier_dbtype eq 'dbmopen') {
dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");
dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");
} elsif ($modifier_dbtype eq 'AnyDBM_File') {
tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname");
tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname");
} else {
tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname");
tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname");
}
}
sub close_db {
if ($modifier_dbtype eq 'dbmopen') {
dbmclose(%database);
dbmclose(%infobase);
} elsif ($modifier_dbtype eq 'AnyDBM_File') {
untie(%database);
untie(%infobase);
} else {
untie(%database);
untie(%infobase);
}
}
sub open_diff {
if ($modifier_dbtype eq 'dbmopen') {
dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname");
} elsif ($modifier_dbtype eq 'AnyDBM_File') {
tie(%diffbase, "AnyDBM_File", $diffname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $diffname");
} else {
tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname");
}
}
sub close_diff {
if ($modifier_dbtype eq 'dbmopen') {
dbmclose(%diffbase);
} elsif ($modifier_dbtype eq 'AnyDBM_File') {
untie(%diffbase);
} else {
untie(%diffbase);
}
}
sub print_searchform {
my ($word) = @_;
print <<"EOD";
EOD
}
sub print_editform {
my ($mymsg, $lastmodified, %mode) = @_;
my $frozen = &is_frozen($form{mypage});
if ($form{mypreview}) {
if ($form{mymsg}) {
unless ($mode{conflict}) {
print qq(
);
print qq();
&print_footer($title);
}
sub do_rss {
my $rss = new Yuki::RSS(
version => '1.0',
encoding => $charset,
);
$rss->channel(
title => $modifier_rss_title,
link => $modifier_rss_link,
description => $modifier_rss_description,
);
my $recentchanges = $database{$RecentChanges};
my $count = 0;
foreach (split(/\n/, $recentchanges)) {
last if ($count >= 15);
/^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
my $title = &unarmor_name($1);
my $escaped_title = &escape($title);
my $link = $modifier_rss_link . '?' . &encode($title);
my $description = $escaped_title . &escape(&get_subjectline($title));
$rss->add_item(
title => $escaped_title,
link => $link,
description => $description,
);
$count++;
}
# print RSS information (as XML).
print <<"EOD"
Content-type: text/xml
@{[$rss->as_string]}
EOD
}
sub is_exist_page {
my ($name) = @_;
if ($use_exists) {
return exists($database{$name});
} else {
return $database{$name};
}
}
sub check_modifiers {
if ($error_AnyDBM_File and $modifier_dbtype eq 'AnyDBM_File') {
&print_error($resource{anydbmfileerror});
}
}
1;
__END__
=head1 NAME
wiki.cgi - This is YukiWiki, yet another Wiki clone.
=head1 DESCRIPTION
YukiWiki is yet another Wiki clone.
YukiWiki can treat Japanese WikiNames (enclosed with [[ and ]]).
YukiWiki provides 'InterWiki' feature, RDF Site Summary (RSS),
and some embedded commands (such as [[#comment]] to add comments).
Read F (English) or F (Japanese) in more detail.
=head1 AUTHOR
Hiroshi Yuki http://www.hyuki.com/yukiwiki/
=head1 LICENSE
Copyright (C) 2000-2002 by Hiroshi Yuki.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut