/[pub]/suikawiki/script/wiki.cgi
Suika

Contents of /suikawiki/script/wiki.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.23 - (hide annotations) (download)
Sun Aug 18 04:14:35 2002 UTC (22 years, 3 months ago) by wakaba
Branch: MAIN
Changes since 1.22: +11 -10 lines
2002-06-18  Wakaba <w@suika.fam.cx>

	* wiki.cgi: Fix cross site scripting problems.

1 wakaba 1.9 #!/usr/bin/perl
2 wakaba 1.16 #!perl
3 wakaba 1.9 #
4 wakaba 1.16 # wiki.cgi - This is YukiWiki, yet another Wiki clone.
5 wakaba 1.9 #
6 wakaba 1.16 # Copyright (C) 2000-2002 by Hiroshi Yuki.
7 wakaba 1.9 # <hyuki@hyuki.com>
8     # http://www.hyuki.com/yukiwiki/
9     #
10 wakaba 1.16 # This program is free software; you can redistribute it and/or
11     # modify it under the same terms as Perl itself.
12 wakaba 1.9 #
13 wakaba 1.16 ##############################
14     #
15     # walwiki.cgi based on yukiwiki.cgi - Yet another WikiWikiWeb clone.
16     #
17     # WalWikiの現バージョンは、YukiWiki 2.0.beta1をベースにしています。
18     #
19     # * 更新内容
20     #
21     # 2.0.beta1.wal.1 on 2002/05/19,22:32:19
22     # (1) Footerの変更
23     # (2) WikiNameの拡張 : PerlCEも包含、PPMInstallは含まない
24     # (3) 別名リンク([別名 URL])に対応。
25     # (4) ISBNをアマゾン.jpのAsociateプログラムリンクに変換。
26     # (5) [[#box:InterWikiName]]でInterWikiなテキストボックス生成
27     # (6) HTMLモード対応。
28     #
29     # 旧2.0.alpha0.wal.3版までの修正の内、以下に変更があります。
30     # ・以下はYukiWiki2に実装されたため、独自コードはなくなりました。
31     # - インラインの画像変換
32     # - YukiWikiDB対応
33     # - テーブル
34     # - DB関連モジュールuseのeval化
35     # - BracketNameによるキーからブラケットを排除
36     # ・ISBN番号への対応はWalWiki2.0より、InterWikiへのAdd-Onになりました。
37     # [[ISBN http://www.amazon.co.jp/exec/obidos/ASIN/isbn($1)/walrdigi-22]]のように登録。
38 wakaba 1.9 #
39 wakaba 1.16 #=======================================
40    
41     # Walrus add (debug) start
42     my $walrus_log;
43     my $walrus_debugging = 0;
44     # Walrus add (debug) end
45    
46     # Libraries.
47     use strict;
48     use lib qw(./WalWiki/lib);
49     use CGI qw(:standard);
50     use CGI::Carp qw(fatalsToBrowser);
51     use Yuki::RSS;
52     use Yuki::DiffText qw(difftext);
53     use Yuki::YukiWikiDB;
54     use AnyDBM_File;
55     require 'jcode.pl';
56     # use Jcode;
57     use Fcntl;
58     my $version = '2.0.beta1.2002-05-29';
59 wakaba 1.17 my $walversion;
60 wakaba 1.9 ##############################
61 wakaba 1.16 #
62     # You MUST modify following '$modifier_...' variables.
63     #
64     my $modifier_mail = 'w@suika.fam.cx'; # Your mail address, like 'walrus@digit.que.ne.jp'.
65     my $modifier_url = 'http://suika.fam.cx/~wakaba/'; # Your web page, like 'http://digit.que.ne.jp/work/'.
66     my $modifier_name = '和'; # Your name, like 'Makio Tsukamoto'.
67     # my $modifier_dbtype = 'AnyDBM_File'; # Fast, not available on some server, page size limited.
68     # my $modifier_dbtype = 'dbmopen'; # Fast, not available on some server, page size limited.
69     my $modifier_dbtype = 'YukiWikiDB'; # Slow, available on all environment.
70     # my $modifier_sendmail = '/usr/sbin/sendmail -t -n'; # Your sendmail.
71     my $modifier_sendmail = ''; # If you don't need mail notification.
72 wakaba 1.17 my $modifier_dir_data = './wikidata'; # Your data directory.
73 wakaba 1.16 my $modifier_rss_title = "WalWiki $walversion";
74     my $modifier_rss_link = 'http://suika.fam.cx/~wakaba/-temp/wiki2/wiki'; # Blank is not allowed.
75     my $modifier_rss_description = 'This is WalWiki, yet another Wiki clone based on YukiWiki';
76 wakaba 1.9 ##############################
77 wakaba 1.16 #
78     # You MAY modify following variables.
79     #
80     my $file_touch = "$modifier_dir_data/touched.txt";
81     my $file_resource = "$modifier_dir_data/resource.txt";
82     my $file_FrontPage = "$modifier_dir_data/frontpage.txt";
83     my $file_conflict = "$modifier_dir_data/conflict.txt";
84     my $file_format = "$modifier_dir_data/format.txt";
85     my $url_cgi = 'wiki';
86 wakaba 1.18 my $url_stylesheet = 'wiki-style.css';
87 wakaba 1.16 my $icontag = '<img src="/icons/folder" alt="*" width="40" height="40" />';
88     my $maxrecent = 50;
89 wakaba 1.9 my $cols = 80;
90     my $rows = 20;
91     ##############################
92 wakaba 1.16 #
93     # You MAY, but do NOT NEED modify following variables.
94     #
95     my $dataname = "$modifier_dir_data/wiki";
96     my $infoname = "$modifier_dir_data/info";
97     my $diffname = "$modifier_dir_data/diff";
98     my $editchar = '?';
99     my $subject_delimiter = ' - ';
100     my $use_autoimg = 1; # automatically convert image URL into <img> tag.
101     my $use_exists = 0; # If you can use 'exists' method for your DB.
102     ##############################
103     my $InterWikiName = 'InterWikiName';
104     my $RecentChanges = 'RecentChanges';
105     my $AdminChangePassword = 'AdminChangePassword';
106     my $CompletedSuccessfully = 'CompletedSuccessfully';
107 wakaba 1.18 my $FrontPage = 'HomePage';
108 wakaba 1.16 my $IndexPage = 'IndexPage';
109     my $SearchPage = 'SearchPage';
110     my $CreatePage = 'CreatePage';
111     my $ErrorPage = 'ErrorPage';
112     my $RssPage = 'RssPage';
113     my $AdminSpecialPage = 'Admin Special Page'; # must include spaces.
114     ##############################
115     # my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]+)+)\b'; # Walrus del (2)
116     my $wiki_name = '\b([A-Z][a-z]+([A-Z][a-z]*)+)\b'; # Walrus add (2)
117     my $bracket_name = '\[\[(\S+?)\]\]';
118     my $embedded_name = '\[\[(#\S+?)\]\]';
119     my $interwiki_definition = '\[\[(\S+?)\ (\S+?)\]\]';
120 wakaba 1.22 my $interwiki_name = '([^:]+):i:([^:].*)';
121 wakaba 1.16 ##############################
122     my $embed_comment = '[[#comment]]';
123     my $embed_rcomment = '[[#rcomment]]';
124     my $embed_interwiki = '^\[\[#(box|text|password):(\S+)\]\]$'; # Walrus add (5)
125 wakaba 1.22 my %embed_command = (
126     searched => '^\[\[#searched:([^\]]+)\]\]$',
127     );
128 wakaba 1.16 ##############################
129     my $info_LastModified = 'LastModified';
130     my $info_IsFrozen = 'IsFrozen';
131     my $info_AdminPassword = 'AdminPassword';
132     ##############################
133     my $kanjicode = 'euc';
134     my $charset = 'EUC-JP';
135     my $lang = 'ja';
136     my %fixedpage = (
137     $IndexPage => 1,
138     $CreatePage => 1,
139     $ErrorPage => 1,
140     $RssPage => 1,
141     $RecentChanges => 1,
142     $SearchPage => 1,
143     $AdminChangePassword => 1,
144     $CompletedSuccessfully => 1,
145 wakaba 1.18 #$FrontPage => 1,
146 wakaba 1.16 );
147     my %form;
148     my %database;
149     my %infobase;
150     my %diffbase;
151     my %resource;
152     my %interwiki;
153     ##############################
154     my %page_command = (
155     $IndexPage => 'index',
156     $SearchPage => 'searchform',
157     $CreatePage => 'create',
158     $RssPage => 'rss',
159     $AdminChangePassword => 'adminchangepasswordform',
160 wakaba 1.18 #$FrontPage => 'FrontPage',
161 wakaba 1.16 );
162     my %command_do = (
163     read => \&do_read,
164     edit => \&do_edit,
165     adminedit => \&do_adminedit,
166     adminchangepasswordform => \&do_adminchangepasswordform,
167     adminchangepassword => \&do_adminchangepassword,
168     write => \&do_write,
169     index => \&do_index,
170     searchform => \&do_searchform,
171     search => \&do_search,
172     create => \&do_create,
173     createresult => \&do_createresult,
174     FrontPage => \&do_FrontPage,
175     comment => \&do_comment,
176     rss => \&do_rss,
177     diff => \&do_diff,
178     interwikibox => \&do_interwiki_box, # Walrus add (5)
179     );
180     ##############################
181     my @ignore_html_page = ('FrontPage'); # Walrus add (6)
182     my @ignore_html_tags = ('a', 'br', 'img'); # Walrus add (6)
183     my $walversion = '2.0.beta1.wal.1'; # Walrus add (1)
184 wakaba 1.9 ##############################
185 wakaba 1.16 # &test_convert;
186 wakaba 1.9 &main;
187     exit(0);
188 wakaba 1.16 ##############################
189 wakaba 1.9
190     sub main {
191 wakaba 1.16 &init_resource;
192     &open_db;
193     &init_form;
194     &init_InterWikiName;
195     if ($command_do{$form{mycmd}}) {
196     &{$command_do{$form{mycmd}}};
197 wakaba 1.9 } else {
198 wakaba 1.16 &do_FrontPage;
199 wakaba 1.9 }
200 wakaba 1.16 &close_db;
201 wakaba 1.9 }
202    
203     sub do_read {
204 wakaba 1.16 &print_header($form{mypage});
205     &print_content($database{$form{mypage}});
206 wakaba 1.22 my ($r, $c) = get_search_result ($form{mypage});
207     if ($c) {
208     print q{<h2>See also</h2>};
209     print $r;
210     }
211 wakaba 1.16 &print_footer($form{mypage});
212 wakaba 1.9 }
213    
214     sub do_edit {
215 wakaba 1.16 my ($page) = &unarmor_name(&armor_name($form{mypage}));
216     &print_header($page);
217     if (not &is_editable($page)) {
218     &print_message($resource{cantchange});
219     } elsif (&is_frozen($page)) {
220     &print_message($resource{cantchange});
221     } else {
222     &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>0);
223 wakaba 1.9 }
224 wakaba 1.16 &print_footer($page);
225 wakaba 1.9 }
226    
227 wakaba 1.16 sub do_adminedit {
228     my ($page) = &unarmor_name(&armor_name($form{mypage}));
229     &print_header($page);
230     if (not &is_editable($page)) {
231     &print_message($resource{cantchange});
232 wakaba 1.9 } else {
233 wakaba 1.16 &print_message($resource{passwordneeded});
234     &print_editform($database{$page}, &get_info($page, $info_LastModified), admin=>1);
235 wakaba 1.9 }
236 wakaba 1.16 &print_footer($page);
237 wakaba 1.9 }
238    
239 wakaba 1.16 sub do_adminchangepasswordform {
240     &print_header($AdminChangePassword);
241     &print_passwordform;
242     &print_footer($AdminChangePassword);
243     }
244 wakaba 1.9
245 wakaba 1.16 sub do_adminchangepassword {
246     if ($form{mynewpassword} ne $form{mynewpassword2}) {
247     &print_error($resource{passwordmismatcherror});
248     }
249     my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword);
250     if ($validpassword_crypt) {
251     if (not &valid_password($form{myoldpassword})) {
252     &send_mail_to_admin(<<"EOD", "AdminChangePassword");
253     myoldpassword=$form{myoldpassword}
254     mynewpassword=$form{mynewpassword}
255     mynewpassword2=$form{mynewpassword2}
256 wakaba 1.9 EOD
257 wakaba 1.16 &print_error($resource{passworderror});
258 wakaba 1.9 }
259 wakaba 1.16 }
260     my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
261     my (@token) = ('0'..'9', 'A'..'Z', 'a'..'z');
262     my $salt1 = $token[(time | $$) % scalar(@token)];
263     my $salt2 = $token[($sec + $min*60 + $hour*60*60) % scalar(@token)];
264     my $crypted = crypt($form{mynewpassword}, "$salt1$salt2");
265     &set_info($AdminSpecialPage, $info_AdminPassword, $crypted);
266    
267     &print_header($CompletedSuccessfully);
268     &print_message($resource{passwordchanged});
269     &print_footer($CompletedSuccessfully);
270     }
271    
272     sub do_index {
273     &print_header($IndexPage);
274     print qq(<ul>);
275     foreach my $page (sort keys %database) {
276     if (&is_editable($page)) {
277     print qq(<li><a href="$url_cgi?@{[&encode($page)]}">$page</a>@{[&escape(&get_subjectline($page))]}</li>);
278     # print qq(<li>@{[&get_info($page, $info_IsFrozen)]}</li>);
279     # print qq(<li>@{[0 + &is_frozen($page)]}</li>);
280 wakaba 1.9 }
281     }
282 wakaba 1.16 print qq(</ul>);
283     &print_footer($IndexPage);
284 wakaba 1.9 }
285    
286 wakaba 1.16 sub do_write {
287     if (&frozen_reject()) {
288     return;
289 wakaba 1.9 }
290    
291     if (not &is_editable($form{mypage})) {
292 wakaba 1.16 &print_header($form{mypage});
293     &print_message($resource{cantchange});
294     &print_footer($form{mypage});
295 wakaba 1.9 return;
296     }
297    
298 wakaba 1.16 if (&conflict($form{mypage}, $form{mymsg})) {
299 wakaba 1.9 return;
300     }
301    
302 wakaba 1.16 # Making diff
303 wakaba 1.9 {
304 wakaba 1.16 &open_diff;
305     my @msg1 = split(/\n/, $database{$form{mypage}});
306 wakaba 1.9 my @msg2 = split(/\n/, $form{mymsg});
307 wakaba 1.16 $diffbase{$form{mypage}} = &difftext(\@msg1, \@msg2);
308     &close_diff;
309 wakaba 1.9 }
310    
311     if ($form{mymsg}) {
312 wakaba 1.16 $database{$form{mypage}} = $form{mymsg};
313     &send_mail_to_admin($form{mypage}, "Modify");
314     if ($form{mytouch}) {
315     &set_info($form{mypage}, $info_LastModified, '' . localtime);
316     &update_recent_changes;
317     }
318     &set_info($form{mypage}, $info_IsFrozen, 0 + $form{myfrozen});
319 wakaba 1.22 &print_header($CompletedSuccessfully, -goto => $url_cgi.'?'.&encode($form{mypage}));
320 wakaba 1.16 &print_message($resource{saved});
321     &print_content("$resource{continuereading} @{[&armor_name($form{mypage})]}");
322     &print_footer($CompletedSuccessfully);
323     } else {
324     &send_mail_to_admin($form{mypage}, "Delete");
325     delete $database{$form{mypage}};
326     delete $infobase{$form{mypage}};
327     if ($form{mytouch}) {
328     &update_recent_changes;
329     }
330     &print_header($form{mypage});
331     &print_message($resource{deleted});
332     &print_footer($form{mypage});
333 wakaba 1.9 }
334     }
335    
336 wakaba 1.16 sub do_searchform {
337     &print_header($SearchPage);
338     &print_searchform("");
339     &print_footer($SearchPage);
340 wakaba 1.9 }
341    
342 wakaba 1.16 sub do_search {
343 wakaba 1.22 my $word = $form{mymsg};
344 wakaba 1.16 &print_header($SearchPage);
345 wakaba 1.22 &print_searchform(&escape($word));
346     print get_search_result ($word, -output_not_found => 1);
347 wakaba 1.23 print "foo";
348 wakaba 1.16 &print_footer($SearchPage);
349 wakaba 1.9 }
350    
351 wakaba 1.22 sub get_search_result ($;%) {
352     my $word = shift;
353     my %option = @_;
354     my $counter = 0;
355     my $r = '';
356     foreach my $page (sort keys %database) {
357     next if $page eq $RecentChanges;
358     if ( index ($database{$page}, $word) > 0
359     || index ($page, $word) > 0
360     || index ($word, $page) > 0
361     ) {
362 wakaba 1.23 $r .= qq(<li><a href ="$url_cgi?@{[&escape(&encode($page))]}">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</li>);
363 wakaba 1.22 $counter++;
364     }
365     }
366     $r = qq|<ul>$r</ul>| if $r;
367     get_message ($resource{notfound})
368     if $counter == 0 && $option{-output_not_found};
369     wantarray? ($r, $counter): $r;
370     }
371    
372 wakaba 1.16 sub do_create {
373     &print_header($CreatePage);
374     print <<"EOD";
375     <form action="$url_cgi" method="post">
376     <input type="hidden" name="mycmd" value="edit">
377     <strong>$resource{newpagename}</strong><br>
378     <input type="text" name="mypage" value="" size="20">
379     <input type="submit" value="$resource{createbutton}"><br>
380     </form>
381     EOD
382     &print_footer($CreatePage);
383 wakaba 1.9 }
384    
385 wakaba 1.16 sub do_FrontPage {
386     open(FILE, $file_FrontPage) or &print_error("($file_FrontPage)");
387     my $content = join('', <FILE>);
388     &code_convert(\$content, $kanjicode);
389     close(FILE);
390     &print_header($FrontPage);
391     &print_content($content);
392     &print_footer($FrontPage);
393 wakaba 1.9 }
394    
395     sub print_error {
396     my ($msg) = @_;
397 wakaba 1.16 &print_header($ErrorPage);
398     print qq(<p><strong class="error">$msg</strong></p>);
399     &print_footer($ErrorPage);
400 wakaba 1.9 exit(0);
401     }
402    
403 wakaba 1.16 sub print_header {
404 wakaba 1.22 my ($page,%option) = @_;
405 wakaba 1.16 my $bodyclass = "normal";
406     if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) {
407     $bodyclass = "frozen";
408 wakaba 1.22 }
409     if ($option{-goto}) {
410     print qq{Refresh: 0; url="$option{-goto}"\n};
411 wakaba 1.9 }
412 wakaba 1.16 my $cookedpage = &encode($page);
413 wakaba 1.9 print <<"EOD";
414 wakaba 1.16 Content-type: text/html; charset=$charset
415 wakaba 1.18 Content-Language: $lang
416     Content-Style-Type: text/css
417 wakaba 1.9
418 wakaba 1.16 <!DOCTYPE html
419     PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
420     "http://www.w3.org/TR/html4/loose.dtd">
421     <html lang="$lang">
422     <head>
423 wakaba 1.23 <title>@{[&escape($page.' '.&get_subjectline($page))]}</title>
424 wakaba 1.16 <link rel="index" href="$url_cgi?$IndexPage">
425     <link rev="made" href="mailto:$modifier_mail">
426     <link rel="stylesheet" type="text/css" href="$url_stylesheet">
427 wakaba 1.9 </head>
428 wakaba 1.16 <body class="$bodyclass">
429 wakaba 1.22 EOD
430     &print_navigate_links ($page);
431     print <<EOD;
432     <h1 class="header"><a
433     title="$resource{searchthispage}"
434 wakaba 1.23 href="$url_cgi?mycmd=search;mymsg=$cookedpage">@{[&escape($page)]}</a>@{[&escape(&get_subjectline($page))]}</h1>
435 wakaba 1.22 EOD
436     }
437    
438     sub print_navigate_links (@) {
439     my ($page) = @_;
440     my $editable = 0;
441     my $admineditable = 0;
442     if (&is_frozen($page) and $form{mycmd} =~ /^(read|write)$/) {
443     $editable = 0;
444     $admineditable = 1;
445     } elsif (&is_editable($page) and $form{mycmd} =~ /^(read|write)$/) {
446     $admineditable = 1;
447     $editable = 1;
448     } else {
449     $editable = 0;
450     }
451     my $cookedpage = &encode($page);
452     print <<EOH;
453 wakaba 1.16 <div class="tools">
454     @{[ $admineditable
455     ? qq(<a title="$resource{admineditthispage}" href="$url_cgi?mycmd=adminedit;mypage=$cookedpage">$resource{admineditbutton}</a> | )
456     : qq()
457     ]}
458     @{[ $editable
459 wakaba 1.22 ? qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedpage" accesskey="E">$resource{editbutton} <kbd>E</kbd></a> | )
460 wakaba 1.16 : qq()
461     ]}
462     @{[ $admineditable
463     ? qq(<a href="$url_cgi?mycmd=diff;mypage=$cookedpage">$resource{diffbutton}</a> | )
464     : qq()
465     ]}
466     <a href="$url_cgi?$CreatePage">$resource{createbutton}</a> |
467     <a href="$url_cgi?$IndexPage">$resource{indexbutton}</a> |
468     <a href="$url_cgi?$RssPage">$resource{rssbutton}</a> |
469     <a href="$url_cgi?$FrontPage">$FrontPage</a> |
470     <a href="$url_cgi?$SearchPage">$resource{searchbutton}</a> |
471     <a href="$url_cgi?$RecentChanges">$resource{recentchangesbutton}</a>
472     </div>
473 wakaba 1.22 EOH
474 wakaba 1.9 }
475    
476 wakaba 1.16 sub print_footer {
477     my ($page) = @_;
478     $walrus_log = ($walrus_debugging) ? &text_to_html("----\n$walrus_log") : ''; # Walrus add (debug)
479     # Walrus mod (1) start
480 wakaba 1.23 my $cvslog = '$Revision: 1.22 $ $Date: 2002/06/30 07:52:46 $';
481 wakaba 1.22 print_navigate_links ($page);
482     print <<"EOD";
483 wakaba 1.16 <div class="footer">
484 wakaba 1.9 <p>
485 wakaba 1.16 <a href="http://digit.que.ne.jp/work/">WalWiki</a> $walversion &copy; 2000-2002 by <a href="http://digit.que.ne.jp/">Makio Tsukamoto</a>.<br />
486     based on <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version &copy; 2000-2002 by <a href="http://www.hyuki.com/">Hiroshi Yuki</a>.<br />
487 wakaba 1.18 <a href="/gate/cvs/wakaba/wiki/" title="CVS Repository">
488 wakaba 1.19 $cvslog
489 wakaba 1.18 </a>
490 wakaba 1.9 </p>
491 wakaba 1.18 <div class="navigation">
492     [<a href="/" title="このサーバーの首頁">/</a>
493     <a href="/map" title="このサーバーの案内">地図</a>
494     <a href="/search/" title="このサーバーの検索">検索</a>]
495     </div>
496 wakaba 1.10 </div>
497 wakaba 1.19 $walrus_log
498 wakaba 1.16 </body>
499     </html>
500 wakaba 1.12 EOD
501 wakaba 1.16 # print <<"EOD";
502     # <hr>
503     # <address class="footer">
504     # <a href="http://www.hyuki.com/yukiwiki/">YukiWiki</a> $version
505     # &copy; 2000-2002 by <a href="http://www.hyuki.com/">Hiroshi Yuki</a>.<br />
506     # Modified by <a href="$modifier_url">$modifier_name</a>.
507     # </address>
508     # <p class="footer">
509     # <a href="http://www.hyuki.com/yukiwiki/">$icontag</a>
510     # </p>
511     # </body>
512     # </html>
513     # EOD
514     # Walrus mod (1) end
515 wakaba 1.9 }
516    
517 wakaba 1.16 sub escape {
518     my $s = shift;
519     $s =~ s|\r\n|\n|g;
520 wakaba 1.23 $s =~ s|&|&amp;|g;
521 wakaba 1.16 $s =~ s|<|&lt;|g;
522     $s =~ s|>|&gt;|g;
523     $s =~ s|"|&quot;|g;
524     return $s;
525     }
526    
527     sub unescape {
528     my $s = shift;
529     # $s =~ s|\n|\r\n|g;
530 wakaba 1.23 $s =~ s|&lt;|<|g;
531     $s =~ s|&gt;|>|g;
532     $s =~ s|&quot;|"|g;
533     $s =~ s|&amp;|&|g;
534 wakaba 1.16 return $s;
535     }
536    
537     sub print_content {
538     my ($rawcontent) = @_;
539     print &text_to_html($rawcontent, toc=>1);
540 wakaba 1.9 }
541    
542 wakaba 1.16 sub text_to_html {
543     my ($txt, %option) = @_;
544 wakaba 1.9 my (@txt) = split(/\n/, $txt);
545 wakaba 1.16 my (@toc);
546     my $tocnum = 0;
547     my (@saved, @result);
548     unshift(@saved, "</p>");
549     push(@result, "<p>");
550 wakaba 1.9 foreach (@txt) {
551     chomp;
552 wakaba 1.16 # Walrus mod (6) start
553 wakaba 1.19 #if ($saved[0] eq '</html>') {
554     # if (/<\/html>/i) { splice(@saved); }
555     # else { push (@result, &html_to_ignored_html($_)); }
556     #} elsif (/^<html>/i and &is_ignore_html($form{mypage})) {
557     # push(@result, splice(@saved));
558     # push(@saved, '</html>');
559     #} els
560 wakaba 1.18 if (/^\*\*\*\*\*(.*)/) {
561     push(@toc, qq(-- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
562     push(@result, splice(@saved), qq(<h6 id="i$tocnum">) . &inline($1) . '</h6>');
563     $tocnum++;
564     } elsif (/^\*\*\*\*(.*)/) {
565     push(@toc, qq(-- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
566     push(@result, splice(@saved), qq(<h5 id="i$tocnum">) . &inline($1) . '</h5>');
567     $tocnum++;
568     } elsif (/^\*\*\*(.*)/) {
569     push(@toc, qq(-- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
570     push(@result, splice(@saved), qq(<h4 id="i$tocnum">) . &inline($1) . '</h4>');
571     $tocnum++;
572 wakaba 1.13 } elsif (/^\*\*(.*)/) {
573 wakaba 1.16 # if (/^\*\*(.*)/) {
574     # Walrus mod (6) end
575     push(@toc, qq(-- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
576     push(@result, splice(@saved), qq(<h3><a name="i$tocnum"> </a>) . &inline($1) . '</h3>');
577     $tocnum++;
578 wakaba 1.9 } elsif (/^\*(.*)/) {
579 wakaba 1.16 push(@toc, qq(- <a href="#i$tocnum">@{[&escape($1)]}</a>\n));
580     push(@result, splice(@saved), qq(<h2><a name="i$tocnum"> </a>) . &inline($1) . '</h2>');
581     $tocnum++;
582 wakaba 1.18 #} elsif (/^----/) {
583     # push(@result, splice(@saved), '<hr>');
584     } elsif (/^(={1,5})(.*)/) {
585     &back_push('ol', length($1), \@saved, \@result);
586     push(@result, '<li>' . &inline($2) . '</li>');
587     } elsif (/^(-{1,5})(.*)/) {
588 wakaba 1.16 &back_push('ul', length($1), \@saved, \@result);
589 wakaba 1.13 push(@result, '<li>' . &inline($2) . '</li>');
590 wakaba 1.9 } elsif (/^:([^:]+):(.*)/) {
591 wakaba 1.16 &back_push('dl', 1, \@saved, \@result);
592 wakaba 1.9 push(@result, '<dt>' . &inline($1) . '</dt>', '<dd>' . &inline($2) . '</dd>');
593 wakaba 1.18 } elsif (/^(>{1,5})(.*)/) {
594 wakaba 1.16 &back_push('blockquote', length($1), \@saved, \@result);
595 wakaba 1.9 push(@result, &inline($2));
596     } elsif (/^\s*$/) {
597     push(@result, splice(@saved));
598     unshift(@saved, "</p>");
599     push(@result, "<p>");
600     } elsif (/^(\s+.*)$/) {
601 wakaba 1.16 &back_push('pre', 1, \@saved, \@result);
602 wakaba 1.18 #push(@result, &escape($1)); # Not &inline, but &escape
603     push(@result, &inline($1)); # Not &inline, but &escape
604 wakaba 1.16 # } elsif (/^\,(.*)$/) { # Walrus del (BF)
605     } elsif (/^\,(.*?)[\x0D\x0A]*$/) { # Walrus add (BF)
606     &back_push('table', 1, \@saved, \@result, ' border="1"');
607     #######
608     # This part is taken from Mr. Ohzaki's Perl Memo and Makio Tsukamoto's WalWiki.
609     # XXXXX
610     my $tmp = "$1,";
611     my @value = map {/^"(.*)"$/ ? scalar($_ = $1, s/""/"/g, $_) : $_} ($tmp =~ /("[^"]*(?:""[^"]*)*"|[^,]*),/g);
612     my @align = map {(s/^\s+//) ? ((s/\s+$//) ? ' align="center"' : ' align="right"') : ''} @value;
613     my @colspan = map {($_ eq '==') ? 0 : 1} @value;
614     for (my $i = 0; $i < @value; $i++) {
615     if ($colspan[$i]) {
616     while ($i + $colspan[$i] < @value and $value[$i + $colspan[$i]] eq '==') {
617     $colspan[$i]++;
618     }
619     $colspan[$i] = ($colspan[$i] > 1) ? sprintf(' colspan="%d"', $colspan[$i]) : '';
620     $value[$i] = sprintf('<td%s%s>%s</td>', $align[$i], $colspan[$i], &inline($value[$i]));
621     } else {
622     $value[$i] = '';
623     }
624     }
625     push(@result, join('', '<tr>', @value, '</tr>'));
626     # XXXXX
627     #######
628 wakaba 1.9 } else {
629     push(@result, &inline($_));
630     }
631     }
632     push(@result, splice(@saved));
633 wakaba 1.16
634     if ($option{toc}) {
635     # Convert @toc (table of contents) to HTML.
636     # This part is taken from Makio Tsukamoto's WalWiki.
637     my (@tocsaved, @tocresult);
638     foreach (@toc) {
639     if (/^(-{1,3})(.*)/) {
640     &back_push('ul', length($1), \@tocsaved, \@tocresult);
641     push(@tocresult, '<li>' . $2 . '</li>');
642     }
643     }
644     push(@tocresult, splice(@tocsaved));
645     return join("\n", @tocresult, @result);
646     } else {
647     return join("\n", @result);
648     }
649 wakaba 1.9 }
650    
651     sub back_push {
652 wakaba 1.16 my ($tag, $level, $savedref, $resultref, $attr) = @_;
653     while (@$savedref > $level) {
654     push(@$resultref, shift(@$savedref));
655     }
656     if ($savedref->[0] ne "</$tag>") {
657     push(@$resultref, splice(@$savedref));
658     }
659     while (@$savedref < $level) {
660     unshift(@$savedref, "</$tag>");
661     push(@$resultref, "<$tag$attr>");
662 wakaba 1.9 }
663     }
664    
665 wakaba 1.16 sub inline {
666     my ($line) = @_;
667     $line = &escape($line);
668 wakaba 1.18 $line =~ s|'''([^']+?)'''|<strong>$1</strong>|g;
669     $line =~ s|''([^']+?)''|<em>$1</em>|g;
670 wakaba 1.16 $line =~ s|(\d\d\d\d-\d\d-\d\d \(\w\w\w\) \d\d:\d\d:\d\d)|<span class="date">$1</span>|g; # Date
671     $line =~ s!
672 wakaba 1.18 (
673     (?:&lt;(?:mailto|http|https|ftp|urn):[\x21-\x7E]*)&gt;
674     |
675     ($bracket_name) # [[likethis]], [[#comment]], [[Friend:remotelink]]
676     |
677     ($interwiki_definition) # [[Friend http://somewhere/?q=sjis($1)]]
678     #|
679     # ($wiki_name)
680     )
681 wakaba 1.16 !
682     &make_link($1)
683     !gex;
684     return $line;
685     }
686    
687     sub make_link {
688     my $chunk = shift;
689     # Walrus add (3) start
690 wakaba 1.21 $chunk =~ s/^&lt;(.*)&gt;$/$1/;
691 wakaba 1.16 my $name = $chunk;
692     if ($chunk =~ /^\[\[([^ ]+?) ([^ ]+?)\]\]$/ and $form{mypage} ne $InterWikiName) {
693     ($name, $chunk) = ($1, $2);
694     } elsif ($chunk =~ /^mailto:(.*)$/) {
695     $name = $1;
696     }
697     if ($use_autoimg and $name =~ /^(http|https|ftp|):.+\.(png|gif|jpe?g)/) {
698     $name = qq(<img src="$name">) ;
699     }
700     $name = &unarmor_name($name);
701     # Walrus add (3) end
702     if ($chunk =~ /^(http|https|ftp):/) {
703     # Walrus mod (3) start
704     # if ($use_autoimg and $chunk =~ /\.(gif|png|jpeg|jpg)$/) {
705     # return qq(<a href="$chunk"><img src="$chunk"></a>);
706     # } else {
707     # return qq(<a href="$chunk">$chunk</a>);
708     # }
709 wakaba 1.21 return qq(&lt;<a href="$chunk">$name</a>&gt;);
710 wakaba 1.16 # Walrus mod (3) end
711 wakaba 1.18 } elsif ($chunk =~ m#^urn:[0-9A-Za-z_:;/.-]+#) {
712     return qq|&lt;<a href="/uri-res/N2L?${name}">$name</a>&gt;|;
713     } elsif ($chunk =~ /^mailto:(.*)/) {
714 wakaba 1.16 # return qq(<a href="$chunk">$2</a>); # Walrus del (3)
715 wakaba 1.18 return qq(&lt;<a href="$chunk">$name</a>&gt;); # Walrus add (3)
716 wakaba 1.16 } elsif ($chunk =~ /^$interwiki_definition$/) {
717     # return qq(<span class="InterWiki">$chunk</span>); # Walrus del (3)
718     return qq(<span class="InterWiki">$name</span>); # Walrus add (3)
719     } elsif ($chunk =~ /^$embedded_name$/) {
720     return &embedded_to_html($chunk);
721     } else {
722     $chunk = &unarmor_name($chunk);
723     $chunk = &unescape($chunk); # To treat '&' or '>' or '<' correctly.
724     my $cookedchunk = &encode($chunk);
725     if ($chunk =~ /^$interwiki_name$/) {
726     my ($intername, $localname) = ($1, $2);
727     my $remoteurl = $interwiki{$intername};
728     if ($remoteurl) {
729     # $remoteurl =~ s/\b(euc|sjis|ykwk|asis)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus del (4)
730     $remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $localname)/e; # Walrus add (4)
731     # return qq(<a href="$remoteurl">$chunk</a>); # Walrus del (3)
732     return qq(<a href="$remoteurl">$name</a>); # Walrus add (3)
733     } else {
734     # return $chunk; # Walrus del (3)
735     return $name; # Walrus add (3)
736     }
737     } elsif ($database{$chunk}) {
738     my $subject = &escape(&get_subjectline($chunk, delimiter => ''));
739     # return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3)
740     return qq(<a title="$subject" href="$url_cgi?$cookedchunk">$name</a>); # Walrus add (3)
741     } elsif ($page_command{$chunk}) {
742     # return qq(<a title="$chunk" href="$url_cgi?$cookedchunk">$chunk</a>); # Walrus del (3)
743 wakaba 1.20 return qq(<a title="$chunk" href="$url_cgi?$cookedchunk" class="wiki">$name</a>); # Walrus add (3)
744 wakaba 1.16 } else {
745 wakaba 1.20 return qq(<a title="$resource{editthispage}" href="$url_cgi?mycmd=edit;mypage=$cookedchunk" class="wiki">$name<span class="mark">$editchar</span></a>);
746 wakaba 1.9 }
747     }
748     }
749    
750 wakaba 1.16 # Walrus add (6) start
751     sub is_ignore_html {
752 wakaba 1.9 my ($pagename) = @_;
753 wakaba 1.16 foreach (@ignore_html_page) {
754     return 1 if ($pagename eq $_);
755 wakaba 1.9 }
756 wakaba 1.16 return 0;
757 wakaba 1.9 }
758 wakaba 1.16 # Walrus add (6) end
759 wakaba 1.9
760 wakaba 1.16 # Walrus add (6) start
761     sub html_to_ignored_html {
762     my $str = shift(@_);
763     my $text_regex = q{[^<]*};
764     my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}}
765     my $comment_tag_regex = '<!(?:--[^-]*-(?:[^-]+-)*?-(?:[^>-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)';
766     my $tag_regex = qq{$comment_tag_regex|<$tag_regex_};
767     my $ignored = join('|', @ignore_html_tags);
768     my $result = '';
769     while ($str =~ /($text_regex)($tag_regex)?/gso) {
770     last if $1 eq '' and $2 eq '';
771     $result .= $1;
772     my $tag_tmp = $2;
773     $result .= ($tag_tmp =~ /^<\/?($ignored)(?![0-9A-Za-z])/i) ? $tag_tmp : &escape($tag_tmp);
774     if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) {
775     $str =~ /(.*?)(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$)/gsi;
776     $result .= &escape($1);
777     }
778 wakaba 1.9 }
779 wakaba 1.16 return $result;
780 wakaba 1.9 }
781 wakaba 1.16 # Walrus add (6) end
782 wakaba 1.9
783 wakaba 1.16 sub print_message {
784     my ($msg) = @_;
785     print qq(<p><strong>$msg</strong></p>);
786 wakaba 1.9 }
787    
788 wakaba 1.22 sub get_message {
789     my ($msg) = @_;
790     qq(<p><strong>$msg</strong></p>);
791     }
792    
793 wakaba 1.16 sub init_form {
794     if (param()) {
795     foreach my $var (param()) {
796     $form{$var} = param($var);
797     }
798     } else {
799     $ENV{QUERY_STRING} = $FrontPage;
800     }
801    
802     my $query = &decode($ENV{QUERY_STRING});
803     if ($page_command{$query}) {
804     $form{mycmd} = $page_command{$query};
805     $form{mypage} = $query;
806     } elsif ($query =~ /^($wiki_name)$/) {
807     $form{mycmd} = 'read';
808     $form{mypage} = $1;
809     } elsif ($database{$query}) {
810     $form{mycmd} = 'read';
811     $form{mypage} = $query;
812     }
813    
814     # mypreview_edit -> do_edit, with preview.
815     # mypreview_adminedit -> do_adminedit, with preview.
816     # mypreview_write -> do_write, without preview.
817     foreach (keys %form) {
818     if (/^mypreview_(.*)$/) {
819     $form{mycmd} = $1;
820     $form{mypreview} = 1;
821     }
822     }
823 wakaba 1.9
824 wakaba 1.16 #
825     # $form{mycmd} is frozen here.
826     #
827    
828     $form{mymsg} = &code_convert(\$form{mymsg}, $kanjicode);
829     $form{myname} = &code_convert(\$form{myname}, $kanjicode);
830     }
831    
832     sub update_recent_changes {
833     my $update = "- @{[&get_now]} @{[&armor_name($form{mypage})]} @{[&get_subjectline($form{mypage})]}";
834     my @oldupdates = split(/\r?\n/, $database{$RecentChanges});
835     my @updates;
836     foreach (@oldupdates) {
837     /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
838     my $name = &unarmor_name($1);
839     if (&is_exist_page($name) and ($name ne $form{mypage})) {
840     push(@updates, $_);
841     }
842     }
843     if (&is_exist_page($form{mypage})) {
844     unshift(@updates, $update);
845     }
846     splice(@updates, $maxrecent + 1);
847     $database{$RecentChanges} = join("\n", @updates);
848     if ($file_touch) {
849     open(FILE, "> $file_touch");
850     print FILE localtime() . "\n";
851     close(FILE);
852     }
853 wakaba 1.9 }
854    
855 wakaba 1.16 sub get_subjectline {
856     my ($page, %option) = @_;
857     if (not &is_editable($page)) {
858     return "";
859     } else {
860     # Delimiter check.
861     my $delim = $subject_delimiter;
862     if (defined($option{delimiter})) {
863     $delim = $option{delimiter};
864     }
865 wakaba 1.9
866 wakaba 1.16 # Get the subject of the page.
867     my $subject = $database{$page};
868     $subject =~ s/\r?\n.*//s;
869     return "$delim$subject";
870     }
871 wakaba 1.9 }
872    
873 wakaba 1.16 sub send_mail_to_admin {
874     my ($page, $mode) = @_;
875     return unless $modifier_sendmail;
876     my $message = <<"EOD";
877     To: $modifier_mail
878     From: $modifier_mail
879     Subject: [Wiki]
880     MIME-Version: 1.0
881     Content-Type: text/plain; charset=ISO-2022-JP
882     Content-Transfer-Encoding: 7bit
883    
884     --------
885     MODE = $mode
886     REMOTE_ADDR = $ENV{REMOTE_ADDR}
887     REMOTE_HOST = $ENV{REMOTE_HOST}
888     --------
889     $page
890     --------
891     $database{$page}
892     --------
893     EOD
894     &code_convert(\$message, 'jis');
895     open(MAIL, "| $modifier_sendmail");
896     print MAIL $message;
897     close(MAIL);
898 wakaba 1.9 }
899    
900 wakaba 1.16 sub open_db {
901     if ($modifier_dbtype eq 'dbmopen') {
902     dbmopen(%database, $dataname, 0666) or &print_error("(dbmopen) $dataname");
903     dbmopen(%infobase, $infoname, 0666) or &print_error("(dbmopen) $infoname");
904     } elsif ($modifier_dbtype eq 'AnyDBM_File') {
905     tie(%database, "AnyDBM_File", $dataname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $dataname");
906     tie(%infobase, "AnyDBM_File", $infoname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $infoname");
907     } else {
908     tie(%database, "Yuki::YukiWikiDB", $dataname) or &print_error("(tie Yuki::YukiWikiDB) $dataname");
909     tie(%infobase, "Yuki::YukiWikiDB", $infoname) or &print_error("(tie Yuki::YukiWikiDB) $infoname");
910 wakaba 1.9 }
911     }
912    
913 wakaba 1.16 sub close_db {
914     if ($modifier_dbtype eq 'dbmopen') {
915     dbmclose(%database);
916     dbmclose(%infobase);
917     } elsif ($modifier_dbtype eq 'AnyDBM_File') {
918     untie(%database);
919     untie(%infobase);
920     } else {
921     untie(%database);
922     untie(%infobase);
923     }
924     }
925 wakaba 1.9
926 wakaba 1.16 sub open_diff {
927     if ($modifier_dbtype eq 'dbmopen') {
928     dbmopen(%diffbase, $diffname, 0666) or &print_error("(dbmopen) $diffname");
929     } elsif ($modifier_dbtype eq 'AnyDBM_File') {
930     tie(%diffbase, "AnyDBM_File", $diffname, O_RDWR|O_CREAT, 0666) or &print_error("(tie AnyDBM_File) $diffname");
931     } else {
932     tie(%diffbase, "Yuki::YukiWikiDB", $diffname) or &print_error("(tie Yuki::YukiWikiDB) $diffname");
933     }
934     }
935 wakaba 1.9
936 wakaba 1.16 sub close_diff {
937     if ($modifier_dbtype eq 'dbmopen') {
938     dbmclose(%diffbase);
939     } elsif ($modifier_dbtype eq 'AnyDBM_File') {
940     untie(%diffbase);
941     } else {
942     untie(%diffbase);
943     }
944 wakaba 1.9 }
945    
946 wakaba 1.16 sub print_searchform {
947     my ($word) = @_;
948     print <<"EOD";
949     <form action="$url_cgi" method="get">
950     <input type="hidden" name="mycmd" value="search">
951     <input type="text" name="mymsg" value="$word" size="20">
952     <input type="submit" value="$resource{searchbutton}">
953     </form>
954     EOD
955 wakaba 1.9 }
956    
957 wakaba 1.16 sub print_editform {
958     my ($mymsg, $lastmodified, %mode) = @_;
959     my $frozen = &is_frozen($form{mypage});
960    
961     if ($form{mypreview}) {
962     if ($form{mymsg}) {
963     unless ($mode{conflict}) {
964     print qq(<h3>$resource{previewtitle}</h3>\n);
965     print qq($resource{previewnotice}\n);
966     print qq(<div class="preview">\n);
967     &print_content($form{mymsg});
968     print qq(</div>\n);
969     }
970     } else {
971     print qq($resource{previewempty});
972     }
973     $mymsg = &escape($form{mymsg});
974 wakaba 1.9 } else {
975 wakaba 1.16 $mymsg = &escape($mymsg);
976 wakaba 1.9 }
977    
978 wakaba 1.16 my $edit = $mode{admin} ? 'adminedit' : 'edit';
979    
980     print <<"EOD";
981     <form action="$url_cgi" method="post">
982     @{[ $mode{admin} ? qq($resource{frozenpassword} <input type="password" name="mypassword" value="$form{mypassword}" size="10"><br>) : "" ]}
983     <input type="hidden" name="myLastModified" value="$lastmodified">
984 wakaba 1.23 <input type="hidden" name="mypage" value="@{[&escape($form{mypage})]}">
985 wakaba 1.22 <textarea cols="$cols" rows="$rows" name="mymsg" wrap="off" tabindex="1">$mymsg</textarea><br>
986 wakaba 1.16 @{[
987     $mode{admin} ?
988     qq(
989     <input type="radio" name="myfrozen" value="1" @{[$frozen ? qq(checked="checked") : ""]}>$resource{frozenbutton}
990     <input type="radio" name="myfrozen" value="0" @{[$frozen ? "" : qq(checked="checked")]}>$resource{notfrozenbutton}<br>)
991     : ""
992     ]}
993     @{[
994     $mode{conflict} ? "" :
995     qq(
996     <input type="checkbox" name="mytouch" value="on" checked="checked">$resource{touch}<br>
997     <input type="submit" name="mypreview_$edit" value="$resource{previewbutton}">
998 wakaba 1.22 <input type="submit" name="mypreview_write" value="$resource{savebutton}" accesskey="S"><kbd>S</kbd><br>
999 wakaba 1.16 )
1000     ]}
1001     </form>
1002     EOD
1003     unless ($mode{conflict}) {
1004     # Show the format rule.
1005     open(FILE, $file_format) or &print_error("($file_format)");
1006     my $content = join('', <FILE>);
1007     &code_convert(\$content, $kanjicode);
1008 wakaba 1.9 close(FILE);
1009 wakaba 1.16 print &text_to_html($content, toc=>0);
1010 wakaba 1.9 }
1011     }
1012    
1013 wakaba 1.16 sub print_passwordform {
1014     print <<"EOD";
1015     <form action="$url_cgi" method="post">
1016     <input type="hidden" name="mycmd" value="adminchangepassword">
1017     $resource{oldpassword} <input type="password" name="myoldpassword" size="10"><br>
1018     $resource{newpassword} <input type="password" name="mynewpassword" size="10"><br>
1019     $resource{newpassword2} <input type="password" name="mynewpassword2" size="10"><br>
1020     <input type="submit" value="$resource{changepasswordbutton}"><br>
1021     </form>
1022     EOD
1023 wakaba 1.9 }
1024    
1025 wakaba 1.16 sub is_editable {
1026     my ($page) = @_;
1027     if (&is_bracket_name($page)) {
1028     return 0;
1029     } elsif ($fixedpage{$page}) {
1030     return 0;
1031     } elsif ($page =~ /\s/) {
1032     return 0;
1033     } elsif ($page =~ /^\#/) {
1034     return 0;
1035     } elsif ($page =~ /^$interwiki_name$/) {
1036     return 0;
1037     } else {
1038     return 1;
1039     }
1040 wakaba 1.9 }
1041    
1042 wakaba 1.16 # armor_name:
1043     # WikiName -> WikiName
1044     # not_wiki_name -> [[not_wiki_name]]
1045     sub armor_name {
1046     my ($name) = @_;
1047     if ($name =~ /^$wiki_name$/) {
1048     return $name;
1049     } else {
1050     return "[[$name]]";
1051 wakaba 1.9 }
1052     }
1053    
1054 wakaba 1.16 # unarmor_name:
1055     # [[bracket_name]] -> bracket_name
1056     # WikiName -> WikiName
1057     sub unarmor_name {
1058     my ($name) = @_;
1059     if ($name =~ /^$bracket_name$/) {
1060     return $1;
1061     } else {
1062     return $name;
1063     }
1064 wakaba 1.9 }
1065    
1066 wakaba 1.16 sub is_bracket_name {
1067     my ($name) = @_;
1068     if ($name =~ /^$bracket_name$/) {
1069     return 1;
1070     } else {
1071     return 0;
1072 wakaba 1.9 }
1073     }
1074    
1075 wakaba 1.16 sub decode {
1076     my ($s) = @_;
1077     $s =~ tr/+/ /;
1078     $s =~ s/%([A-Fa-f0-9][A-Fa-f0-9])/pack("C", hex($1))/eg;
1079     return $s;
1080     }
1081 wakaba 1.9
1082 wakaba 1.16 sub encode {
1083     my ($s) = @_;
1084     my $encoded = '';
1085     foreach my $ch (split(//, $s)) {
1086     if ($ch =~ /[A-Za-z0-9_]/) {
1087     $encoded .= $ch;
1088     } else {
1089     $encoded .= '%' . sprintf("%02X", ord($ch));
1090     }
1091     }
1092     return $encoded;
1093     }
1094 wakaba 1.9
1095 wakaba 1.16 sub init_resource {
1096     open(FILE, $file_resource) or &print_error("(resource)");
1097     while (<FILE>) {
1098     chomp;
1099     next if /^#/;
1100     my ($key, $value) = split(/=/, $_, 2);
1101     $resource{$key} = &code_convert(\$value, $kanjicode);
1102     }
1103     close(FILE);
1104     }
1105 wakaba 1.9
1106 wakaba 1.16 sub conflict {
1107     my ($page, $rawmsg) = @_;
1108     if ($form{myLastModified} eq &get_info($page, $info_LastModified)) {
1109     return 0;
1110     }
1111     open(FILE, $file_conflict) or &print_error("(conflict)");
1112     my $content = join('', <FILE>);
1113     &code_convert(\$content, $kanjicode);
1114     close(FILE);
1115     &print_header($page);
1116     &print_content($content);
1117     &print_editform($rawmsg, $form{myLastModified}, frozen=>0, conflict=>1);
1118     &print_footer($page);
1119     return 1;
1120     }
1121    
1122     sub get_now {
1123     my (@week) = qw(Sun Mon Tue Wed Thu Fri Sat);
1124     my ($sec, $min, $hour, $day, $mon, $year, $weekday) = localtime(time);
1125     $year += 1900;
1126     $mon++;
1127     $mon = "0$mon" if $mon < 10;
1128     $day = "0$day" if $day < 10;
1129     $hour = "0$hour" if $hour < 10;
1130     $min = "0$min" if $min < 10;
1131     $sec = "0$sec" if $sec < 10;
1132     $weekday = $week[$weekday];
1133     return "$year-$mon-$day ($weekday) $hour:$min:$sec";
1134     }
1135    
1136     # [[YukiWiki http://www.hyuki.com/yukiwiki/wiki.cgi?euc($1)]]
1137     sub init_InterWikiName {
1138     my $content = $database{$InterWikiName};
1139     while ($content =~ /\[\[(\S+) +(\S+)\]\]/g) {
1140     my ($name, $url) = ($1, $2);
1141     $interwiki{$name} = $url;
1142     }
1143     }
1144 wakaba 1.9
1145 wakaba 1.16 sub interwiki_convert {
1146     my ($type, $localname) = @_;
1147     if ($type eq 'sjis' or $type eq 'euc') {
1148     &code_convert(\$localname, $type);
1149     return &encode($localname);
1150     } elsif ($type eq 'ykwk') {
1151     # for YukiWiki1
1152     if ($localname =~ /^$wiki_name$/) {
1153     return $localname;
1154     } else {
1155     &code_convert(\$localname, 'sjis');
1156     return &encode("[[" . $localname . "]]");
1157     }
1158     } elsif ($type eq 'asis') {
1159     return $localname;
1160     # Walrus add (4) start
1161     } elsif ($type eq 'isbn') {
1162     $localname = join('', ($localname =~ /[0-9x]/g)) if ($localname =~ /^(\d-?){9}[\dx]$/);
1163     return $localname;
1164     # Walrus add (4) end
1165     } else {
1166     return $localname;
1167     }
1168     }
1169 wakaba 1.9
1170 wakaba 1.16 sub get_info {
1171     my ($page, $key) = @_;
1172     my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});
1173     return $info{$key};
1174     }
1175 wakaba 1.9
1176 wakaba 1.16 sub set_info {
1177     my ($page, $key, $value) = @_;
1178     my %info = map { split(/=/, $_, 2) } split(/\n/, $infobase{$page});
1179     $info{$key} = $value;
1180     my $s = '';
1181     for (keys %info) {
1182     $s .= "$_=$info{$_}\n";
1183     }
1184     $infobase{$page} = $s;
1185     }
1186 wakaba 1.9
1187 wakaba 1.16 sub frozen_reject {
1188     my ($isfrozen) = &get_info($form{mypage}, $info_IsFrozen);
1189     my ($willbefrozen) = $form{myfrozen};
1190     if (not $isfrozen and not $willbefrozen) {
1191     # You need no check.
1192     return 0;
1193     } elsif (valid_password($form{mypassword})) {
1194     # You are admin.
1195     return 0;
1196     } else {
1197     &print_error($resource{passworderror});
1198     return 1;
1199     }
1200     }
1201 wakaba 1.9
1202 wakaba 1.16 sub valid_password {
1203     my ($givenpassword) = @_;
1204     my ($validpassword_crypt) = &get_info($AdminSpecialPage, $info_AdminPassword);
1205     if (crypt($givenpassword, $validpassword_crypt) eq $validpassword_crypt) {
1206     return 1;
1207     } else {
1208     return 0;
1209     }
1210     }
1211 wakaba 1.9
1212 wakaba 1.16 sub is_frozen {
1213     my ($page) = @_;
1214     if (&get_info($page, $info_IsFrozen)) {
1215     return 1;
1216     } else {
1217     return 0;
1218     }
1219     }
1220 wakaba 1.9
1221 wakaba 1.16 sub do_comment {
1222     my ($content) = $database{$form{mypage}};
1223     my $datestr = &get_now;
1224     my $namestr = $form{myname} ? " ''[[$form{myname}]]'' : " : " ";
1225     if ($content =~ s/(\Q$embed_comment\E)/- $datestr$namestr$form{mymsg}\n$1/) {
1226     ;
1227     } else {
1228     $content =~ s/(\Q$embed_rcomment\E)/$1\n- $datestr$namestr$form{mymsg}/;
1229     }
1230     if ($form{mymsg}) {
1231     $form{mymsg} = $content;
1232     $form{mytouch} = 'on';
1233     &do_write;
1234     } else {
1235     $form{mycmd} = 'read';
1236     &do_read;
1237     }
1238     }
1239 wakaba 1.9
1240 wakaba 1.16 sub embedded_to_html {
1241     my ($embedded) = @_;
1242     if ($embedded eq $embed_comment or $embedded eq $embed_rcomment) {
1243     my $lastmodified = &get_info($form{mypage}, $info_LastModified);
1244     return <<"EOD";
1245     <form action="$url_cgi" method="post">
1246     <input type="hidden" name="mycmd" value="comment">
1247     <input type="hidden" name="mypage" value="$form{mypage}">
1248     <input type="hidden" name="myLastModified" value="$lastmodified">
1249     <input type="hidden" name="mytouch" value="on">
1250     $resource{yourname}
1251     <input type="text" name="myname" value="" size="10">
1252     <input type="text" name="mymsg" value="" size="40">
1253     <input type="submit" value="$resource{commentbutton}">
1254     </form>
1255     EOD
1256 wakaba 1.22 } elsif ($embedded =~ /$embed_command{searched}/) {
1257     return get_search_result ($1);
1258 wakaba 1.16 # Walrus add (5) start
1259     } elsif ($embedded =~ /$embed_interwiki/ and my $remoteurl = $interwiki{$2}) {
1260     $_ = &make_interwiki_box($1, $2);
1261     return ($_) ? $_ : $embedded;
1262     # Walrus add (5) end
1263     } else {
1264     return $embedded;
1265     }
1266     }
1267 wakaba 1.9
1268 wakaba 1.16 # Walrus add (5) start
1269     sub do_interwiki_box {
1270     my $remoteurl = $interwiki{$form{'myintername'}};
1271     if ($remoteurl) {
1272     $remoteurl =~ s/\b(euc|sjis|ykwk|asis|isbn)\(\$1\)/&interwiki_convert($1, $form{'mylocalname'})/e;
1273     print "Location: $remoteurl\n\n";
1274     exit(1);
1275     } else {
1276     &do_read;
1277     }
1278     }
1279     # Walrus add (5) end
1280 wakaba 1.9
1281 wakaba 1.16 # Walrus add (5) start
1282     sub make_interwiki_box {
1283     my ($localname, $intername) = @_;
1284     my %ignoretype = (
1285     'box' => 'text',
1286     'text' => 'text',
1287     'pass' => 'password',
1288     'password' => 'password'
1289     );
1290     my $converted = ($ignoretype{$localname}) ? <<EOD : undef;
1291     <form action="$url_cgi" method="post">
1292     <input type="hidden" name="mycmd" value="interwikibox">
1293     <input type="hidden" name="mypage" value="$form{mypage}">
1294     <input type="hidden" name="myintername" value="$intername">
1295     $intername:
1296     <input type="$ignoretype{$localname}" name="mylocalname" value="" size="10">
1297     <input type="submit" value="Submit">
1298     </form>
1299     EOD
1300     }
1301     # Walrus add (5) end
1302 wakaba 1.9
1303 wakaba 1.16 sub code_convert {
1304     my ($contentref, $kanjicode) = @_;
1305     # &Jcode::convert($contentref, $kanjicode); # for Jcode.pm
1306     &jcode::convert($contentref, $kanjicode); # for jcode.pl
1307     return $$contentref;
1308     }
1309    
1310     sub test_convert {
1311     my $txt = &text_to_html(<<"EOD", toc=>1);
1312     *HEADER1
1313     **HEADER1-1
1314     -ITEM1
1315     -ITEM2
1316     -ITEM3
1317     PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1318     PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1319     PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1320    
1321     PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1322     PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1323     PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1324     **HEADER1-2
1325     :TERM1:DESCRIPTION1 AND ''BOLD''
1326     PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1327     PAR1PAR1PAR1PAR1PAR1PAR1''BOLD''PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1328     PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1329     :TERM2:DESCRIPTION2
1330     :TERM3:DESCRIPTION3
1331     ----
1332     *HEADER2
1333     **HEADER2-1
1334     http://www.hyuki.com/
1335     **HEADER2-2
1336 wakaba 1.9
1337 wakaba 1.16 [[YukiWiki2]]
1338 wakaba 1.9
1339 wakaba 1.16 PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1340     PAR1PAR1PAR1PAR1PAR1PAR1'''''BOLD ITALIC'''''PAR1PAR1PAR1PAR1PAR1
1341     PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1PAR1
1342     >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1343     >PAR2PAR2PAR2PAR2PAR2PAR2'''ITALIC'''PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1344     >PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2PAR2
1345    
1346     LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0LEVEL0
1347    
1348     >LEVEL1
1349     >LEVEL1
1350     >LEVEL1
1351     >>LEVEL2
1352     >>LEVEL2
1353     >>LEVEL2
1354     >>>LEVEL3
1355     -HELLO-1
1356     --HELLO-2
1357     (HELLO-2, HELLO-2, HELLO-2)
1358     ---HELLO-3
1359     (HELLO-3, HELLO-3, HELLO-3)
1360     --HELLO-2
1361     ---HELLO-3
1362     --HELLO-2
1363     ---HELLO-3
1364     >>>LEVEL3
1365     >>>LEVEL3
1366     >>>LEVEL3
1367     >>>LEVEL3
1368     EOD
1369     print $txt;
1370     exit;
1371     }
1372 wakaba 1.9
1373 wakaba 1.16 sub do_diff {
1374     if (not &is_editable($form{mypage})) {
1375     &do_read;
1376     return;
1377     }
1378     &open_diff;
1379     my $title = $form{mypage};
1380     &print_header($title);
1381     $_ = &escape($diffbase{$form{mypage}});
1382     &close_diff;
1383     print qq(<h3>$resource{difftitle}</h3>);
1384     print qq($resource{diffnotice});
1385     print qq(<pre class="diff">);
1386     foreach (split(/\n/, $_)) {
1387     if (/^\+(.*)/) {
1388     print qq(<b class="added">$1</b>\n);
1389     } elsif (/^\-(.*)/) {
1390     print qq(<s class="deleted">$1</s>\n);
1391     } elsif (/^\=(.*)/) {
1392     print qq(<span class="same">$1</span>\n);
1393     } else {
1394     print qq|??? $_\n|;
1395     }
1396     }
1397     print qq(</pre>);
1398     print qq(<hr>);
1399     &print_footer($title);
1400     }
1401 wakaba 1.9
1402 wakaba 1.16 sub do_rss {
1403     my $rss = new Yuki::RSS(
1404     version => '1.0',
1405     encoding => $charset,
1406     );
1407     $rss->channel(
1408     title => $modifier_rss_title,
1409     link => $modifier_rss_link,
1410     description => $modifier_rss_description,
1411     );
1412     my $recentchanges = $database{$RecentChanges};
1413     my $count = 0;
1414     foreach (split(/\n/, $recentchanges)) {
1415     last if ($count >= 15);
1416     /^\- \d\d\d\d\-\d\d\-\d\d \(...\) \d\d:\d\d:\d\d (\S+)/; # date format.
1417     my $title = &unarmor_name($1);
1418     my $escaped_title = &escape($title);
1419     my $link = $modifier_rss_link . '?' . &encode($title);
1420     my $description = $escaped_title . &escape(&get_subjectline($title));
1421     $rss->add_item(
1422     title => $escaped_title,
1423     link => $link,
1424     description => $description,
1425     );
1426     $count++;
1427     }
1428     # print RSS information (as XML).
1429     print <<"EOD"
1430     Content-type: text/xml
1431 wakaba 1.9
1432 wakaba 1.16 @{[$rss->as_string]}
1433     EOD
1434     }
1435 wakaba 1.9
1436 wakaba 1.16 sub is_exist_page {
1437     my ($name) = @_;
1438     if ($use_exists) {
1439     return exists($database{$name});
1440     } else {
1441     return $database{$name};
1442     }
1443     }
1444 wakaba 1.9
1445 wakaba 1.16 1;
1446     __END__
1447     =head1 NAME
1448 wakaba 1.9
1449 wakaba 1.16 wiki.cgi - This is YukiWiki, yet another Wiki clone.
1450 wakaba 1.9
1451 wakaba 1.16 =head1 DESCRIPTION
1452 wakaba 1.9
1453 wakaba 1.16 YukiWiki is yet another Wiki clone.
1454 wakaba 1.9
1455 wakaba 1.16 YukiWiki can treat Japanese WikiNames (enclosed with [[ and ]]).
1456     YukiWiki provides 'InterWiki' feature, RDF Site Summary (RSS),
1457     and some embedded commands (such as [[#comment]] to add comments).
1458 wakaba 1.9
1459 wakaba 1.16 Read F<readme_en.txt> (English) or F<readme_ja.txt> (Japanese) in more detail.
1460 wakaba 1.9
1461 wakaba 1.16 =head1 AUTHOR
1462 wakaba 1.9
1463 wakaba 1.16 Hiroshi Yuki <hyuki@hyuki.com> http://www.hyuki.com/yukiwiki/
1464 wakaba 1.9
1465 wakaba 1.16 =head1 LICENSE
1466 wakaba 1.9
1467 wakaba 1.16 Copyright (C) 2000-2002 by Hiroshi Yuki.
1468 wakaba 1.9
1469 wakaba 1.16 This program is free software; you can redistribute it and/or
1470     modify it under the same terms as Perl itself.
1471 wakaba 1.9
1472     =cut

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24