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 [© <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') {®ist; } |
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 = ÷_log($_); |
258 |
|
|
foreach (@datas) { |
259 |
|
|
my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_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 ' ' 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) = ÷_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) = ÷_data($kiji_data); |
326 |
|
|
foreach (@kiji_datas) { |
327 |
|
|
my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_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>((>)+)/\n$1>/ig; |
358 |
|
|
$comment =~ s/<br>/\n> /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 = ÷_log(&search_tree); |
406 |
|
|
foreach (@kiji_datas) { |
407 |
|
|
my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_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) = ÷_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 = ÷_log($_); |
506 |
|
|
foreach $data (@datas) { |
507 |
|
|
my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_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) = ÷_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) = ÷_data($data); |
603 |
|
|
# &jcode'convert(*comment,'euc'); |
604 |
|
|
$comment = &squelch($comment) if $nazo; |
605 |
|
|
$comment =~ s/(<br>|\s| )+$//g; |
606 |
|
|
$comment =~ s/^(>|>)([^<]*)/<q class=\"responce\">>$2<\/q>/g; |
607 |
|
|
$comment =~ s/<br>(>|>)([^<]*)/<br><q class=\"responce\">>$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 = ÷_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) = ÷_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) = ÷_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/&/&/g; |
910 |
|
|
$text =~ s/</</g; |
911 |
|
|
$text =~ s/>/>/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 = ÷_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) = ÷_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/>/>/g; |
1001 |
|
|
$comment =~ s/</</g; |
1002 |
|
|
$comment =~ s/&/&/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 |
|
|
} |