/[suikacvs]/webroot/sccc/board-t/board.cgi
Suika

Contents of /webroot/sccc/board-t/board.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Wed Jan 12 04:23:01 2005 UTC (20 years, 4 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +0 -0 lines
FILE REMOVED
New

1 wakaba 1.1 #!/usr/bin/perl
2    
3 wakaba 1.2 $myvesion = '1.1 (2005-01-11)';
4 wakaba 1.1
5     $about_perl = <<"EOH";
6 wakaba 1.2 <address class="version weak">
7     FlasH BBS Pro v1.41 [&copy; <a href="http://www7.big.or.jp/~jawa/">Shigeto Nakazawa</a>] をベースに<a href="http://www.ne.jp/asahi/minazuki/bakera/">水無月ばけら</a>が改造
8 wakaba 1.1 + <a href="mailto:wakaba\@suika.fam.cx">若葉</a>の quick hack $myversion
9     </address>
10     EOH
11    
12     ## h12-05-06 水無月ばけら <bakera@star.email.ne.jp>
13     ## h09-01-17 じゃわ@中澤重人 <jawa@big.or.jp>
14     ## FlasH BBS Pro 1.41 <http://www7.big.or.jp/~jawa/>
15    
16     #一般設定
17     $max_size = 512 * 1024;
18     $max_msg = 2000;
19 wakaba 1.2 $admin_email = 'hero@suika.fam.cx';
20 wakaba 1.1 $this_name = 'board';
21     $gif_allnews = '';
22     $gif_news = '';
23     $gif_new_news = '';
24     $gif_width = 20;
25     $gif_height = 14;
26 wakaba 1.2 $default_title = '';
27     $default_name = '';
28     $default_email = '';
29     $default_comment = '';
30 wakaba 1.1 $arc_dir = './log/';
31     $log_dir = './log/';
32 wakaba 1.2 $base_url = "http://suika.fam.cx/sccc/";
33 wakaba 1.1 $rfc_base_uri = 'http://dnsbalance.ring.gr.jp/pub/doc/RFC';
34     $logfile = $log_dir.'bo.log';
35    
36     #ロックファイル検出時のリトライ回数
37     $retry = 3;
38    
39     #文字コード
40     $mojicode = "euc";
41     require 'jcode.pl';
42    
43     #NN2 で charset=EUC-JP を送ると化けるらしい。
44     if( $ENV{'HTTP_USER_AGENT'} =~ /compatible/ ){
45     $charset = ';charset=EUC-JP';
46     }elsif( $ENV{'HTTP_USER_AGENT'} =~ /Mozilla\/2.0/ ){
47     $charset = '';
48     }else{
49     $charset = ';charset=EUC-JP';
50     }
51    
52     &read_form;
53    
54     #パラメータの処理
55     #デフォルト
56     $uri_mode = 'all';
57     $tree = 0;
58     $new_kiji = 10;
59     $max_tree = 10;
60     $nazo = '';
61     $indent = 'ul';
62     $max_depth = 40;
63     $margin = 3;
64    
65     $ID = $OPT{'id'};
66     $uri_query = "id=$ID";
67     $form_query = "<input type=\"hidden\" name=\"id\" value=\"$ID\">";
68     if($OPT{'link'}){
69     $uri_mode = $OPT{'link'};
70     &add_query('link', $uri_mode);
71     }
72     if($OPT{'tree'}){
73     $tree = $OPT{'tree'};
74     &add_query('tree', $tree);
75     }
76     if($OPT{'new_kiji'}){
77     $new_kiji = $OPT{'new_kiji'};
78     &add_query('new_kiji', $new_kiji);
79     }
80     if($OPT{'tmp_new_kiji'}){
81     $new_kiji = $OPT{'tmp_new_kiji'};
82     #このパラメータはクエリーに反映しない。
83     }
84     if($OPT{'max_tree'}){
85     $max_tree = $OPT{'max_tree'};
86     &add_query('max_tree',$max_tree);
87     }
88     if($OPT{'nazo'}){
89     $nazo = $OPT{'nazo'};
90     &add_query('nazo', $nazo) if ( $nazo ne 'only' );
91     }
92     if($OPT{'indent'}){
93     $indent = $OPT{'indent'};
94     &add_query('indent', $indent);
95     }
96     if($OPT{'max_depth'}){
97     $max_depth = $OPT{'max_depth'};
98     &add_query('max_depth', $max_depth);
99     }
100     if($OPT{'margin'}){
101     $margin = $OPT{'margin'};
102     &add_query('margin', $margin);
103     }
104    
105     $cookie_name = 'board';
106 wakaba 1.2 $title = 'セイチュー COMPUTER 掲示板';
107     $backurl = '../';
108 wakaba 1.1 $back_name = '目次';
109     $html_info = '';
110     $link_element = '';
111 wakaba 1.2 my $linkss = q{<link rel="stylesheet" href="../seichucomputer.css" media="all">};
112 wakaba 1.1 ## Administrator
113 wakaba 1.2 $address_element = qq{<address><a href=\"mailto:hero\@suika.fam.cx\" rev="made">helo</a></address>};
114 wakaba 1.1
115    
116     $defhead = <<"EOH";
117    
118     <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
119     <html lang="ja">
120     <head>
121     <title>$title</title>
122 wakaba 1.2 $linkss
123     <link rel="index" href="../" />
124 wakaba 1.1 </head>
125     <body>
126     <h1>$title</h1>
127     EOH
128     $def_header_http = <<EOH;
129 wakaba 1.2 Content-Type: text/html; charset=euc-jp
130 wakaba 1.1 Content-Language: ja
131     Content-Style-Type: text/css
132     Content-Script-Type: text/javascript
133    
134     EOH
135    
136     $deffoot = <<"EOH";
137 wakaba 1.2 <div class="footer">
138 wakaba 1.1 $address_element
139     $about_perl
140 wakaba 1.2 </div>
141 wakaba 1.1 </body></html>
142     EOH
143    
144 wakaba 1.2 $navi_usage = '<div class="navigation"><p>[';
145 wakaba 1.1 $navi_ichiran = "<a href=\"$this_name?$uri_query\">一覧表示</a>";
146     $navi_num = " / <a href=\"$this_name?$uri_query;md=num\">最新記事</a>";
147     $navi_new = " / <a href=\"$this_name?$uri_query;md=new\">新規投稿</a>";
148     $navi_back = " / <a href=\"$backurl\">$back_name</a> ]</p></div>";
149 wakaba 1.2 $html_navi = "<p class=\"navigation\">$navi_usage$navi_ichiran$navi_num$navi_new$navi_back</p>";
150 wakaba 1.1
151    
152     ##
153    
154     &get_cookie;
155     if ($nazo eq 'only') {&nazo_only; }
156     elsif ($OPT{'md'} eq 'reg') {&regist; }
157     elsif ($OPT{'md'} eq 'del') {&delete; }
158     elsif ($OPT{'md'} eq 'viw') {&view; }
159     elsif ($OPT{'md'} eq 'new') {
160 wakaba 1.2 $html_navi = "<p class=\"navigation\">$navi_usage$navi_ichiran$navi_num$navi_back";
161 wakaba 1.1 &html_form('root');
162     }
163     elsif ($OPT{'md'} eq 'set') { &set; }
164     elsif ($OPT{'md'} eq 'num') {
165 wakaba 1.2 $html_navi = "<p class=\"navigation\">$navi_usage$navi_ichiran$navi_new$navi_back";
166 wakaba 1.1 &number;
167     }
168     else {
169 wakaba 1.2 $html_navi = "<p class=\"navigation\">$navi_usage$navi_num$navi_new$navi_back";
170 wakaba 1.1 &ichiran;
171     }
172     &html_footer;
173     exit 0;
174    
175     # [ ヘッダー部分表示 ]
176     #
177    
178     sub html_header {
179     my($sub_title) = @_;
180     my $s;
181     if ($sub_title) {
182     $s = <<"_EOF_";
183 wakaba 1.2 Content-Type: text/html; charset=euc-jp
184 wakaba 1.1 Content-Language: ja
185     Content-Style-Type: text/css
186     Content-Script-Type: text/javascript
187    
188     <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
189     <html lang="ja">
190     <head>
191 wakaba 1.2 $linkss
192 wakaba 1.1 $link_element
193     <title>$title ($sub_title)</title>
194     _EOF_
195    
196     if($indent eq 'css'){
197     my($i, $tmp_margin);
198 wakaba 1.2 $s .= '<style type="text/css" media="all">';
199 wakaba 1.1 for( $i = 1; $i <= $max_depth; $i++ ){
200     $tmp_margin = $margin * $i;
201     print ".lv$i\{margin-left:$tmp_margin\%\}";
202     }
203     $s .= '</style>';
204     }
205     $s .= <<"_EOF_";
206     </head>
207     <body>
208 wakaba 1.2 <h1>$title</h1>
209 wakaba 1.1 $html_navi
210     <h2>$sub_title</h2>
211     _EOF_
212     return $s;
213     }
214     print $s;
215     }
216    
217     sub html_footer {
218     print<<"_EOF_";
219     $deffoot
220     _EOF_
221     }
222    
223     # [ 一覧表示 ]
224     #
225    
226     sub ichiran {
227     &set_cookie;
228     local($s) = &html_header('記事一覧');
229    
230     #ログ読み出し
231     open(LOG, $logfile) or die qq(open: $logfile: $!); #&Suika::CGI::Error::die('open', file => $logfile);
232     print $s;
233     my($count, $last_nj);
234     $count = <LOG>;chop($count);
235     $last_nj = <LOG>;chop($last_nj);
236    
237     if( $indent eq 'css' || $indent eq 'ul' ){
238     $prt_elm = 'ul';
239     $cld_elm = 'li';
240     }else{
241     $prt_elm = 'div';
242     $cld_elm = 'p';
243     }
244    
245     print $html_info;
246     print '<div class="set">';
247     print "<p><em class=\"note\">([全]を選択すると関連記事も含めて一括表示できます。)</em></p>\n";
248     $tree = int($tree/$max_tree) * $max_tree;
249     $end_tree = $tree + $max_tree;
250     my($tree_count) = 0;
251     while (<LOG>) {
252     my($last_lx) = -1;
253     $tree_count++;
254     next if $tree_count <= $tree;
255     next if $tree_count > $end_tree;
256     print "\n<hr>\n<$prt_elm class=\"tree\">";
257     @datas = &divide_log($_);
258     foreach (@datas) {
259     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
260     if ( $indent eq 'ul' && $last_lx > -1 ){
261     my($l_diff) = $last_lx - $lx;
262     if( $l_diff < 0 ){
263     print "<$prt_elm>";
264     }elsif( $l_diff > 0){
265     my($i);
266     print "</$cld_elm>";
267     for($i = 1; $i <= $l_diff; $i++){
268     print "</$prt_elm></$cld_elm>";
269     }
270     }else{
271     print "</$cld_elm>";
272     }
273     }
274     if($indent eq 'css'){
275     print "<$cld_elm class=\"lv$lx\">";
276     }else{
277     print "<$cld_elm>";
278     }
279     if ($res eq 'root') {
280     print "[<a href=\"$this_name?$uri_query;md=set;tn=$tn\">全</a>]";
281     } elsif ($indent eq 'space') {
282     my($space_width) = $lx * 2 + 2;
283     print '&nbsp;' x $space_width;
284     }
285     print "<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$tn\">";
286     if ($no > $count - $new_kiji) {
287     print "[新]";
288     } else {
289     print "[・]";
290     }
291     print " $title</a> : ";
292     if ($COOKIE{'name'} eq $name) {
293     print "<strong>$name</strong>"; #自分の記事を強調表示
294     } else {
295     print $name;
296     }
297     print " <span class=\"date\">($date)</span>";
298     $last_lx = $lx;
299     }
300     if ( $indent eq 'ul' ){
301     # print "<!--$last_lx-->";
302     my($i);
303     for($i = 1; $i <= $last_lx; $i++){
304     print "</$cld_elm></$prt_elm>";
305     }
306     }
307     print "</$cld_elm></$prt_elm>";
308     }
309     close(LOG);
310     print"</div>\n";
311    
312     &navi_form($tree_count);
313     }
314    
315     # [ 個別で記事の内容を表示する ]
316     #
317    
318     sub view {
319     local($s) = $def_header_http.$defhead.$html_navi."<h2>記事$OPT{'no'}</h2>";
320     my(@kiji_datas) = &divide_log(&search_tree);
321     my($kiji_data) = &search_data(@kiji_datas);
322    
323     $s .= &kiji_view($kiji_data);
324     $s .= "<div class=\"comment-navi\">";
325     my($no,$rq_res,$lx,$tn,$title,$name,$email,$date,$rq_act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
326     foreach (@kiji_datas) {
327     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($_);
328     if ($rq_res == $no) {
329     $parent = "この記事は「<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>」へのコメントです。";
330     }
331     if (($res == $OPT{'no'}) && ($res ne 'root')) {
332     $children .= "<li>「<a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">$title</a>」$name<span class=\"date\">($date)</span></li>";
333     }
334     }
335     if ($rq_res eq 'root') { $parent = 'ルート記事です。'; }
336     elsif (!$parent) { $parent = '元になった記事はみつかりませんでした。'; }
337     if (!$children) { $children = 'コメントは投稿されていません。</p>'; }
338     else{$children = "以下のコメントが投稿されています。</p>\n<ul class=\"comment\">$children</ul>";}
339     $s .= <<"_EOF_";
340     <hr>
341     <p>$parent
342     $children
343     <hr></div>
344     _EOF_
345     if ($rq_act > 6) {
346     $s .= '<p>この記事に対してコメントを投稿することは出来ません。</p>';
347     return 0;
348     }elsif( $nazo eq 'no' ){
349     $s .= '<!--謎スケルチモードではコメントの投稿は出来ません。-->';
350     return 0;
351     }
352     if ($title =~ /^[Rr][Ee]\^\d+\:(.*)/) {$title = "Re: $1";}
353     elsif ($title =~ /^[Rr][Ee]\[\d+\]\:(.*)/) {$title = "Re: $1";}
354     elsif ($title =~ /^[Rr][Ee]\:(.*)/) {$title = "Re: $1";}
355     else {$title = "Re: $title"; }
356     $comment = "<br>$comment";
357     $comment =~ s/<br>((&gt;)+)/\n$1&gt;/ig;
358     $comment =~ s/<br>/\n&gt; /ig;
359     $comment =~ s/\n//;
360     $s .= '<p>この記事に関するコメントを投稿する場合は以下の投稿欄に書き込んで下さい。</p>';
361     $s .= &html_form($OPT{'no'},$title,$comment,$OPT{'tn'},$lx,1);
362    
363     #投稿者削除
364     if (crypt($COOKIE{'pwd'},$file_pwd) eq $file_pwd) {
365     $s .= <<"_EOF_";
366     <hr>
367     <form action="./$this_name" method="post">
368     <p>
369     $form_query
370     <input type="hidden" name="md" value="del">
371     <input type="hidden" name="code" value="$OPT{'code'}">
372     <input type="hidden" name="tn" value="$OPT{'tn'}">
373     <input type="hidden" name="no" value="$OPT{'no'}">
374     <input type="hidden" name="pwd" value="$COOKIE{'bbs_pwd'}">
375     <input type="submit" value="この記事の内容を削除する">
376     <em class="note">(完全に削除出来ない場合もあります。)</em></p>
377     </form>
378     _EOF_
379     }
380    
381     print ($s.$deffoot);
382     exit;
383     }
384    
385     # [ セット表示 ]
386     #
387    
388     sub set {
389     my($last_lx) = -1;
390     print &html_header('セット表示');
391    
392     if( $indent eq 'css' || $indent eq 'ul' ){
393     $prt_elm = 'ul';
394     $cld_elm = 'li';
395     }else{
396     $prt_elm = 'div';
397     $cld_elm = 'p';
398     }
399    
400     print<<"_EOF_";
401     <div class=\"set\">
402     <h3><a name="list">記事一覧</a></h3>
403     <$prt_elm class="tree">
404     _EOF_
405     @kiji_datas = &divide_log(&search_tree);
406     foreach (@kiji_datas) {
407     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($_);
408     my($num_no) = int($no);
409     $reply[$res] .= "$num_no-";
410     if ( $indent eq 'ul' && $last_lx > -1 ){
411     my($l_diff) = $last_lx - $lx;
412     if( $l_diff < 0 ){
413     print "<$prt_elm>";
414     }elsif( $l_diff > 0){
415     my($i);
416     print "</$cld_elm>";
417     for($i = 1; $i <= $l_diff; $i++){
418     print "</$prt_elm></$cld_elm>";
419     }
420     }else{
421     print "</$cld_elm>";
422     }
423     }
424     if($indent eq 'css'){
425     print "<$cld_elm class=\"lv$lx\">";
426     }else{
427     print "<$cld_elm>";
428     }
429     $last_lx = $lx;
430     if ($res ne 'root' && $indent eq 'space') {
431     my($space_width) = $lx * 2 + 2;
432     print ' ' x $space_width;
433     }
434     print "<a href=\"#c$num_no\">・ $title</a> : $name <span class=\"date\">($date)</span>";
435     print "</$cld_elm>\n" unless ($indent eq 'ul');
436     }
437     if ( $indent eq 'ul' ){
438     # print "<!--$last_lx-->";
439     my($i);
440     for($i = 1; $i <= $last_lx; $i++){
441     print "</$cld_elm></$prt_elm>";
442     }
443     }else{
444     print "</$prt_elm>";
445     }
446    
447     print"</$cld_elm></$prt_elm></div>\n";
448    
449     foreach $data (@kiji_datas) {
450     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
451     my($num_no) = int($no);
452    
453     print "<p>No.<a name=\"c$num_no\">$num_no</a>";
454     if ($res eq 'root') {
455     print '<em class="note">(親記事)</em>';
456     } else {
457     $res = int($res);
458     print "<a href=\"#c$res\">▲<em>[$res]</em></a>";
459     }
460     if (!$reply[$no]) {
461     print ' / <em class="note">(注釈なし)</em>';
462     } else {
463     chop($reply[$no]);
464     my(@replys) = split(/-/,$reply[$no]);
465     foreach (@replys) {
466     print " / <a href=\"#c$_\">▼<em>[$_]</em></a>";
467     }
468     }
469     print "</p>\n";
470    
471     print &kiji_view($data);
472     if( $nazo eq 'no' ){
473     print '<!--謎スケルチモードではコメントの投稿は出来ません。-->';
474     }else{
475     print "<p><a href=\"$this_name?$uri_query;md=viw;no=$no;tn=$OPT{'tn'}\">コメントを投稿</a> / ";
476     }
477     print "<a href=\"#list\">記事一覧</a></p><hr>";
478     }
479     }
480    
481     # [ 最新記事一括機能 ]
482    
483     sub number {
484     print &html_header("最新記事");
485     print "<p>最近の記事 $new_kiji 件を表示しています。</p>";
486     print '<p>[';
487     my($i,$j,$tmp);
488     for ( $i = 1; $i <= 10; $i++ ){
489     $j = $i * 10;
490     unless ($new_kiji == $j){
491     if($tmp){
492     print ' / ' ;
493     }else{
494     $tmp = 1;
495     }
496     print "<a href=\"$this_name?$uri_query;md=num;tmp_new_kiji=$j\">$j 件</a>";
497     }
498     }
499     print ' ]</p>';
500     open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
501     my($count, $last_nj);
502     $count = <LOG>;chop($count);
503     $last_nj = <LOG>;chop($last_nj);
504     while (<LOG>) {
505     @datas = &divide_log($_);
506     foreach $data (@datas) {
507     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = &divide_data($data);
508     if ($no > $count - $new_kiji) {
509     push(@nums,$data);
510     }
511     }
512     last if @nums >= $new_kiji;
513     }
514     close(LOG);
515    
516     @nums = reverse(sort(@nums));
517     print '<ul class="new">';
518     my($list_order);
519     foreach $data (@nums) {
520     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
521     $list_order++;
522     print "<li><p>$list_order: 記事No.$no</p>\n";
523     print &kiji_view($data);
524     print<<"_EOF_";
525     <p><a href="$this_name?$uri_query;md=viw;no=$no;tn=$tn">コメントを投稿</a> / <a href="$this_name?$uri_query;md=set;tn=$tn">セットで表示</a></p><hr></li>
526     _EOF_
527     }
528     print '</ul>';
529     }
530    
531     # [ 投稿フォームを表示 ]
532     #
533    
534     sub html_form {
535     my($no,$title,$comment,$tn,$lx,$c) = (@_);
536     local($s); $s = $def_header_http.$defhead if $c != 1;
537     $s .= '<h2>記事の投稿</h2>';
538    
539     if ($no eq '') { $no = 'root'; }
540 wakaba 1.2 $title = "($default_title)" if not length $title and
541     length $default_title;
542     $comment = "($default_comment)" if not length $comment and
543     length $default_comment;
544 wakaba 1.1 if($COOKIE{'name'}){
545     $my_name = $COOKIE{'name'};
546 wakaba 1.2 }elsif (length $default_name) {
547 wakaba 1.1 $my_name = "($default_name)";
548     }
549     if($COOKIE{'email'}){
550     $my_email = $COOKIE{'email'};
551 wakaba 1.2 }elsif (length $default_email) {
552 wakaba 1.1 $my_email = "($default_email)";
553     }
554    
555     $nj = time() . '-' . &random_string(8);
556    
557     $s .= <<"_EOF_";
558     <script type="text/javascript" defer="defer"><!--
559     function check(myform){
560     if(!myform.name.value ){
561     alert("投稿者名を記入してください。");
562     myform.name.focus();
563     return false;
564     } else if(!myform.title.value ){
565     alert("題名を記入してください。");
566     myform.title.focus();
567     return false;
568     } else if(!myform.comment.value ){
569     alert("本文を記入してください。");
570     myform.comment.focus();
571     return false;
572     } else {
573     return true;
574     }
575     }
576     //--></script>
577     <form action="./$this_name" method="post" onsubmit="return check(this);">
578     <p><label accesskey="S" for="title">題名(<span class="key">S</span>):</label>
579     <input type="text" name="title" id="title" size="40" maxlength="80" value="$title"></p>
580     <p><label accesskey="N" for="name">名前(<span class="key">N</span>):</label>
581     <input type="text" name="name" id="name" size="40" maxlength="42" value="$my_name"></p>
582     <p><label accesskey="E" for="email">メイル(<span class="key">M</span>):</label>
583     <input type="text" name="email" id="email" size="60" maxlength="120" value="$my_email"></p>
584     <p><label accesskey="B" for="comment">本文(<span class="key">B</span>):</label>
585     <br><textarea name="comment" id="comment" rows="10" cols="70">$comment</textarea></label></p>
586     <p><input type="submit" value="送信">
587     $form_query
588     <input type="hidden" name="md" value="reg"><input type="hidden" name="no" value="$no"><input type="hidden" name="tn" value="$tn"><input type="hidden" name="lx" value="$lx"><input type="hidden" name="pwd" value="$COOKIE{'pwd'}"><input type="hidden" name="nj" value="$nj"><input type="hidden" name="code" value="$OPT{'code'}"></p>
589     </form>
590     _EOF_
591     if ($c == 1) {
592     $s;
593     } else {
594     print ($s);
595     }
596     }
597    
598     # [ 記事内容を表示 ]
599    
600     sub kiji_view {
601     my($data) = @_;
602     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$tm_pwd,$rhost,$ipad,$comment) = &divide_data($data);
603     # &jcode'convert(*comment,'euc');
604     $comment = &squelch($comment) if $nazo;
605     $comment =~ s/(<br>|\s| )+$//g;
606     $comment =~ s/^(>|&gt;)([^<]*)/<q class=\"responce\">&gt;$2<\/q>/g;
607     $comment =~ s/<br>(>|&gt;)([^<]*)/<br><q class=\"responce\">&gt;$2<\/q>/g;
608    
609     #URL にアンカーを設定する
610     if( $uri_mode eq 'uri' || $uri_mode eq 'all' ){
611     $comment =~ s/(https?|ftp|gopher|telnet|nntp|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\">$1\:$2<\/a>/ig;
612     }
613     if( $uri_mode eq 'rfc' || $uri_mode eq 'all' ){
614     $comment =~ s/(\W)([Rr][Ff][Cc]\s?)([1-9]\d*)(\W)/$1<a href=\"$rfc_base_uri\/rfc$3.txt\">$2$3<\/a>$4/g;
615     }
616     # &jcode'convert(*comment,$mojicode);
617     if ($email) { $name = "<a href=\"mailto:$email\">$name</a>"; }
618     local($s) = <<"_EOF_";
619     <!-- message start -->
620     <div class="message"><h3 class="subject">$title</h3>
621     <div class="message-header"><p><cite class="from">$name</cite>
622     <span class="date">($date)</span><!--$rhost($ipad)--></p></div>
623     <div class="message-body">
624     <p>$comment</p></div></div>
625     <!-- message end -->
626     _EOF_
627     $s;
628     }
629    
630     # [ 記事登録処理 ]
631    
632     sub regist {
633     my($title,$name,$email,$comment,$lx,$tn,$pwd,$ref_url) = ($OPT{'title'},$OPT{'name'},$OPT{'email'},$OPT{'comment'},$OPT{'lx'},$OPT{'tn'},$OPT{'pwd'},$ENV{'HTTP_REFERER'});
634     $title =~ s/^\($default_title\)//;
635     $title =~ s/\r\n//g;
636     $title =~ s/[\r\n]//g;
637     $name =~ s/^\($default_name\)//;
638     $name =~ s/\r\n//g;
639     $name =~ s/[\r\n]//g;
640     $email =~ s/^\($default_email\)//;
641     $email =~ s/\r\n//g;
642     $email =~ s/[\r\n]//g;
643     $comment =~ s/^\($default_comment\)//;
644     $comment =~ s/^\s+//g;
645     $comment =~ s/(\s| )+$//g;
646     $comment =~ s/\r\n/<br>/g;
647     $comment =~ s/[\r\n]/<br>/g;
648     $lx++;
649     $pwd =~ s/\r\n//g;
650     $pwd =~ s/\r|\n//g;
651     $ref_url =~ s/\?(.|\n)*//g;
652     s/\%7E/\~/g;
653    
654     #投稿チェック
655     if($ENV{'REQUEST_METHOD'} ne "POST"){
656     &method_error();
657     # }elsif($base_url && ($ref_url !~ $base_url)){
658     # &error('不正投稿','アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。正しい投稿でもこのエラーが出る場合は、ブラウザが Referer を送出する設定になっているか確認してください。');
659     }elsif (length($title) > 80) {
660     $_ = length($title) - 80;
661     &error('題名入力エラー',"題名が長すぎます。$_ バイト削減してください。");
662     }elsif (!$title) {
663     &error('題名入力エラー','題名が入力されていません。');
664     }elsif (!$name) {
665     &error('投稿者名入力エラー','投稿者名が入力されていません。');
666     }elsif (length($name) > 42) {
667     $_ = length($name) - 42;
668     &error('投稿者名入力エラー',"投稿者名が長すぎます。$_ バイト削減してください。");
669     }elsif ($email && $email !~ /\w[\w\.\-]*\@\w[\w\.\-]*\.\w+/){
670     &error('メールアドレス入力エラー','メールアドレスの書式が不正です。全角文字を使っていないか、空白を含めていないか確認してください。');
671     }elsif (length($email) > 120) {
672     $_ = length($email) - 120;
673     &error('メールアドレス入力エラー',"メールアドレスが長すぎます。$_ バイト削減してください。");
674     }elsif (!$comment) {
675     &error('本文入力エラー','本文が入力されていません。空白のみの投稿は出来ません。');
676     }elsif (length($comment) > $max_msg) {
677     $_ = length($comment) - $max_msg;
678     &error('本文入力エラー',"本文が長すぎます。$_ バイト削減してください。");
679     }elsif ((!$pwd) || (length($pwd) > 8)) { $pwd = &random_string(8); }
680     my($salt) = &random_string(2);
681     $file_pwd = crypt($pwd,$salt);
682     &get_date;
683    
684     open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
685     my($count, $last_nj);
686     $count = <LOG>;chop($count);
687     $last_nj = <LOG>;chop($last_nj);
688     my(@all_log) = <LOG>;
689     close(LOG);
690    
691     $this_nj = $OPT{'nj'};
692    
693     if (++$count > 9999) {
694     &error('記事カウンタのオーバーフロー','登録記事数が 10,000 に達したため、投稿を受け付けることが出来ません。投稿を受け付けるには、既存の記事を再編成して掲示板の最適化を行う必要があります。管理者に連絡してください。');
695     # }elsif ($this_nj eq $last_nj){
696     # &error('二重投稿','二重投稿です。投稿ボタンが連打されてしまった可能性があります。一覧表示をリロードして記事が投稿されたか確認してください。再投稿の際は、投稿フォームをリロードして投稿をやり直してください。');
697     }
698    
699     my($kiji_no) = substr("0000",length($count)).$count;
700    
701     $rhost = $ENV{'REMOTE_HOST'};
702     $ipad = $ENV{'REMOTE_ADDR'};
703    
704     if ($OPT{'no'} eq 'root') {
705     $kiji_data = "$kiji_no<>root<>0<>$kiji_no<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment\n";
706     unshift(@all_log,$kiji_data);
707     } else {
708     foreach $tree (@all_log) {
709     if ($tn == (split(/<>/,$tree))[0]) {
710     @datas = &divide_log($tree);
711     $flag1 = 0; $flag2 = 0;
712     $kiji_data = "$kiji_no<>$OPT{'no'}<>$lx<>$tn<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment";
713     foreach $data (@datas) {
714     if (($flag2 == 1) && ($temp_lx >= (split(/<>/,$data))[2])){
715     $tree_data = "$tree_data<#>$kiji_data";
716     $flag2 = 2;
717     }
718     if ($flag1) { $tree_data = "$tree_data<#>$data"; }
719     else { $tree_data = $data; $flag1 = 1; }
720     if (($OPT{'no'} == (split(/<>/,$data))[0]) && (!$flag2)) {
721     $flag2 = 1; $temp_lx = (split(/<>/,$data))[2];
722     }
723     }
724     if ($flag2 == 1){ $tree_data = "$tree_data<#>$kiji_data"; }
725     unshift (@new,"$tree_data\n");
726     }
727     else { push (@new,$tree); }
728     }
729     @all_log = @new;
730     }
731    
732     #容量オーバーした記事を削除
733     if ($max_size < 1500) { $max_size = 1500; }
734     $size = -s $logfile;
735     while ($size > $max_size){
736     my($delete) = pop(@all_log);
737     $size -= length($delete);
738     &delete_log($delete);
739     }
740     &write_file($count, $this_nj, @all_log);
741    
742     $COOKIE{'name'} = $name;
743     $COOKIE{'email'} = $email;
744     $COOKIE{'pwd'} = $pwd;
745     &set_cookie;
746     local($s) = $def_header_http.$defhead.$html_navi.'<h2>投稿の受理</h2>';
747     $s .= <<"_EOF_";
748     <p>御投稿有難うございます。以下の内容を受理しました。</p>
749     _EOF_
750     $s .= &kiji_view($kiji_data);
751     print ($s.$deffoot);
752     exit;
753     }
754    
755     # [ 投稿者削除処理 ]
756    
757     sub delete {
758     my(@kiji_datas) = &divide_log(&search_tree);
759     my($kiji_data) = &search_data(@kiji_datas);
760     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$file_pwd,$rhost,$ipad,$comment) = &divide_data($kiji_data);
761     if (crypt($COOKIE{'pwd'},$file_pwd) ne $file_pwd) {
762     &error('削除エラー','指定した記事の削除はできません。既に削除されていないか確認してください。どうしても削除したい場合は管理者に連絡してください。');
763     }
764     &get_date;
765    
766     #証拠を残しておく。
767     &delete_log($kiji_data);
768    
769     open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
770     my($count, $last_nj);
771     $count = <LOG>;chop($count);
772     $last_nj = <LOG>;chop($last_nj);
773     my($delete_notice);
774     if (@kiji_datas == 1) {
775     while (<LOG>) {
776     unless (/^$OPT{'no'}/) { push(@new,$_); }
777     }
778     $delete_notice = '<p>記事はツリーを構成していなかったため、完全に消滅しています。</p>';
779     } else {
780     my($kiji_data) = "$no<>$res<>$lx<>$tn<><del datetime=\"$datetime\">$title</del><em>(投稿者削除)</em><>$name<><>$date<>8<>Null<>$rhost<>$ipad<>投稿者によって削除されました。(削除: $date_now)";
781     my($flag) = 0;
782     my($tree_data);
783     foreach (@kiji_datas) {
784     if ($flag) { $tree_data .= "<#>"; } else { $flag = 1; }
785     if (/^$OPT{'no'}/) { $tree_data .= $kiji_data; }
786     else { $tree_data .= $_; }
787     }
788     $tree_data =~ s/\n//;
789     while (<LOG>) {
790     if (!/^$OPT{'tn'}/) { push(@new,$_); }
791     else { push(@new,"$tree_data\n"); }
792     }
793     $delete_notice = '<p>記事はツリーの一部を構成していたため、(投稿者削除) という記事に差し替えられています。</p>';
794     }
795     close(LOG);
796     &write_file($count, $this_nj, @new);
797     print &html_header("投稿者削除");
798     print<<"_EOF_";
799     <hr>
800     <p>記事 No.$OPT{'tn'}「$title」を削除しました。</p>
801     $delete_notice
802     <p><a href="$this_name?$uri_query">一覧表示</a>をリロードして、記事が削除されたことを確認してください。</p>
803     <hr>
804     _EOF_
805     }
806    
807     # [ データ処理関連汎用サブ ]
808    
809     sub divide_log {
810     my($data) = @_;
811     chop($data);
812     return split(/<#>/,$data);
813     }
814     sub divide_data {
815     my $data = @_;
816     return split(/<>/,$_[0]);
817     }
818    
819     sub search_data {
820     my(@kiji_datas) = @_;
821     my($search_data_no) = $OPT{'no'};
822     my($hit_data);
823     foreach(@kiji_datas){
824     if ( /^$search_data_no/ ) {
825     $hit_data = $_;
826     last;
827     }
828     }
829     return $hit_data;
830     }
831    
832     sub search_tree {
833     my($search_tree_no) = $OPT{'tn'};
834     my($hit_data);
835     open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
836     my($count, $last_nj);
837     $count = <LOG>;chop($count);
838     $last_nj = <LOG>;chop($last_nj);
839     while (<LOG>) {
840     if ( /^$search_tree_no/ ){
841     $hit_data = $_;
842     last;
843     }
844     }
845     close(LOG);
846     return $hit_data;
847     }
848    
849     # [ フォームからデータ取得 ]
850    
851     sub read_form {
852     # %OPT = %Suika::CGI::param;
853     # return;
854     my($pair,$buffer);
855     if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
856     } else { $buffer = $ENV{'QUERY_STRING'}; }
857     my(@pairs) = split(/[&;]/,$buffer); #パラメータ区切りに ; を使えるように改造。
858     foreach $pair (@pairs) {
859     my($name,$value) = split(/=/,$pair);
860     $value =~ tr/+/ /;
861     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
862     $OPT{$name} = &change_code($value);
863     }
864     }
865    
866     # [ クッキー処理 ]
867    
868     sub get_cookie {
869     my($pair,%DUMMY);
870     my($cookies) = $ENV{'HTTP_COOKIE'};
871     my(@pairs) = split(/;/,$cookies);
872     foreach $pair (@pairs) {
873     my($name,$value) = split(/=/,$pair);
874     $name =~ s/ //g;
875     $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
876     $DUMMY{$name} = $value;
877     }
878     @pairs = split(/,/,$DUMMY{$cookie_name});
879     foreach $pair (@pairs) {
880     my($name,$value) = split(/:/,$pair);
881     $COOKIE{$name} = &change_code($value);
882     }
883     }
884     sub set_cookie {
885     my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + 30*24*60*60);
886     $year += 100 if $year < 99;
887     $year += 1900;
888     $sec = "0$sec" if $sec < 10;
889     $min = "0$min" if $min < 10;
890     $hour = "0$hour" if $hour < 10;
891     $mday = "0$mday" if $mday < 10;
892     $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
893     $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
894     $date_gmt = "$youbi, $mday\-$mon\-$year $hour:$min:$sec GMT";
895     my($cook);
896     foreach $valname ('name','email','pwd'){
897     my($tmp) = $COOKIE{$valname};
898     $tmp =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
899     $cook .= "$valname:$tmp,";
900     }
901     print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\n";
902     }
903    
904     # [ 文字コード関連 ]
905    
906     sub change_code {
907     my($text)=$_[0];
908     &jcode'convert(*text,$mojicode);
909     $text =~ s/&/&amp;/g;
910     $text =~ s/</&lt;/g;
911     $text =~ s/>/&gt;/g;
912     return $text;
913     }
914    
915     # [ 日付取得 ]
916    
917     sub get_date {
918     $ENV{'TZ'} = "JST-9"; # TimeZone (日本時間 = 国際標準時(JST) - 9時間)
919     my($sec,$min,$hour,$day,$mon,$year) = localtime();
920     if ($year < 99) { $year += 100; }
921     $year += 1900;
922     $mon++;
923     $sec = "0$sec" if $sec < 10;
924     $min = "0$min" if $min < 10;
925     $hour = "0$hour" if $hour < 10;
926     $mon = "0$mon" if $mon < 10;
927     $day = "0$day" if $day < 10;
928     $date_now = "$year/$mon/$day $hour:$min:$sec";
929     $datetime = "$year-$mon-${day}T$hour:$min:$sec+09:00";
930     }
931    
932     # [ 記録ファイルの処理 ]
933    
934     sub write_file {
935     my($count,$this_nj,@lines) = @_;
936    
937     #プロセスID からテンポラリファイル名を生成
938     $pros = $$;
939     $pros = time unless $pros;
940     $tmp_file = "$ID$pros.tmp";
941    
942     #他のテンポラリファイルを検索
943     opendir(DIR,$log_dir) or &error('システムエラー','作業ディレクトリのオープンに失敗しました。管理者が何かを忘れている可能性があります。');
944     @list = readdir(DIR);
945     closedir(DIR);
946     unless (@list) { &error('システムエラー','作業ディレクトリが完全に空です。'); }
947     @lists = grep(/$ID.*\.tmp/,@list);
948    
949     #テンポラリファイルがある場合
950     my($retry_counter) = $retry;
951     while (@lists) {
952     if (--$retry_counter <= 0) {
953     #しびれを切らした
954     foreach (@lists) {
955     #テンポラリファイルを抹殺
956     unlink("$log_dir$_") if (-e "$log_dir$_");
957     }
958     &error('ビジー','ただ今混雑しています。時間をおいて再度実行してください。');
959     }
960     sleep(1);
961     opendir(DIR,"$log_dir");
962     @list = readdir(DIR);
963     closedir(DIR);
964     @lists = grep(/$ID.*\.tmp/,@list);
965     }
966    
967     #テンポラリファイルに書き込む
968     open(WRITE,">$log_dir$tmp_file") or &error('書き込みエラー','記録ファイルの書き込みが出来ません。管理者に連絡してください。');
969     print WRITE "$count\n";
970     print WRITE "$this_nj\n";
971     print WRITE @lines;
972     close(WRITE);
973    
974     #もう一度他のテンポラリファイルを検索
975     opendir(DIR,$log_dir);
976     @list = readdir(DIR);
977     closedir(DIR);
978     @lists = grep(/$ID.*\.tmp/,@list);
979     @lists = grep(!/$tmp_file/,@lists);#自分自身は除外
980     if (@lists) {#他で書き込み中であれば書き込みを中止して終了
981     unlink("$log_dir$tmp_file") if (-e "$log_dir$tmp_file");
982     &error('書き込みの競合','別の書き込みの処理中です。すこし時間をおいてから、再度ご利用下さい。');
983     }
984     rename("$log_dir$tmp_file",$logfile) or &error('書き込みの競合','書き込みに失敗しました。再度実行してください。');
985     chmod 0666, $logfile;
986     }
987    
988     sub delete_log{
989     my($delete) = @_;
990     open(WRITE,">> $arc_dir${ID}.txt") or &error('エラー','削除ログのシステムエラーです。管理者に連絡してください。');
991     @datas = &divide_log($delete);
992     @datas = sort(@datas);
993     foreach $data (@datas) {
994     my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = &divide_data($data);
995     print WRITE "No:$no $title\n";
996     print WRITE "$date";
997     print WRITE "$res へのコメント" unless ($res eq 'root');
998     print WRITE "\n";
999     $comment =~ s/<br>/\n/g;
1000     $comment =~ s/&gt;/>/g;
1001     $comment =~ s/&lt;/</g;
1002     $comment =~ s/&amp;/&/g;
1003     print WRITE "$comment\n\n";
1004     }
1005     close(WRITE);
1006     }
1007    
1008     sub random_string{
1009     my($str_length) = @_;
1010     my($str,$i);
1011     srand();
1012     for ($i=0; $i<$str_length; $i++){
1013     $str .= substr('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./', int(rand(64)),1);
1014     }
1015     return $str;
1016     }
1017    
1018     # [ エラー処理 ]
1019    
1020     sub error {
1021     my($err_msg,$err_description) = @_;
1022     print<<"_EOF_";
1023     Content-type: text/html; $charset_code
1024     Content-Language: ja
1025    
1026     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
1027     "http://www.w3.org/TR/html4/strict.dtd">
1028     <html lang="ja">
1029     <head>
1030     $link_element
1031 wakaba 1.2 $linkss
1032 wakaba 1.1 <title>(エラー報告)</title>
1033     </head>
1034     <body>
1035 wakaba 1.2 <h1>エラー</h1>
1036 wakaba 1.1 <h2>$err_msg</h2>
1037     <p>$err_description</p>
1038     _EOF_
1039     &html_footer;
1040     exit;
1041     }
1042    
1043     sub method_error{
1044     print<<"_EOF_";
1045     Status: 405 Method Not Allowed
1046     Allow: POST
1047     Content-type: text/html; $charset_code
1048     Content-Language: ja
1049    
1050     <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
1051     "http://www.w3.org/TR/html4/strict.dtd">
1052     <html lang="ja">
1053     <head>
1054 wakaba 1.2 $linkss
1055 wakaba 1.1 <title>(エラー報告)</title>
1056     </head>
1057     <body>
1058 wakaba 1.2 <h1>エラー</h1>
1059 wakaba 1.1 <h2>不正投稿</h2>
1060     <p>アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。</p>
1061     _EOF_
1062     &html_footer;
1063     exit;
1064     }
1065    
1066     sub navi_form{
1067     my($tree_count) = @_;
1068     my($this_page,$page_navi);
1069     my($tmp_query) = $uri_query;
1070     $tmp_query =~ s/;tree=\d+//;
1071     if($tree_count){
1072     for ($i = 0; $i < $tree_count; $i += $max_tree) {
1073     $j = $i / $max_tree + 1;
1074     if ($tree == $i) {
1075     $this_page = $j;
1076     } else {
1077     $page_navi .= "/ <a href=\"$this_name?$tmp_query;tree=$i\">$jページ</a>\n"
1078     }
1079     }
1080     }
1081     $page_navi .= "( $this_page / $j ページ )" if $j > 1;
1082     print<<"_EOF_";
1083     <div class="pagenavi"><hr>
1084     <p><a href="$this_name?$uri_query;md=new">新規投稿</a>
1085     $page_navi</p>
1086     <hr></div>
1087     _EOF_
1088     }
1089    
1090     sub nazo_only{
1091     my(%nazo);
1092     my(@env);
1093     my($name, $value);
1094     open(LOG, $logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。');
1095     while(<LOG>){
1096     while( m|(【.+?】)|g ){
1097     $nazo{"$1"} ++;
1098     }
1099     }
1100     close(LOG);
1101     print &html_header("謎統計情報");
1102     if(%nazo){
1103     print '<ul>';
1104     while (($name, $value) = each(%nazo)){
1105     push(@env, "$name = $value");
1106     }
1107     foreach (sort(@env)){
1108     print "<li><p>$_</p></li>";
1109     }
1110     print '</ul>';
1111     }else{
1112     print '<p>Not Found.</p>';
1113     }
1114     &html_footer;
1115     exit;
1116     }
1117    
1118     sub location{
1119     my($location) = @_;
1120     print <<"_EndOfText_";
1121     Status: 302 Found
1122     Location: $location
1123     Content-Type: text/html; charset=EUC-JP
1124     Content-Language: ja
1125    
1126     _EndOfText_
1127     print &html_header("$location");
1128     print "<p><a href=\"$location\">$location</a> を参照してください。</p>";
1129     &html_footer;
1130     exit;
1131     }
1132    
1133     sub add_query{
1134     my($name, $value) = @_;
1135     $uri_query .= ";$name=$value";
1136     $form_query .= "<input type=\"hidden\" name=\"$name\" value=\"$value\">";
1137     }
1138    
1139     sub squelch{
1140     my($data) = @_;
1141     #謎をスケルチする
1142     if( $nazo eq 'no' ){
1143     $data =~ s/(【[^<]+?】)/<del class="nazo">$1<\/del>/g;
1144     }
1145     return $data;
1146     }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24