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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations) (download)
Wed Jan 12 08:49:22 2005 UTC (20 years, 5 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +3 -3 lines
*** empty log message ***

1 #!/usr/local/bin/perl
2
3 use strict;
4 require 'jcode.pl';
5
6 ### bbs.cgi ver 2.31 (2001/08/22)
7
8 # システム情報
9 use vars qw($KEEPLOGCOUNT);
10 $KEEPLOGCOUNT = 4096; # ログファイル保持数(システム設定)
11
12 #==================================================
13 # システム関連(タイムゾーン・シグナル)
14 #==================================================
15
16 #タイムゾーンをセットする
17 {
18 $ENV{'TZ'} = "JST-9";
19 }
20
21 #シグナル対処関数
22 sub SigExit {
23 exit(0);
24 }
25
26 #対応シグナル
27 {
28 $SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = "SigExit";
29 }
30
31
32 #==================================================
33 # 初期情報の取得(POST)
34 #==================================================
35
36 {
37 use vars qw(%FORM);
38 use vars qw($buffer);
39 my (@pairs, $name, $value, $check);
40 $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
41 if ($ENV{'REQUEST_METHOD'} eq "POST") {
42 read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
43 @pairs = split /&/,$buffer;$buffer=undef;
44 foreach (@pairs) {
45 ($name, $value) = split /=/;
46 $value =~ tr/+/ /;
47 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg;
48 $value =~ s/</&lt;/g;
49 $value =~ s/>/&gt;/g;
50 $value =~ s/\r\n|\r|\n/<br>/g;
51 $value =~ s/^(?:<br>)+//g;
52 $value =~ s/(?:<br>)+$//g;
53 $value =~ s/(?:<br>){4,}/<br><br><br>/g;
54 $value =~ s/($check)[\201-\237\340-\374]<br>/$1<br>/g;
55 $buffer .= $value;
56 $FORM{$name} = $value;
57 }
58 }
59 if((&jcode'getcode(*buffer))[1] ne 'sjis'){
60 DispError("ERROR!","ERROR:Sjisで書いてね。。。");
61 }
62 if($FORM{'submit'} !~ /^[\x81-\x95|\xE0-\xEF]/ || length($FORM{'submit'}) < 6){
63 DispError("ERROR!","ERROR:文字化けしちゃうよ。。。");
64 }
65 if(length($FORM{'time'})<9){
66 DispError("ERROR!","ERROR:フォーム情報が不正です!");
67 }
68 }
69
70
71 #==================================================
72 # 設定
73 #==================================================
74
75 {
76 use vars qw(%SETTING);
77 use vars qw(%FLAG);
78 use vars qw($HOST);
79 use vars qw($DATE);
80 use vars qw($ID);
81
82 # 各種PATH生成
83 use vars qw($WWWPATH);
84 use vars qw($PATH);
85 use vars qw($DATPATH);
86 use vars qw($TEMPPATH);
87 use vars qw($IMODEPATH);
88 $FORM{'bbs'} =~ s/\0//g;
89 $PATH = "../" . $FORM{'bbs'} . "/";
90 $DATPATH = $PATH . "dat/";
91 $TEMPPATH = $PATH . "html/";
92 $IMODEPATH = $PATH . "i/";
93
94 use vars qw($NOWTIME);
95 $NOWTIME = time;
96
97 $FLAG{'FROM'}=$FORM{'FROM'};
98 $FLAG{'mail'}=$FORM{'mail'};
99 }
100
101
102 #==================================================
103 # 初期情報の取得(設定ファイル)
104 #==================================================
105
106 {
107 # 設定ファイルを読む
108 my ($m_pass,$m_key,$m_value);
109 $m_pass = $PATH . "SETTING.TXT";
110 if(-e $m_pass){
111 open(FILE,$m_pass);
112 foreach (<FILE>){
113 chop;
114 ($m_key,$m_value) = split /=/;
115 $SETTING{$m_key} = $m_value;
116 }
117 close(FILE);
118 }else{
119 # 設定ファイルがない(ERROR)
120 DispError("ERROR!","ERROR:ユーザー設定が消失しています!");
121 }
122
123 # 欠落情報の補完
124 unless($SETTING{'BBS_THREAD_NUMBER'}){$SETTING{'BBS_THREAD_NUMBER'}=20;}
125 unless($SETTING{'BBS_CONTENTS_NUMBER'}){$SETTING{'BBS_CONTENTS_NUMBER'}=10;}
126 unless($SETTING{'BBS_LINE_NUMBER'}){$SETTING{'BBS_LINE_NUMBER'} = 30;}
127 unless($SETTING{'BBS_MAX_MENU_THREAD'}){$SETTING{'BBS_MAX_MENU_THREAD'}=100;}
128 unless($SETTING{'BBS_BG_COLOR'}){$SETTING{'BBS_BG_COLOR'}="#FFFFFF";}
129 unless($SETTING{'BBS_MENU_COLOR'}){$SETTING{'BBS_MENU_COLOR'}="#CCFFCC";}
130 unless($SETTING{'BBS_MAKETHREAD_COLOR'}){$SETTING{'BBS_MAKETHREAD_COLOR'}="#CCFFCC";}
131 unless($SETTING{'BBS_THREAD_COLOR'}){$SETTING{'BBS_THREAD_COLOR'}="#EFEFEF";}
132 unless($SETTING{'BBS_SUBJECT_COLOR'}){$SETTING{'BBS_SUBJECT_COLOR'}="#FF0000";}
133 unless($SETTING{'BBS_TEXT_COLOR'}){$SETTING{'BBS_TEXT_COLOR'}="#000000";}
134 unless($SETTING{'BBS_NAME_COLOR'}){$SETTING{'BBS_NAME_COLOR'}="#008800";}
135 unless($SETTING{'BBS_LINK_COLOR'}){$SETTING{'BBS_LINK_COLOR'}="#0000FF";}
136 unless($SETTING{'BBS_ALINK_COLOR'}){$SETTING{'BBS_ALINK_COLOR'}="#FF0000";}
137 unless($SETTING{'BBS_VLINK_COLOR'}){$SETTING{'BBS_VLINK_COLOR'}="#660099";}
138 unless($SETTING{'BBS_TITLE_COLOR'}){$SETTING{'BBS_TITLE_COLOR'}="#000000";}
139 unless($SETTING{'BBS_SUBJECT_COUNT'}){$SETTING{'BBS_SUBJECT_COUNT'}=64;}
140 unless($SETTING{'BBS_NAME_COUNT'}){$SETTING{'BBS_NAME_COUNT'}=64;}
141 unless($SETTING{'BBS_MAIL_COUNT'}){$SETTING{'BBS_MAIL_COUNT'}=64;}
142 unless($SETTING{'BBS_MESSAGE_COUNT'}){$SETTING{'BBS_MESSAGE_COUNT'}=4096;}
143 #unless($SETTING{'BBS_THREAD_TATESUGI'}){$SETTING{'BBS_THREAD_TATESUGI'}=5;}
144 unless($SETTING{'timecount'}){$SETTING{'timecount'}=15;}
145 unless($SETTING{'timeclose'}){$SETTING{'timeclose'}=15;}
146 unless($SETTING{'BBS_WAIT_MINUTE'}){$SETTING{'BBS_WAIT_MINUTE'}=3;}
147 unless($SETTING{'BBS_MAX_RES_COUNT'}){$SETTING{'BBS_MAX_RES_COUNT'}=1000;}
148 unless($SETTING{'BBS_MAX_RES_SIZE'}){$SETTING{'BBS_MAX_RES_SIZE'}=500;}
149 }
150
151
152 #==================================================
153 # 初期情報の取得(日付)
154 #==================================================
155
156 {
157 # 日付と時間をげとする
158 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
159 my ($myear, $mtd, $dday, $uruu);
160 my ($wmon, $wmday, $wwday, $wdday);
161 my ($nmon, $nday, $dtime, $nhour, $nmin, $nsec);
162 my ($qyear, $quruu, $qmon, $qday, $qrokuyou);
163 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($NOWTIME);
164 $myear = $year + 1900;
165 $wday = ("日", "月", "火", "水", "木", "金", "土")[$wday];
166
167 if ( $SETTING{'BBS_LUNISOLAR_CALENDAR'} ) {
168 # 旧暦の計算(qreki.plが必要)
169 # qreki.plの入手先 → http://www3.biwako.ne.jp/~nobuaki/qreki/
170 require './qreki.pl';
171 ($qyear, $quruu, $qmon, $qday) = &qreki::calc_kyureki($myear, $mon + 1, $mday);
172 $qrokuyou = ( $qmon + $qday ) % 6;
173 $quruu = ("", "閏")[$quruu];
174 $qrokuyou = ("大安", "赤口", "先勝", "友引", "先負", "仏滅")[$qrokuyou];
175 }
176
177 if (( $SETTING{'BBS_WORLD_CALENDAR'} ) || ( $SETTING{'BBS_DECIMAL_CALENDAR'} )) {
178
179 # 閏年の判定
180 if (( $myear % 4 == 0 ) && ( $myear % 100 != 0 ) || ( $myear % 400 == 0 )) {
181 $uruu = 1;
182 } else {
183 $uruu = 0;
184 }
185
186 # 通日の計算 ( 0 〜 364 ( 平年 ), 365 ( 閏年 ) )
187 $mtd = ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 )[$mon];
188 $dday = $mtd + $mday - 1;
189 if (( $uruu == 1 ) && ( $mon >= 2 )) {
190 $dday++;
191 }
192 }
193
194 if ( $SETTING{'BBS_WORLD_CALENDAR'} ) {
195 # 世界暦の計算
196 if (( $uruu == 1 ) && ( $dday >= 183 )) {
197 $wdday = $dday - 1;
198 } else {
199 $wdday = $dday;
200 }
201 if (( $uruu == 1 ) && ( $dday == 182 )) {
202 $wmon = 6;
203 $wmday = 31;
204 $wwday = "世";
205 } elsif (( $uruu == 1 ) && ( $dday == 365 ) || ( $uruu == 0 ) && ( $dday == 364 )) {
206 $wmon = 12;
207 $wmday = 31;
208 $wwday = "世";
209 } else {
210 $wmon = int ( $wdday / ( 91 / 3 )) + 1;
211 $wmday = int ( $wdday - ( $wmon - 1 ) * ( 91 / 3 )) + 1;
212 $wwday = ("日", "月", "火", "水", "木", "金", "土")[($wdday % 7)];
213 }
214 }
215
216 if ( $SETTING{'BBS_DECIMAL_CALENDAR'} ) {
217 # 10進の暦法の計算
218 if ( $dday == 365 ) {
219 $nmon = 9;
220 $nday = 36;
221 } else {
222 $nmon = int ( $dday / 36.5 );
223 $nday = int ( $dday - $nmon * 36.5 );
224 }
225
226 # 10進の時法の計算
227 $dtime = ( $hour * 3600 + $min * 60 + $sec ) / 0.864;
228 $nhour = int ( $dtime / 10000 );
229 $nmin = int (( $dtime - $nhour * 10000 ) / 100 );
230 $nsec = int ( $dtime - $nhour * 10000 - $nmin * 100 );
231 }
232
233 # 日付・時間の合成
234 $DATE = sprintf("%04d/%02d/%02d(%s) %02d:%02d",
235 $myear, $mon + 1, $mday, $wday, $hour, $min);
236
237 if ( $SETTING{'BBS_LUNISOLAR_CALENDAR'} ) {
238 $DATE .= sprintf(" 旧暦:%04d/%s%02d/%02d(%s) %02d:%02d",
239 $qyear, $quruu, $qmon, $qday, $qrokuyou, $hour, $min);
240 }
241
242 if ( $SETTING{'BBS_WORLD_CALENDAR'} ) {
243 $DATE .= sprintf(" 世界暦:%04d/%02d/%02d(%s) %02d:%02d",
244 $myear, $wmon, $wmday, $wwday, $hour, $min);
245 }
246
247 if ( $SETTING{'BBS_DECIMAL_CALENDAR'} ) {
248 $DATE .= sprintf(" 十\進暦:%04d/%01d/%02d #%01d%02d",
249 $myear, $nmon, $nday, $nhour, $nmin);
250 }
251
252 # ID
253 my $idnum = substr($ENV{'REMOTE_ADDR'}, 8);
254 my $idcrypt = substr(crypt($idnum * $idnum, substr($DATE, 8, 2)), -8);
255 $ID = " ID:".$idcrypt;
256
257 # 有効期限をつくる
258 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
259 my $exp = 24 * 60 * 60; $exp *= 30; #有功日数を乗じる
260 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($NOWTIME + $exp);
261 $wday = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
262 $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
263 $year = $year+1900;$mday = "0$mday" if ($mday < 10);
264 $FLAG{'expires'} = "$wday, $mday-$mon-$year 00:00:00 GMT";
265 }
266
267
268 #==================================================
269 # ホスト取得
270 #==================================================
271
272 {
273 $FLAG{'PROXY'} = 0;
274 my $host2;
275 $HOST = $ENV{'REMOTE_ADDR'};
276 if ($HOST =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
277 $HOST = gethostbyaddr(pack('c4',split(/\./, $HOST)), 2) || $HOST;
278 }
279 if ($ENV{'HTTP_VIA'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/) {
280 $host2 = $ENV{'HTTP_VIA'};
281 }
282 if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/) {
283 $host2 = $ENV{'HTTP_X_FORWARDED_FOR'};
284 }
285 if ($ENV{'HTTP_FORWARDED'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/) {
286 $host2 = $ENV{'HTTP_FORWARDED'};
287 }
288 $host2 = gethostbyaddr(pack('c4', split(/\./, $host2)), 2);
289 $HOST .= "[$host2]" if ($host2);
290 if ($HOST =~ /proxy/i && $host2 eq '') { $FLAG{'PROXY'} = 1; }
291 if ($ENV{'HTTP_USER_AGENT'} =~ /ANONYMIZER/i) { $FLAG{'PROXY'} = 1; }
292 if ($host2){ $FLAG{'PROXY'} = 1; }
293 }
294
295
296 #==================================================
297 # i-mode検出
298 #==================================================
299
300 {
301 $FLAG{'imode'}=0;
302 if($FORM{'submit'} eq 'かきこむ'){$FLAG{'imode'}=1;}
303 if($ENV{'HTTP_USER_AGENT'} =~ /DoCoMo\//){$FLAG{'imode'}=1;}
304 }
305
306
307 #==================================================
308 # パス情報(名前)
309 #==================================================
310
311 {
312 $FLAG{'cap'}='';
313 if (-e "../caps.cgi" && $FORM{'mail'} =~ /#.+/) {
314 my ($id1,$name1,$pass1);
315 open(IN,"../caps.cgi");
316 foreach (<IN>) {
317 chop;
318 ($id1,$name1,$pass1) = split /<>/;
319 if($FORM{'mail'} =~ /#$pass1/){
320 $FLAG{'cap'} = "$name1 ★";$ID=" ID:???";
321 last;
322 }
323 }
324 close(IN);
325 }
326 }
327
328
329 #==================================================
330 # アクセス規制
331 #==================================================
332
333 {
334 # 不正PROXY使用ですか、、、?
335
336 # プロキシ制限の実施
337 if($FLAG{'PROXY'} == 1 && $SETTING{'BBS_PROXY_CHECK'} eq "checked") {
338 DispError("ERROR!","ERROR:PROXY規制中!");
339 }
340 if($HOST !~/jp$/ && $SETTING{'BBS_OVERSEA_PROXY'} eq "checked") {
341 DispError("ERROR!","ERROR:PROXY規制中!");
342 }
343 if($HOST !~ /jp$/ && $FORM{'subject'} ne '' && $SETTING{'BBS_OVERSEA_THREAD'} eq "checked") {
344 DispError("ERROR!","jpドメインからスレッド立ててください");
345 }
346
347 #-------------------------------ユーザー設定が異常です!
348 if(-e "../z$FORM{'bbs'}/uerror.cgi"){
349 open (IN,"../$FORM{'bbs'}/uerror.cgi");
350 foreach (<IN>){
351 chop;
352 if ($HOST =~ /$_/) {
353 DispError("ERROR!","ユーザー設定が異常です!");
354 }
355 }
356 close(IN);
357 }
358
359 #-------------------------------リモートホストを公開します。
360 if (-e "../$FORM{'bbs'}/chubo.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
361 open (IN,"../$FORM{'bbs'}/chubo.cgi");
362 foreach (<IN>){
363 chop;
364 if ($HOST =~ /$_/) {
365 $FORM{'MESSAGE'} .= '<br><br><font color=red><b>あなたのレスまたはスレッドの内容について問題があり、<br>';
366 $FORM{'MESSAGE'} .= '管理人からの警告にもかかわらず内容に改善が見られませんでしたので、<br>';
367 $FORM{'MESSAGE'} .= "あなたのリモートホスト</b>($HOST)<b>を公開します。<br>";
368 $FORM{'MESSAGE'} .= '解除申請は事務所にお願いします。</b></font>';
369 }
370 }
371 close(IN);
372 }
373
374 #-------------------------------管理人から警告します。
375 if (-e "../$FORM{'bbs'}/keikoku.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
376 open (IN,"../$FORM{'bbs'}/keikoku.cgi");
377 foreach (<IN>){
378 chop;
379 if ($HOST =~ /$_/) {
380 $FORM{'MESSAGE'} .= '<br><br><font color=orange><b>あなたのレスまたはスレッドの内容について、管理人から警告します。<br>';
381 $FORM{'MESSAGE'} .= '内容に改善が見られない場合、あなたのリモートホストが公開されます。<br>';
382 $FORM{'MESSAGE'} .= '解除申請は事務所にお願いします。</b></font>';
383 }
384 }
385 close(IN);
386 }
387
388 #-------------------------------個別の規制
389 if (-e "../$FORM{'bbs'}/arashi.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
390 open (IN,"../$FORM{'bbs'}/arashi.cgi");
391 foreach (<IN>){
392 chomp;
393 my ($arashikey , $arashihost);
394 ($arashikey , $arashihost) = (split /<>/ , $_);
395 if (($FORM{'key'} eq $arashikey) && ($HOST =~ /$arashihost/)) {
396 DispError("ERROR!","荒らしさんの使ったリモートホストです。。。");
397 }
398 }
399 close(IN);
400 }
401 }
402
403
404 #==================================================
405 # 情報の修正(名前)
406 #==================================================
407
408 {
409 #名前がなければ名無しさん(かちゅ〜しゃ使用者とそれ以外で振り分け)
410 $FLAG{'NONAME'} = 0;
411 unless($FORM{'FROM'}){
412 if (($ENV{'HTTP_USER_AGENT'} =~ /Katjusha/) || ($ENV{'HTTP_USER_AGENT'} =~ /kage/)) {
413 $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME_KA'};
414 } else {
415 $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME'};
416 }
417 $FLAG{'NONAME'} = 1;
418 if ($FLAG{'cap'}) {$FORM{'FROM'}='';}
419 }
420
421 if (($ENV{'HTTP_USER_AGENT'} !~ /Katjusha/) && ($ENV{'HTTP_USER_AGENT'} !~ /kage/)) {
422 if ($FORM{'FROM'} eq $SETTING{'BBS_NONAME_NAME_KA'}) {
423 $FORM{'FROM'} = $SETTING{'BBS_NONAME_NAME'};
424 }
425 }
426 }
427
428
429 #==================================================
430 # 情報の修正(キー)
431 #==================================================
432
433 # サブジェクトがある場合はキーを現在に設定
434 # サブジェクト&キーがない場合はエラー
435 # サブジェクトが無くキーがある場合はキーを受けとる
436 {
437 if($FORM{'subject'}){
438 $FORM{'key'} = $NOWTIME;
439 }else{
440 if(defined($FORM{'key'})){
441 # キーが数字じゃない場合ばいばい!
442 if($FORM{'key'} =~ /\D/){
443 DispError("ERROR!","ERROR:キー情報が不正です!");
444 }
445 }else{
446 if ($SETTING{'BBS_PASSWORD_CHECK'} eq "checked"){
447 print "Content-type: text/html; charset=shift_jis\n\n";
448 print <<EOF;
449 <HTML>
450 <HEAD>
451 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
452 <META HTTP-EQUIV="pragma" CONTENT="no-cache">
453 <SCRIPT LANGUAGE="JavaScript">
454 <!--
455 Name = getCookie("NAME");
456 Mail = getCookie("MAIL");
457 function getCookie(key, tmp1, tmp2, xx1, xx2, xx3) {
458 tmp1 = " " + document.cookie + ";";
459 xx1 = xx2 = 0;
460 len = tmp1.length;
461 while (xx1 < len) {
462 xx2 = tmp1.indexOf(";", xx1);
463 tmp2 = tmp1.substring(xx1 + 1, xx2);
464 xx3 = tmp2.indexOf("=");
465 if (tmp2.substring(0, xx3) == key) {
466 return(unescape(tmp2.substring(xx3 + 1, xx2 - xx1 - 1)));
467 }
468 xx1 = xx2 + 1;
469 }
470 return("");
471 }
472 // -->
473 </SCRIPT>
474 <TITLE>$SETTING{'BBS_TITLE'}</TITLE>
475 </HEAD>
476 <BODY TEXT="$SETTING{'BBS_TEXT_COLOR'}" BGCOLOR="$SETTING{'BBS_BG_COLOR'}" link="$SETTING{'BBS_LINK_COLOR'}" alink="$SETTING{'BBS_ALINK_COLOR'}" vlink="$SETTING{'BBS_VLINK_COLOR'}" background="$SETTING{'BBS_BG_PICTURE'}">
477 EOF
478 if($SETTING{'BBS_TITLE_PICTURE'}){
479 print "<div align=center>";
480 if($SETTING{'BBS_TITLE_LINK'}){ print "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
481 print "<img src=\"$SETTING{'BBS_TITLE_PICTURE'}\" border=0>";
482 if($SETTING{'BBS_TITLE_LINK'}){ print "</a>"; }
483 print "</div>";
484 }else{
485 print "<div align=center>";
486 if($SETTING{'BBS_TITLE_LINK'}){ print "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
487 # print "<FONT COLOR=\"$SETTING{'BBS_TITLE_COLOR'}\"><H1>$SETTING{'BBS_TITLE'}</H1></FONT>";
488 if($SETTING{'BBS_TITLE_LINK'}){ print "</a>"; }
489 print "</div>";
490 }
491 print "\n";
492 print <<EOF;
493 <br><table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MAKETHREAD_COLOR'}" align=center><tr><td align="center">
494 <form method=POST action="../test/bbs.cgi">
495 <TABLE BORDER="0" CELLPADDING="1" WIDTH="100%">
496 <TR><TD nowrap COLSPAN="2">
497 <font size=+1><b>$SETTING{'BBS_TITLE'}</b></font><br>
498 EOF
499 if ($SETTING{'BBS_PROXY_CHECK'} eq "checked") {
500 print " <font color=#FF0000>■PROXY規制中■</font><br>\n";
501 }
502 print " </TD>\n";
503 print " <TD width=10% ALIGN=\"right\">";
504
505 &HTM("../right.txt");
506
507 print <<EOF;
508 </TD>
509 </TR>
510 <TR><TD COLSPAN="3">
511 EOF
512
513 &HTM($PATH."head.txt");
514 print " <br></TD></TR>\n";
515 print <<EOF;
516 <TR>
517 <TD nowrap ALIGN="right">タイトル:</TD>
518 <TD COLSPAN="2"><input type="text" name="subject" size="40"> <input type=submit value="新規スレッド作成" name="submit"></TD>
519 </TR><TR>
520 <TD nowrap ALIGN="right">名前:</TD>
521 <TD>
522 <SCRIPT Language="JavaScript">
523 <!--
524 document.write("<INPUT TYPE=text NAME=FROM SIZE=20 VALUE=");
525 document.write(Name, ">");
526 // -->
527 </SCRIPT>
528 <NOSCRIPT>
529 <INPUT TYPE=text NAME=FROM SIZE=20>
530 </NOSCRIPT>
531 </TD>
532 <TD nowrap width=45%>E-mail<font size="1">(省略可)</font>:
533 <SCRIPT Language="JavaScript">
534 <!--
535 document.write("<INPUT TYPE=text NAME=mail SIZE=20 VALUE=");
536 document.write(Mail, ">");
537 // -->
538 </SCRIPT>
539 <NOSCRIPT>
540 <INPUT TYPE=text NAME=mail SIZE=20>
541 </NOSCRIPT>
542 </TD>
543 <TD><br></TD></TR><TR>
544 <TD nowrap ALIGN="right" VALIGN="top">内容:</TD>
545 <TD COLSPAN="2">
546 <textarea rows=5 cols=60 wrap=OFF name=MESSAGE></textarea>
547 <input type=hidden name=bbs value=$FORM{'bbs'}>
548 <input type=hidden name=time value=$NOWTIME>
549 </TD></TR></TABLE>
550 EOF
551 &HTM("../bottom.txt");
552 print "<br><br>\n</form>\n";
553 print "</td></tr></table><br>\n";
554 exit;
555 }
556 DispError("ERROR!","ERROR:サブジェクトが存在しません!");
557 }
558 }
559 }
560
561
562 #==================================================
563 # 書き込み確認。
564 #==================================================
565
566 {
567 if ($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'}){
568 $FORM{'subject'}=~s/&/&amp;/g;$FORM{'subject'}=~s/"/&quot;/g;
569 $FLAG{'FROM'}=~s/&/&amp;/g;$FLAG{'FROM'}=~s/"/&quot;/g;
570 $FORM{'mail'}=~s/&/&amp;/g;$FORM{'mail'}=~s/"/&quot;/g;
571 $FORM{'MESSAGE'}=~s/&/&amp;/g;$FORM{'MESSAGE'}=~s/"/&quot;/g;
572 if ($FORM{'mail'}=~/hirakata/){&hirakata;}
573 # if ($SETTING{'BBS_HIRAKATA_CHECK'} eq "checked"){&hirakata;}
574 my $message2=$FORM{'MESSAGE'};$FORM{'MESSAGE'} =~ s/<br>/\n/g;
575 # my $message2=$FORM{'MESSAGE'};$FORM{'MESSAGE'} =~ s/ <br> /\n/g;
576 print "Content-type: text/html; charset=shift_jis\n\n";
577 if (!$FLAG{'imode'}){
578 print <<EOF;
579 <html>
580 <head>
581 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
582 <META HTTP-EQUIV="pragma" CONTENT="no-cache">
583 <META HTTP-EQUIV="Cache-Control" CONTENT="no-cache">
584 <TITLE>$SETTING{'BBS_TITLE'}</TITLE>
585 </HEAD><body bgcolor="#FFFFFF">
586 <font size=+1 color=#FF0000>書き込み確認。</font><br><br>
587 書き込みに関して様々なログ情報が記録されています。<br>
588 公序良俗に反したり、他人に迷惑をかける書き込みは控えて下さい<br>
589 <form method=POST action="../test/subbbs.cgi">
590 タイトル:$FORM{'subject'}
591 <input type="hidden" name="subject" value="$FORM{'subject'}" size="40"><br>
592 名前:$FLAG{'FROM'}
593 <INPUT TYPE=hidden NAME=FROM SIZE=19 value="$FLAG{'FROM'}">
594 E-mail<font size="1">(省略可)</font>: $FORM{'mail'}
595 <INPUT TYPE=hidden NAME=mail SIZE=19 value="$FORM{'mail'}"><br>
596 内容:<ul>$message2
597 <input type=hidden name=MESSAGE value="$FORM{'MESSAGE'}"></ul>
598 <br>
599 <input type=hidden name=bbs value=$FORM{'bbs'}>
600 <input type=hidden name=time value=$FORM{'time'}>
601 <input type=submit value="全責任を負うことを承諾して書き込む" name="submit"><br>
602 </form>
603 変更する場合は戻るボタンで戻って書き直して下さい。<br>
604 </body></html>
605 EOF
606 exit;
607 } else {
608 print <<EOF;
609 <html><head></head><body>
610 <font color=#FF0000>書き込み確認。</font><br><br>
611 書き込みに関して様々なログ情報が記録されています。<br>
612 公序良俗に反したり、他人に迷惑をかける書き込みは控えて下さい<br>
613 <form method=POST action="../test/subbbs.cgi">
614 タイトル:$FORM{'subject'}
615 <input type="hidden" name="subject" value="$FORM{'subject'}" size="40"><br>
616 名前:$FLAG{'FROM'}
617 <INPUT TYPE=hidden NAME=FROM SIZE=19 value="$FLAG{'FROM'}">
618 E-mail<font size="1">(省略可)</font>: $FORM{'mail'}
619 <INPUT TYPE=hidden NAME=mail SIZE=19 value="$FORM{'mail'}"><br>
620 内容:<ul>$message2
621 <input type=hidden name=MESSAGE value="$FORM{'MESSAGE'}"></ul>
622 <br>
623 <input type=hidden name=bbs value=$FORM{'bbs'}>
624 <input type=hidden name=time value=$FORM{'time'}>
625 全責任を負うことを承諾して<input type=submit value="かきこむ" name="submit"><br>
626 </form>
627 変更する場合は戻るボタンで戻って書き直して下さい。<br>
628 </body></html>
629 EOF
630 exit;
631 }
632 }
633 }
634
635
636 #==================================================
637 # 名前いれてちょ。。。
638 #==================================================
639
640 {
641 if($SETTING{'NANASHI_CHECK'} eq 1 && $FLAG{'NONAME'} && $FLAG{'cap'} eq ''){
642 DispError("ERROR!","ERROR:名前いれてちょ。。。");
643 }
644 if($SETTING{'SUBBBS_CGI_ON'} eq 1 && $ENV{'HTTP_COOKIE'} eq ''){
645 if(!$FLAG{'imode'}){
646 if($SETTING{'BBS_NAMECOOKIE_CHECK'} eq "checked"){
647 print "Set-Cookie: NAME=$FLAG{'FROM'}; expires=$FLAG{'expires'}; path=/\n";
648 }
649 if($SETTING{'BBS_MAILCOOKIE_CHECK'} eq "checked"){
650 print "Set-Cookie: MAIL=$FLAG{'mail'}; expires=$FLAG{'expires'}; path=/\n";
651 }
652 }
653 DispError("ERROR!","ERROR:クッキーをオンにしてちょ。");
654 }
655 }
656
657
658 #==================================================
659 # ブラウザ変ですよん
660 #==================================================
661
662 {
663 if($ENV{'HTTP_USER_AGENT'} =~ /Mozilla/){
664 if($ENV{'HTTP_REFERER'} !~ /$ENV{'HTTP_HOST'}/){
665 DispError("ERROR!","ERROR:ブラウザ変ですよん");
666 }
667 if($ENV{'HTTP_REFERER'} !~ /$FORM{'bbs'}/ && $FORM{'subject'} eq ''){
668 DispError("ERROR!","ERROR:ブラウザ変ですよん");
669 }
670 }
671 }
672
673
674 #==================================================
675 # スレッドの書き込み規制
676 #==================================================
677
678 {
679 my $keyfile = $FORM{'key'} . ".dat";
680 if(-s "$DATPATH$keyfile" > 550000) {
681 DispError("ERROR!","ERROR:このスレッド大きすぎます");
682 }
683
684 if(-e "$DATPATH$keyfile"){
685 #データを取得
686 use vars qw(@keytemp);
687 open(DAT,"$DATPATH$keyfile");
688 @keytemp=<DAT>;
689 close(DAT);
690 my ($date, $subject);
691 $date = (split /<>/,$keytemp[@keytemp-1])[2];
692 $subject = (split /<>/,$keytemp[0])[4];
693 chomp($subject);
694 $FLAG{'subject'} = $subject;
695 $FLAG{'subnum'} = @keytemp;
696
697 if ($date =~/Over|\Qストッパー\E|停止/) {
698 DispError("ERROR!","ERROR:このスレッドには書けません!");
699 }
700 }
701 }
702
703
704 #==================================================
705 # フィールドサイズの判定
706 #==================================================
707
708 if(! $FLAG{'cap'}){
709 # 末尾の空白を削る
710 my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
711 $FORM{'FROM'} =~ s/($check)(?: | )+$/$1/g;
712 $FORM{'mail'} =~ s/($check)(?: | )+$/$1/g;
713 $FORM{'subject'} =~ s/($check)(?: | )+$/$1/g;
714 $FORM{'MESSAGE'} =~ s/($check)(?: | )+<br>/$1<br>/g;
715 $FORM{'MESSAGE'} =~ s/($check)(?: | )+$/$1/g;
716 # unless ($FORM{'FROM'}) {$FORM{'FROM'} = ' ';}
717
718 if(length($FORM{'subject'}) > $SETTING{'BBS_SUBJECT_COUNT'}){
719 DispError("ERROR!","ERROR:サブジェクトが長すぎます!");
720 }
721 if(length($FORM{'FROM'}) > $SETTING{'BBS_NAME_COUNT'}){
722 DispError("ERROR!","ERROR:名前が長すぎます!");
723 }
724 if(length($FORM{'mail'}) > $SETTING{'BBS_MAIL_COUNT'}){
725 DispError("ERROR!","ERROR:メールアドレスが長すぎます!");
726 }
727 if(length($FORM{'MESSAGE'}) > $SETTING{'BBS_MESSAGE_COUNT'}){
728 DispError("ERROR!","ERROR:本文が長すぎます!<br>このエラーが出る時は、掲示板が移転している場合があります。。");
729 }
730 if(length($FORM{'MESSAGE'}) == 0){
731 DispError("ERROR!","ERROR:本文がありません!");
732 }
733 }
734
735
736 #==================================================
737 # NGワードチェック
738 #==================================================
739
740 #if (-e "../$FORM{'bbs'}/ngword.cgi" && !($SETTING{'BBS_NEWSUBJECT'} && $FORM{'subject'})){
741 if (-e "../$FORM{'bbs'}/ngword.cgi"){
742 open (IN,"../$FORM{'bbs'}/ngword.cgi");
743 foreach (<IN>){
744 chomp;
745 $_ =~ s/\r\n|\r|\n//g;
746 $FORM{'MESSAGE'} =~ s/\Q$_\E/<b>(NGワード)<\/b>/g;
747 # if ($FORM{'MESSAGE'} =~ /$_/) {
748 # DispError("ERROR!","ERROR:NGワードが含まれています。書き直してちょ。");
749 # }
750 }
751 close(IN);
752 }
753
754
755 #==================================================
756 # スレッド立てすぎチェック
757 #==================================================
758
759 {
760 if($FORM{'subject'} && $SETTING{'BBS_THREAD_TATESUGI'}>=2){
761 my $file = $PATH . "RIP.cgi";
762 my @IP;
763 if(-e $file){
764 open(RIP,"<$file");
765 @IP = <RIP>;
766 close(RIP);
767 foreach(@IP){
768 chop;
769 if($HOST eq $_){
770 DispError("ERROR!","ERROR:スレッド立てすぎです。。。");
771 }
772 }
773 @IP=@IP[0..$SETTING{'BBS_THREAD_TATESUGI'}-2];
774 }
775 unshift(@IP,$HOST);
776 open(WIP,">$file");
777 eval{flock(WIP,2);};
778 foreach(@IP){
779 print WIP "$_\n";
780 }
781 eval{flock(WIP,8);};
782 close(WIP);
783 chmod(0666,$file);
784 }
785 }
786
787
788 #==================================================
789 # 連続投稿規制
790 #==================================================
791
792 {
793 if($SETTING{'timecount'}>=2){
794 my ($key,$host1);my @IP;my $count=0;my $file = $PATH . "timecheck.cgi";
795 if(-e $file){
796 open(RIP,"<$file");
797 @IP = <RIP>;
798 close(RIP);
799 foreach(@IP){
800 chop;
801 ($key,$host1) = split /<>/;
802 if($HOST eq $host1){
803 if($FORM{'time'} eq $key){
804 DispError("ERROR!","ERROR:2重カキコですか??");
805 }
806 $count++;
807 }
808 }
809 @IP=@IP[0..$SETTING{'timecount'}-2];
810 }
811 if($count >= $SETTING{'timecount'}) {
812 DispError("ERROR!","ERROR:連続投稿ですか??");
813 }
814 unshift(@IP,"$FORM{'time'}<>$HOST");
815 open(WIP,">$file");
816 eval{flock(WIP,2);};
817 foreach(@IP){
818 print WIP "$_\n";
819 }
820 eval{flock(WIP,8);};
821 close(WIP);
822 chmod(0666,$file);
823 }
824 }
825
826
827 #==================================================
828 # 置き換え
829 #==================================================
830
831 {
832 $FORM{'FROM'} =~s/◆/◇/g;
833 if (($FORM{'FROM'} ne $SETTING{'BBS_NONAME_NAME'}) && ($FORM{'FROM'} ne $SETTING{'BBS_NONAME_NAME_KA'})){
834 $FORM{'FROM'} =~s/★/☆/g;
835 }
836
837 $FORM{'FROM'} =~ s/&(rl[emo]|lr[emo]);//g;
838 $FORM{'mail'} =~ s/&(rl[emo]|lr[emo]);//g;
839 $FORM{'subject'} =~ s/&(rl[emo]|lr[emo]);//g;
840
841 $FORM{'FROM'} =~s/削除/"削除"/g;
842 $FORM{'FROM'} =~s/sakujyo/"sakujyo"/g;
843 $FORM{'FROM'} =~s/管理人/"管理人"/g;
844 $FORM{'FROM'} =~s/管直人/"管直人"/g;
845 $FORM{'FROM'} =~s/菅直人/"菅直人"/g;
846
847 # トリップ
848 my ($key,$salt);
849 $FORM{'FROM'} =~ s/&#/<&>/g;
850 if($FORM{'FROM'}=~/#(.+)/){
851 $key = $1;
852 $salt = substr($key."H.", 1, 2);
853 $salt =~ s/[^\.-z]/\./go;
854 $salt =~ tr/:;<=>?@[\\]^_`/ABCDEFGabcdef/;
855 $FLAG{'trip'} = substr(crypt($key, $salt),-10);
856 }
857
858 $FORM{'FROM'} =~ s/#.*//g;
859 $FORM{'FROM'} =~ s/<&>/&#/g;
860 $FORM{'mail'} =~ s/#.*//g;
861
862 if($FLAG{'trip'}){
863 $FORM{'FROM'}.=" "if($FORM{'FROM'});
864 $FORM{'FROM'}.="<trip>";
865 }
866
867 if($FLAG{'cap'}){
868 $FLAG{'cap'}="@$FLAG{'cap'}"if($FORM{'FROM'});
869 $FORM{'FROM'}.="$FLAG{'cap'}";
870 }
871
872 my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
873 $FORM{'FROM'} =~ s/($check)fusianasan/$1<f>/g;
874 $FORM{'FROM'} =~ s/<f>/<\/b>$HOST<b>/g;
875
876 if ($FORM{'FROM'} =~ /($check)nukeanasan/){
877 $FORM{'FROM'} =~ s/($check)nukeanasan/$1<n>/g;
878 my $USERAGENT = $ENV{'HTTP_USER_AGENT'};
879 if ($USERAGENT =~ /[\0-\37\177-\377]/){
880 DispError("ERROR!","ERROR:User Agentをいじってんじゃねぇよゴルァ(゚Д゚)");
881 }
882 $USERAGENT =~ s/</&lt;/g;
883 $USERAGENT =~ s/>/&gt;/g;
884 $FORM{'FROM'} =~ s/<n>/<\/b><font color=red><small>$USERAGENT<\/small><\/font><b>/g;
885 }
886
887 $FORM{'FROM'} =~ s/<trip>/◆<\/b>$FLAG{'trip'}<b>/g;
888
889 $FORM{'MESSAGE'} =~ s/\t//g;
890
891 if ($FORM{'mail'} =~ /hirakata/){&hirakata;}
892 # if ($SETTING{'BBS_HIRAKATA_CHECK'} eq "checked"){&hirakata;}
893
894 $FORM{'MESSAGE'} =~ s/($check)[\201-\237\340-\374]&/$1&/g;
895 $FORM{'MESSAGE'} =~ s/(&gt;&gt;\d+-?\d*)/<r>$1<\/r>/g;
896 $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)-(\d+)<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/n$1-$2" target="_blank">&gt;&gt;$1-$2<\/a>/g;
897 $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)-<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/$1n-" target="_blank">&gt;&gt;$1-<\/a>/g;
898 $FORM{'MESSAGE'} =~ s/<r>&gt;&gt;(\d+)<\/r>/<a href="..\/test\/read.cgi\/$FORM{'bbs'}\/$FORM{'key'}\/$1" target="_blank">&gt;&gt;$1<\/a>/g;
899 $FORM{'MESSAGE'} =~ s/<\/?r>//g;
900 }
901
902
903 #==================================================
904 # 情報の修正
905 #==================================================
906
907 {
908 # UNICODE置き換え
909 $FORM{'mail'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
910 $FORM{'subject'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
911 if ($SETTING{'BBS_UNICODE'} ne "pass"){
912 $FORM{'FROM'} =~ s/&#[x0-9a-fA-F;]+/&;/g;
913 $FORM{'MESSAGE'} =~ s/&#[x0-9a-fA-F;]+/?/g;
914 }
915
916 # 1行データからは改行を削ります
917 $FORM{'FROM'} =~ s/<br>//g;
918 $FORM{'mail'} =~ s/<br>//g;
919 $FORM{'subject'} =~ s/<br>//g;
920
921 # デカ文字対策
922 $FORM{'FROM'} =~ s/"/&quot;/g;
923 $FORM{'mail'} =~ s/"/&quot;/g;
924 $FORM{'subject'} =~ s/"/&quot;/g;
925 ##$FORM{'mail'} =~ s/ //g;
926
927 # 末尾にsjisの1バイト目があったら削る
928 my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
929 my $check2 = '[\201-\237\340-\374]';
930 $FORM{'FROM'} =~ s/($check1)$check2$/$1/g;
931 $FORM{'mail'} =~ s/($check1)$check2$/$1/g;
932 $FORM{'subject'} =~ s/($check1)$check2$/$1/g;
933 $FORM{'MESSAGE'} =~ s/($check1)$check2$/$1/g;
934
935 # mail欄にpreと入れると<pre>を、teletypeと入れると<tt>を挿入
936 if ($FORM{'mail'} =~ /pre/) {
937 $FORM{'MESSAGE'} = "<pre>$FORM{'MESSAGE'}</pre>";
938 $FORM{'MESSAGE'} =~ s/ <br> / <br>/g;
939 } elsif ($FORM{'mail'} =~ /teletype/) {
940 $FORM{'MESSAGE'} = "<tt>$FORM{'MESSAGE'}</tt>";
941 }
942 }
943
944
945 #==================================================
946 # ID・IP表示
947 #==================================================
948
949 {
950 if ($FORM{'mail'} ne '' && $SETTING{'BBS_FORCE_ID'} ne "checked") {
951 $ID = " ID:???";
952 }
953 if ($SETTING{'BBS_ADMIN_NAME'} && $FLAG{'cap'} =~ /$SETTING{'BBS_ADMIN_NAME'}/) {
954 $ID = " ID:$SETTING{'BBS_ADMIN_ID'}";
955 }
956 if ($SETTING{'BBS_NO_ID'} ne "checked") {
957 $DATE .= $ID;
958 }
959 if ($SETTING{'BBS_DISP_IP'} eq "checked") {
960 $DATE .=" <font size=1>[ $HOST ]</font>";
961 }
962 }
963
964
965 #==================================================
966 # ファイル操作(サブジェクトファイル読み込み)
967 #==================================================
968
969 {
970 use vars qw(@PAGEFILE);
971 use vars qw(%SUBJECT);
972 use vars qw($FILENUM);
973 my ($subtt,$subtm,$subval,$subnum);
974 my ($file, $value, $filename);
975 my $subject = $PATH . "subject.txt";
976 my $keyfile = $FORM{'key'} . ".dat";
977 undef $subtm;
978 undef $subtt;
979
980 # サブジェクトファイルを読み込む
981 open(SUBR,"<$subject");
982 eval{flock(SUBR,1);};
983 foreach(<SUBR>){
984 chop;
985 ($file, $value) = split /<>/;
986 unless($file){next;}
987 $filename = $DATPATH . $file;
988 if(-e $filename){ # datが存在する場合順番に追加
989 push(@PAGEFILE,$file);
990 $SUBJECT{$file} = $value;
991 }
992 }
993 eval{flock(SUBR,8);};
994 close(SUBR);
995 # サブジェクト数を取得
996 $FILENUM=@PAGEFILE;
997 if($FORM{'subject'}){$FILENUM++;}
998
999 # ログを定数に揃える
1000 if($FILENUM > $KEEPLOGCOUNT){
1001 for(my $start=$KEEPLOGCOUNT;$start<$FILENUM;$start++){
1002 my ($key,$delfile);
1003 $delfile = $DATPATH . $PAGEFILE[$start];
1004 unlink($delfile);
1005 $key = $PAGEFILE[$start];
1006 $key =~ s/([^\.]*)\.dat/$1/;
1007 $delfile = $TEMPPATH . $key . ".html";
1008 unlink($delfile);
1009 }
1010 $FILENUM = $KEEPLOGCOUNT;
1011 my @temp;
1012 @temp = @PAGEFILE[0..$FILENUM];
1013 undef @PAGEFILE;
1014 @PAGEFILE = @temp;
1015 }
1016
1017 # サブジェクトが存在するか?
1018 unless($FORM{'subject'}){ # 無い場合
1019 # データファイルがあるか検証
1020 unless(-e "$DATPATH$keyfile"){
1021 DispError("ERROR!","ERROR:該当スレッドがありません!");
1022 }
1023 $subval = $FLAG{'subject'};
1024 $subnum = $FLAG{'subnum'};
1025 $subnum++;
1026 # if($subnum > 999){$subnum++;}
1027 }else{
1028 # サブジェクトがある場合それは新規スレッドである・・
1029 $subval = $FORM{'subject'};
1030 $subnum = 1;
1031 }
1032
1033 # レス数とdat容量が規定値を超えていたらレス数を+1する
1034 my $datafile = $DATPATH . $FORM{'key'} . ".dat";
1035 if ($subnum > ($SETTING{'BBS_MAX_RES_COUNT'} - 1)) {$subnum++;}
1036 if (-s "$datafile" >= ($SETTING{'BBS_MAX_RES_SIZE'} * 1024)) {$subnum++;}
1037
1038 $subtt = "$subval ($subnum)";
1039 $subtm = "$keyfile<>$subtt";
1040
1041 # サブジェクトハッシュを書き換える
1042 $SUBJECT{$keyfile}=$subtt;
1043
1044 #スレの1と現在のメール欄からデフォルトのモードを判定
1045 unless ($FORM{'subject'}) {
1046 open (MODE,"../$FORM{'bbs'}/dat/$FORM{'key'}.dat");
1047 my @LOG = <MODE>;
1048 close (MODE);
1049
1050 my $mailcom = (split /<>/,$LOG[0])[1];
1051 undef @LOG;
1052 if ($mailcom =~/hane/) {$FLAG{'submode'} = 'hane';}
1053 elsif ($mailcom =~/kage/) {$FLAG{'submode'} = 'kage';}
1054 elsif ($mailcom =~/sage/) {$FLAG{'submode'} = 'sage';}
1055 elsif ($mailcom =~/dame/) {$FLAG{'submode'} = 'dame';}
1056 else {$FLAG{'submode'} = '';}
1057 }
1058 if ($FORM{'mail'} =~/^age/) {$FLAG{'submode'} = '';}
1059 elsif ($FORM{'mail'} =~/hane/) {$FLAG{'submode'} = 'hane';}
1060 elsif ($FORM{'mail'} =~/kage/) {$FLAG{'submode'} = 'kage';}
1061 elsif ($FORM{'mail'} =~/sage/) {$FLAG{'submode'} = 'sage';}
1062 elsif ($FORM{'mail'} =~/dame/) {$FLAG{'submode'} = 'dame';}
1063
1064 # サブジェクトテキストを開く
1065 {
1066 my $newsub;
1067 $newsub = "";
1068
1069 # haneのときは適当な場所に飛ばす
1070 if ($FLAG{'submode'} eq 'hane') {
1071 my (@temp,$random);
1072 srand;
1073 $random = int(rand (@PAGEFILE - 1));
1074 foreach(@PAGEFILE){
1075 if(@temp == $random){
1076 $temp[@temp]=$keyfile;
1077 $newsub .= "$subtm\n";
1078 }
1079 if($_ ne $keyfile){
1080 $temp[@temp]=$_;
1081 $newsub .= "$_<>$SUBJECT{$_}\n";
1082 }
1083 }
1084 @PAGEFILE=@temp;
1085 # kageのときは真ん中に持ってくる
1086 } elsif ($FLAG{'submode'} eq 'kage') {
1087 my (@temp,$middle);
1088 $middle = int(@PAGEFILE / 2);
1089 foreach(@PAGEFILE){
1090 if(@temp == $middle){
1091 $temp[@temp]=$keyfile;
1092 $newsub .= "$subtm\n";
1093 }
1094 if($_ ne $keyfile){
1095 $temp[@temp]=$_;
1096 $newsub .= "$_<>$SUBJECT{$_}\n";
1097 }
1098 }
1099 @PAGEFILE=@temp;
1100 # sageの時は上がらない
1101 } elsif ($FORM{'subject'} eq "" && $FLAG{'submode'} eq 'sage') {
1102 foreach(@PAGEFILE){
1103 $newsub .= "$_<>$SUBJECT{$_}\n";
1104 }
1105 # dameの時は一番下に移す
1106 } elsif ($FLAG{'submode'} eq 'dame') {
1107 my @temp;
1108 foreach(@PAGEFILE){
1109 if($_ ne $keyfile){
1110 $temp[@temp]=$_;
1111 $newsub .= "$_<>$SUBJECT{$_}\n";
1112 }
1113 }
1114 $temp[@temp]=$keyfile;
1115 $newsub .= "$subtm\n";
1116 @PAGEFILE=@temp;
1117 # それ以外は全てage(一番上に移す)
1118 } else {
1119 my @temp;
1120 $temp[0]=$keyfile;
1121 $newsub = "$subtm\n";
1122 foreach(@PAGEFILE){
1123 # 上がるキーは一番最初に持ってくる
1124 # keyfileは現在書き込みしたスレッドキー(上がっている)
1125 if($_ ne $keyfile){
1126 $temp[@temp]=$_;
1127 $newsub .= "$_<>$SUBJECT{$_}\n";
1128 }
1129 }
1130 @PAGEFILE=@temp;
1131 }
1132
1133 #一括書き込み(板飛び対策入り)
1134 # 読み書きモードでオープン
1135 open(SUBW,"+<$subject");
1136 eval{flock(SUBW,2);};
1137 # ファイルポインタを先頭に
1138 seek(SUBW, 0, 0);
1139 print SUBW $newsub;
1140 # 新ファイルサイズを出力
1141 eval{truncate(SUBW, tell(SUBW));};
1142 # (念のため)ロック解除はクローズ処理任せに
1143 # eval{flock(SUBW,8);};
1144 close(SUBW);
1145 }
1146 # i-mode用テキストを開く
1147 {
1148 unless(-e $IMODEPATH){
1149 mkdir($IMODEPATH,0777);
1150 }
1151 my $imodeindex = $IMODEPATH . "index.html";
1152 open(SUBW,">$imodeindex");
1153 eval{flock(SUBW,2);};
1154 # 一括書き込み
1155 print SUBW "<HTML>\n";
1156 print SUBW "<HEAD>\n";
1157 print SUBW "<TITLE>$SETTING{'BBS_TITLE'}</TITLE>\n";
1158 print SUBW "</HEAD>\n";
1159 print SUBW "おんぷちゃんねる i-mode <a href=\"../../../../i/\">トップ</a><hr>";
1160 print SUBW "$SETTING{'BBS_TITLE'}<hr>";
1161
1162 my ($count,$key,$end,$subtitle);
1163 if($FILENUM<30){$end=$FILENUM;}else{$end=30;}
1164 for($count=1;$count<=$end;$count++){
1165 @PAGEFILE[$count-1]=~ /(\d*)\.dat/;
1166 $key = $1;
1167 $subtitle = $SUBJECT{@PAGEFILE[$count-1]};
1168 &jcode::z2h_sjis(\$subtitle);
1169 print SUBW "$count: <a href=\"../../test/read.cgi/$FORM{'bbs'}/$key/i\">$subtitle</a><br>";
1170 }
1171 $count=@PAGEFILE;
1172 if ($count > 30){
1173 print SUBW "<hr><a href=\"../../test/pageview.cgi?bbs=$FORM{'bbs'}&page=2&imode=true\">次</a>\n";
1174 }
1175 print SUBW "<hr>\n";
1176 print SUBW <<EOF;
1177 <form action="../../test/bbs.cgi" method="POST">
1178 <input type=hidden name=bbs value=$FORM{'bbs'}>
1179 <input type=hidden name=time value=$NOWTIME>
1180 <input type="hidden" name="imode" value="true">
1181 タイトル:<input size="10" name="subject" type="text"><br>
1182 名前:<input type=text name=FROM size=10><br>
1183 mail:<input type=text name=mail size=10><br>
1184 コメント<br>
1185 <textarea ROWS=2 COLS=18 NAME=MESSAGE></textarea><br>
1186 <input type="submit" name="submit" value="新スレ作成"><br>
1187 </form>
1188 EOF
1189 print SUBW "<hr></BODY></HTML>\n";
1190 eval{flock(SUBW,8);};
1191 close(SUBW);
1192 # パーミッション調整
1193 chmod(0666,$imodeindex);
1194 }
1195 # 過去ログメニューをかーくー
1196 {
1197 my $sub = $PATH . "subback.html";
1198 open(HED,">$sub");
1199 eval{flock(HED,2);};
1200 print HED<<EOF;
1201 <html><head><meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS"><META HTTP-EQUIV="pragma" CONTENT="no-cache"><META HTTP-EQUIV="Cache-Control" CONTENT="no-cache"></head><body>
1202 <font size=2><base target="body">
1203 EOF
1204 my $dat;
1205 for(my $count=1;$count<=$FILENUM;$count++){
1206 $PAGEFILE[$count-1]=~/(\d+)\.dat/;
1207 $dat=$1;
1208 print HED "<a href=\"../test/read.cgi/$FORM{'bbs'}/$dat/l50\">$count: $SUBJECT{$PAGEFILE[$count-1]}</a> \n";
1209 }
1210 print HED "<div align=\"right\"><a href=\"./kako/index.html\"><b>倉庫はこちら</b></a>";
1211 print HED "</body></html>";
1212 eval{flock(HED,8);};
1213 close(HED);
1214 }
1215 }
1216
1217
1218 #==================================================
1219 # クッキー発行
1220 #==================================================
1221
1222 {
1223 if(!$FLAG{'imode'}){
1224 # クッキー食わせる
1225 if($SETTING{'BBS_NAMECOOKIE_CHECK'} eq "checked"){
1226 print "Set-Cookie: NAME=$FLAG{'FROM'}; expires=$FLAG{'expires'}; path=/\n";
1227 }
1228 if($SETTING{'BBS_MAILCOOKIE_CHECK'} eq "checked"){
1229 print "Set-Cookie: MAIL=$FLAG{'mail'}; expires=$FLAG{'expires'}; path=/\n";
1230 }
1231 }
1232 }
1233
1234
1235 #==================================================
1236 # ファイル操作(DATファイル更新)
1237 #==================================================
1238
1239 {
1240 my $datafile = $DATPATH . $FORM{'key'} . ".dat";
1241
1242 open(OUT, ">> $datafile");
1243 eval{flock(OUT,2);};
1244
1245 print OUT "$FORM{'FROM'}<>$FORM{'mail'}<>$DATE<>$FORM{'MESSAGE'}<>$FORM{'subject'}\n";
1246 push(@keytemp,"$FORM{'FROM'}<>$FORM{'mail'}<>$DATE<>$FORM{'MESSAGE'}<>$FORM{'subject'}\n");
1247
1248 # レス数が規定値を超えるとスレストをかける
1249 if ($FLAG{'subnum'} > ($SETTING{'BBS_MAX_RES_COUNT'} - 2)) {
1250 my $maxres = $SETTING{'BBS_MAX_RES_COUNT'};
1251 my $maxres1 = $maxres + 1;
1252 print OUT "$maxres1<><>Over $maxres Thread<>このスレッドは$maxresを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n";
1253 push (@keytemp,"$maxres1<><>Over $maxres Thread<>このスレッドは$maxresを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n");
1254 }
1255
1256 # dat容量が規定値を超えるとスレストをかける
1257 if (-s "$datafile" >= ($SETTING{'BBS_MAX_RES_SIZE'} * 1024)) {
1258 my $maxsize = $SETTING{'BBS_MAX_RES_SIZE'} . "KB";
1259 print OUT "$maxsize<><>Over $maxsize data<>このスレッドは$maxsizeを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n";
1260 push (@keytemp,"$maxsize<><>Over $maxsize data<>このスレッドは$maxsizeを超えました。<br>もう書けないので、新しいスレッドを立ててくださいです。。。<>\n");
1261 }
1262
1263 eval{flock(OUT,8);};
1264 close(OUT);
1265
1266 # -----------------------------------------------------------------------
1267 if(-e $PATH."log/"){
1268 my $log = $PATH . "log/" . $FORM{'key'} . ".cgi";
1269 my $num=$FLAG{'subnum'};$num++;
1270 open(WIP,">>$log");
1271 eval{flock(WIP,2);};
1272 print WIP "$num<>$ENV{'REMOTE_ADDR'}<>$HOST<>$NOWTIME\n";
1273 eval{flock(WIP,8);};
1274 close(WIP);
1275 chmod(0600,$log);
1276 }
1277 # -----------------------------------------------------------------------
1278
1279 # パーミッション調整
1280 chmod(0666,$datafile);
1281 chmod(0777,"$DATPATH");
1282 chmod(0777,"$PATH");
1283 }
1284
1285
1286 #==================================================
1287 # ファイル操作(HTML作成用作業ファイル更新)
1288 #==================================================
1289
1290 #HTML用DATを作成
1291 {
1292 MakeWorkFile($FORM{'key'});
1293 #パーミッション調整
1294 chmod(0777,$TEMPPATH);
1295 }
1296
1297
1298 #==================================================
1299 # 本HTML吐き処理
1300 #==================================================
1301
1302 {
1303 use vars qw($INDEXFILE);
1304 $INDEXFILE = $PATH . "index.html";
1305 open(HTM,">$INDEXFILE");
1306 eval{flock(HTM,2);};
1307 print HTM <<EOF;
1308 <HTML>
1309 <HEAD>
1310 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1311 <META HTTP-EQUIV="pragma" CONTENT="no-cache">
1312 <SCRIPT LANGUAGE="JavaScript">
1313 <!--
1314 Name = getCookie("NAME");
1315 Mail = getCookie("MAIL");
1316 function getCookie(key, tmp1, tmp2, xx1, xx2, xx3) {
1317 tmp1 = " " + document.cookie + ";";
1318 xx1 = xx2 = 0;
1319 len = tmp1.length;
1320 while (xx1 < len) {
1321 xx2 = tmp1.indexOf(";", xx1);
1322 tmp2 = tmp1.substring(xx1 + 1, xx2);
1323 xx3 = tmp2.indexOf("=");
1324 if (tmp2.substring(0, xx3) == key) {
1325 return(unescape(tmp2.substring(xx3 + 1, xx2 - xx1 - 1)));
1326 }
1327 xx1 = xx2 + 1;
1328 }
1329 return("");
1330 }
1331 // -->
1332 </SCRIPT>
1333 <TITLE>$SETTING{'BBS_TITLE'}</TITLE>
1334 </HEAD>
1335 <BODY TEXT="$SETTING{'BBS_TEXT_COLOR'}" BGCOLOR="$SETTING{'BBS_BG_COLOR'}" link="$SETTING{'BBS_LINK_COLOR'}" alink="$SETTING{'BBS_ALINK_COLOR'}" vlink="$SETTING{'BBS_VLINK_COLOR'}" background="$SETTING{'BBS_BG_PICTURE'}">
1336 EOF
1337
1338 if($SETTING{'BBS_TITLE_PICTURE'}){
1339 print HTM "<div align=center>";
1340 if($SETTING{'BBS_TITLE_LINK'}){ print HTM "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
1341 print HTM "<img src=\"$SETTING{'BBS_TITLE_PICTURE'}\" border=0>";
1342 if($SETTING{'BBS_TITLE_LINK'}){ print HTM "</a>"; }
1343 print HTM "</div>";
1344 }else{
1345 print HTM "<div align=center>";
1346 if($SETTING{'BBS_TITLE_LINK'}){ print HTM "<a href=\"$SETTING{'BBS_TITLE_LINK'}\" border=0>"; }
1347 # print HTM "<FONT COLOR=\"$SETTING{'BBS_TITLE_COLOR'}\"><H1>$SETTING{'BBS_TITLE'}</H1></FONT>";
1348 if($SETTING{'BBS_TITLE_LINK'}){ print HTM "</a>"; }
1349 print HTM "</div>";
1350 }
1351
1352 print HTM "\n";
1353 print HTM<<EOF;
1354 <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MAKETHREAD_COLOR'}" align=center><tr><td align="center">
1355 <form method=POST action="../test/bbs.cgi">
1356 <TABLE BORDER="0" CELLPADDING="1" WIDTH="100%">
1357 <TR><TD nowrap COLSPAN="2">
1358 <font size=+1><b>$SETTING{'BBS_TITLE'}</b></font><br>
1359 EOF
1360 if ($SETTING{'BBS_PROXY_CHECK'} eq "checked") {
1361 print HTM " <font color=#FF0000>■PROXY規制中■</font><br>\n";
1362 }
1363 print HTM " </TD>\n";
1364 print HTM " <TD width=10% ALIGN=\"right\">";
1365 &HTM("../right.txt",1);
1366 print HTM<<EOF;
1367 </TD>
1368 <TD nowrap width=5% ALIGN="right" VALIGN="top"><a href="#menu">■</a> <a href="#1">▼</a></TD>
1369 </TR>
1370 <TR><TD COLSPAN="3">
1371 EOF
1372 &HTM($PATH."head.txt",1);
1373
1374 print HTM<<EOF;
1375 <br><font color=red>この板の1スレッドの制限は最大$SETTING{'BBS_MAX_RES_COUNT'}レス、または最大$SETTING{'BBS_MAX_RES_SIZE'}KBになっています。</font><br>
1376 EOF
1377
1378 print HTM " <br></TD></TR>\n";
1379
1380 if ($SETTING{'BBS_PASSWORD_CHECK'} ne "checked"){
1381 print HTM<<EOF;
1382 <TR>
1383 <TD nowrap ALIGN="right">タイトル:</TD>
1384 <TD COLSPAN="2"><input type="text" name="subject" size="40"> <input type=submit value="新規スレッド作成" name="submit"></TD>
1385 </TR><TR>
1386 <TD nowrap ALIGN="right">名前:</TD>
1387 <TD>
1388 <SCRIPT Language="JavaScript">
1389 <!--
1390 document.write("<INPUT TYPE=text NAME=FROM SIZE=20 VALUE=");
1391 document.write(Name, ">");
1392 // -->
1393 </SCRIPT>
1394 <NOSCRIPT>
1395 <INPUT TYPE=text NAME=FROM SIZE=20>
1396 </NOSCRIPT>
1397 </TD>
1398 <TD nowrap width=45%>E-mail<font size="1">(省略可)</font>:
1399 <SCRIPT Language="JavaScript">
1400 <!--
1401 document.write("<INPUT TYPE=text NAME=mail SIZE=20 VALUE=");
1402 document.write(Mail, ">");
1403 // -->
1404 </SCRIPT>
1405 <NOSCRIPT>
1406 <INPUT TYPE=text NAME=mail SIZE=20>
1407 </NOSCRIPT>
1408 </TD>
1409 <TD><br></TD></TR><TR>
1410 <TD nowrap ALIGN="right" VALIGN="top">内容:</TD>
1411 <TD COLSPAN="2">
1412 <textarea rows=5 cols=60 wrap=OFF name=MESSAGE></textarea>
1413 <input type=hidden name=bbs value=$FORM{'bbs'}>
1414 <input type=hidden name=time value=$NOWTIME>
1415 </TD></TR></TABLE>
1416 EOF
1417 }else{
1418 print HTM<<EOF;
1419 <TD nowrap COLSPAN="5" ALIGN="center">
1420 <input type=submit value="新規スレッド作成画面へ" name="submit">
1421 <input type=hidden name=bbs value=$FORM{'bbs'}>
1422 <input type=hidden name=time value=$NOWTIME>
1423 </TD></TR></TABLE>
1424 EOF
1425 }
1426 &HTM("../bottom.txt",1);
1427 print HTM "\n</form>\n";
1428 my $lp=int($FILENUM / $SETTING{'BBS_THREAD_NUMBER'});
1429 if($FILENUM != $lp * $SETTING{'BBS_THREAD_NUMBER'}){
1430 $lp++;
1431 }
1432 if($lp>1){
1433 print HTM "<a href=\"../test/pageview.cgi?page=$lp&bbs=$FORM{'bbs'}\">最後のページ</a>";
1434 }
1435
1436 my $nextpage;
1437 if($FILENUM>$SETTING{'BBS_THREAD_NUMBER'}){
1438 $nextpage=1;
1439 print HTM " <a href=\"../test/pageview.cgi?page=2&bbs=$FORM{'bbs'}\">次のページ</a>";
1440 }
1441
1442 print HTM " <a href=\"subback.html\">スレッド一覧</a>";
1443 print HTM " <a href=\"i/index.html\">携帯電話向け</a>";
1444 #print HTM " <a href=\"http://www.2ch.net/guide/faq.html\">FAQ</a>";
1445 #print HTM " <a href=\"index.html\">再読み込み</a>\n";
1446 print HTM "<table border=0 width=100%><tr>";
1447 print HTM "<td align=\"right\"><a href=\"http://onpumoe.hp.infoseek.co.jp/script/\">GlobalNoteScript</a>";
1448 print HTM "</td></tr></table>";
1449 print HTM "</td></TR>\n";
1450 print HTM "</td></tr><tr><td><font size=2>";
1451 &HTM("../bbstable.txt",1);
1452 print HTM <<EOF;
1453 </font></td></tr></table><br>
1454 <a name="menu"></a>
1455 <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MENU_COLOR'}"align=center>
1456 <tr><td><font size=2>
1457 EOF
1458
1459 ### スレッド一覧を吐き出す
1460 #スレッド吐き出し用にファイル数を調整
1461 if($FILENUM > $SETTING{'BBS_MAX_MENU_THREAD'}){
1462 $FILENUM=$SETTING{'BBS_MAX_MENU_THREAD'};
1463 }
1464 my ($dat, $key, $count);
1465 for($count=1;$count<=$FILENUM;$count++){
1466 $dat=$key=$PAGEFILE[$count-1];
1467 $key=~s/([^\.]*)\.dat/$1/;
1468 unless($1){next;}
1469
1470 if($SETTING{'BBS_THREAD_NUMBER'} >= $count){
1471 print HTM "<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/l50\" target=\"body\">$count:</a> <a href=\"#$count\">$SUBJECT{$dat}</a> \n";
1472 }else{
1473 print HTM "<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/l50\" target=\"body\">$count: $SUBJECT{$dat}</a> \n";
1474 }
1475 }
1476 print HTM "\n";
1477 print HTM "<div align=\"right\"><a href=\"./subback.html\"><b>スレッド一覧はこちら</b></a></font>\n";
1478 print HTM "</td></tr></table><br>\n";
1479
1480
1481 my $headad = "../headad.txt";
1482 if(-e $headad){
1483 my @headad;
1484 open(IN, "$headad");
1485 @headad = <IN>;
1486 close(IN);
1487 if (@headad){
1488 print HTM "<table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor=\"$SETTING{'BBS_MENU_COLOR'}\"align=center><tr><td>\n";
1489 foreach(@headad){print HTM;}
1490 print HTM "</td></tr></table><br>\n";
1491 }
1492 }
1493 &HTM("../headad2.txt",1);
1494
1495 ### スレッドを吐き出す
1496 #スレッド吐き出し用にファイル数を調整
1497 if($FILENUM > $SETTING{'BBS_THREAD_NUMBER'}){
1498 $FILENUM=$SETTING{'BBS_THREAD_NUMBER'};
1499 }
1500 my ($front, $next, $ancnum, $dap, $first, $line);
1501 for(my $contnum = 0;$contnum < $FILENUM;$contnum++){
1502 $front=$contnum;
1503 $next=$contnum+2;
1504 if($front==0){$front=$FILENUM;}
1505 if($next>$FILENUM){$next=1;}
1506 $ancnum=$contnum+1;
1507 $dap = $PAGEFILE[$contnum];
1508 $dap =~ s/([^\.]*)\.dat/$1/;
1509 if (!-e "$TEMPPATH$dap.html") {
1510 MakeWorkFile($dap);
1511 }
1512 print HTM "\n";
1513 open(IN, "$TEMPPATH$dap.html");
1514 $first=<IN>;
1515 $first =~ s/\$ANCOR/$ancnum/g;
1516 $first =~ s/\$FRONT/$front/g;
1517 $first =~ s/\$NEXT/$next/g;
1518 print HTM $first;
1519 print HTM while <IN>;
1520 close(IN);
1521 print HTM <<EOF;
1522 <input type=hidden name=time value=$NOWTIME>
1523 <b>
1524 <a href="../test/read.cgi/$FORM{'bbs'}/$dap/">レスを全部読む</a>
1525 <a href="../test/read.cgi/$FORM{'bbs'}/$dap/l50">最新レス50</a>
1526 <a href="../test/read.cgi/$FORM{'bbs'}/$dap/-100">レス1-100</a>
1527 <a href="#menu">掲示板のトップへ</a> <a href="../$FORM{'bbs'}/./index.html">リロード</a>
1528 </b></form></DL></td></tr></table></TD></TR></DL></TABLE><br>
1529 EOF
1530
1531 }
1532
1533 if ($nextpage){
1534 print HTM<<EOF;
1535 <table border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_MENU_COLOR'}"align=center>
1536 <tr><td align=center>
1537 <a href="../test/pageview.cgi?page=2&bbs=$FORM{'bbs'}"><font size=5><b>次のページ</b></font></a>
1538 </td></tr>
1539 </table>
1540 EOF
1541 }
1542
1543 print HTM "<table border=0 align=center><tr><td><center>";
1544
1545 print HTM "<br><br>";
1546 &HTM("../bottom_ad.txt",1);
1547 print HTM "\n";
1548 print HTM "</center></tr></td></table></body></html>";
1549 eval{flock(HTM,8);};
1550 close(HTM);
1551 &location;
1552
1553 }
1554
1555 sub HTM {
1556 my ($file,$h) = @_;
1557 if(-e $file){
1558 if($h){select(HTM);}
1559 open(IN, "$file");
1560 print while <IN>;
1561 close(IN);
1562 if($h){select(STDOUT);}
1563 }
1564
1565 }
1566
1567 sub location {
1568 if ($FLAG{'imode'}){
1569 $PATH .= "i/index.html";
1570 # $PATH =~ s/^\.\.\///g;
1571 print "Content-Type: text/html; charset=shift_jis\n\n";
1572 print <<EOF;
1573 <html><head></head><body>
1574 書き込みが完了しました。<br>
1575 <br>
1576 <a href="$PATH">掲示板に戻る</a><br>
1577 <a href="../test/read.cgi/$FORM{'bbs'}/$FORM{'key'}/i">元のスレッドに戻る</a><br>
1578 </body><html>
1579 EOF
1580 }else{
1581 $PATH .= "index.html";
1582 if ($SETTING{'BBS_LOCATION_CHECK'} eq 'checked') {
1583 print "Location: $PATH \n\n";
1584 } else {
1585 print "Content-Type: text/html; charset=shift_jis\n\n";
1586 print <<EOF;
1587 <html><head>
1588 <title>書きこみました。</title>
1589 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1590 <META content=$SETTING{'BBS_WAIT_MINUTE'};URL=$PATH http-equiv=refresh></head>
1591 <body bgcolor=#EEEEEE>
1592 書きこみが終わりました。<br><br>画面が切り替わるまでしばらくお待ち下さい。
1593 </body></html>
1594 EOF
1595 }
1596 }
1597 exit;
1598 }
1599
1600 #エラー画面(エラー処理)
1601 #DispError(TITLE,TOPIC);
1602 sub DispError {
1603 my ($title,$topic)=@_;
1604 print "Content-Type: text/html; charset=shift_jis\n\n";
1605 #-----------------------------------------------------------------------
1606 print <<EOF;
1607 <html>
1608 <head>
1609 <title>$title</title>
1610 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
1611 </head>
1612 <body bgcolor="#FFFFFF">
1613 <font size=+1 color=#FF0000><b>$topic</b></font><ul>
1614 <b>$FORM{'subject'} </b><br>
1615 名前: $FORM{'FROM'}<br>
1616 E-mail: $FORM{'mail'}<br>
1617 内容:<br>$FORM{'MESSAGE'}<br><br>
1618 </ul><center>こちらでリロードしてください。<a href="../$FORM{'bbs'}/index.html"> GO! </a><br>
1619
1620 EOF
1621 my $headad = "../headad.txt";if(-e $headad){open(IN, "$headad");print while <IN>;close(IN);}
1622 print <<EOF;
1623 </body>
1624 </html>
1625 EOF
1626 #-----------------------------------------------------------------------
1627 exit;
1628 }
1629
1630 #作業用ファイル作成
1631 #MakeWorkFile(KEY-NUMBER);
1632 sub MakeWorkFile {
1633 my $key = $_[0];
1634 my $workfile = $TEMPPATH . $key . ".html";
1635 my $datafile = $DATPATH . $key . ".dat";
1636 my (@messx,@content);
1637 my ($mailto,$time,$brmax,$topnum,$firstlog,$lognum,$name,$mail,$subject,$message);
1638 if(!-e $datafile){
1639 open(SHTM,">$workfile");
1640 print SHTM "return";
1641 close(SHTM);
1642 return;
1643 }
1644 open(SHTM,">$workfile");# ログテンポラリを開く
1645 eval{flock(SHTM,2);};
1646
1647 # ログのカキコ数を取得
1648 $lognum = @keytemp;
1649 # 1つ目の要素を読み込む
1650 $firstlog = $keytemp[0];
1651 # 改行カット
1652 chomp($firstlog);
1653
1654 # 1つ目の要素を加工する
1655 ($name,$mail,$time,$message,$subject) = split /<>/,$firstlog;
1656 my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1657 $message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo;
1658
1659 # サブジェクトテーブルを吐き出す(ここは必ず1行にまとめること(処理効率))
1660 #-----------------------------------------------------------------------
1661 print SHTM <<EOF;
1662 <TABLE border=1 cellspacing=8 cellpadding=2 width=95% bgcolor="$SETTING{'BBS_THREAD_COLOR'}" align=center><TR><TD><table border=0 width=100%><TR><td nowrap><a name="\$ANCOR"></a><B>[\$ANCOR:$lognum]</B></td><td><B><FONT size=+1 color="$SETTING{'BBS_SUBJECT_COLOR'}">$subject</FONT></B></td><TD nowrap ALIGN="right"><a href ="#menu">■</a><a href="#\$FRONT">▲</a><a href="#\$NEXT">▼</a></td></tr><tr><td colspan=3><DL>
1663 EOF
1664 #-----------------------------------------------------------------------
1665 # 1つ目の要素のメールへのリンクを作成
1666
1667 # 末尾にsjisの1バイト目があったら削る
1668 my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1669 my $check2 = '[\201-\237\340-\374]';
1670 $mail =~ s/($check1)$check2$/$1/g;
1671 $name =~ s/($check1)$check2$/$1/g;
1672
1673 if($mail ne ''){
1674 $mailto = "<a href=\"mailto:$mail\"><b>$name</b></a>";
1675 }else{
1676 $mailto = "<font color=$SETTING{'BBS_NAME_COLOR'}><b>$name</b></font>";
1677 }
1678
1679 # 1つ目の要素を吐き出す
1680 print SHTM "<dt>1 名前:$mailto 投稿日:$time<dd>$message<br><br><br>\n";
1681
1682 # ログ数から、表示コンテンツをチェック
1683 if(@keytemp>$SETTING{'BBS_CONTENTS_NUMBER'}){
1684 # ケツの要素を0〜9番までコンテンツに格納
1685 @content[0..$SETTING{'BBS_CONTENTS_NUMBER'}-1] = @keytemp[@keytemp-$SETTING{'BBS_CONTENTS_NUMBER'}..@keytemp-1];
1686 $topnum=@keytemp-($SETTING{'BBS_CONTENTS_NUMBER'}-1);
1687 }else{
1688 # アタマの要素を1〜10番までコンテンツに格納
1689 @content[0..($SETTING{'BBS_CONTENTS_NUMBER'}-1)] = @keytemp[1..$SETTING{'BBS_CONTENTS_NUMBER'}];
1690 $topnum=2;
1691 }
1692
1693 foreach(@content){
1694 unless($_){
1695 $topnum++;
1696 next;
1697 }
1698 chop;
1699 ($name,$mail,$time,$message,$subject) = split /<>/;
1700 my $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1701 $message =~ s/($check)(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1<a href=\"$2\:$3\" target=\"_blank\">$2\:$3<\/a>/igo;
1702
1703 # 要素のメールへのリンクを作成
1704
1705 # 末尾にsjisの1バイト目があったら削る
1706 my $check1 = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})*';
1707 my $check2 = '[\201-\237\340-\374]';
1708 $mail =~ s/($check1)$check2$/$1/g;
1709 $name =~ s/($check1)$check2$/$1/g;
1710
1711 if($mail ne ''){
1712 $mailto = "<a href=\"mailto:$mail\"><b>$name</b></a>";
1713 }else{
1714 $mailto = "<font color=$SETTING{'BBS_NAME_COLOR'}><b>$name</b></font>";
1715 }
1716
1717 print SHTM "<dt>$topnum 名前:$mailto 投稿日:$time<dd>";
1718 $topnum++;
1719 @messx = split /<br>/,$message;# メッセージを行でカット
1720 if(@messx<$SETTING{'BBS_LINE_NUMBER'}){
1721 print SHTM "$message <br>";
1722 }else{
1723 for(@messx[0..$SETTING{'BBS_LINE_NUMBER'}]){
1724 print SHTM "$_<br>";
1725 }
1726 $topnum--;
1727 if ($mail =~ /pre/) {
1728 print SHTM "</pre>";
1729 } elsif ($mail =~ /teletype/) {
1730 print SHTM "</tt>";
1731 }
1732 print SHTM "<font color=\"$SETTING{'BBS_NAME_COLOR'}\">(省略されました・・全てを読むには<a href=\"../test/read.cgi/$FORM{'bbs'}/$key/$topnum\" target=\"_blank\">ここ</a>を押してください)</font><br>";
1733 $topnum++;
1734 }
1735 print SHTM "<br>\n";
1736 }
1737 #-----------------------------------------------------------------------
1738 print SHTM <<EOF;
1739 <dt><dd><form method=POST action="../test/bbs.cgi">
1740 <input type=submit value="書き込む" name="submit">
1741 名前:
1742 <SCRIPT Language="JavaScript">
1743 <!--
1744 document.write("<INPUT TYPE=text NAME=FROM SIZE=19 VALUE=");
1745 document.write(Name, ">");
1746 // -->
1747 </SCRIPT>
1748 <NOSCRIPT>
1749 <INPUT TYPE=text NAME=FROM SIZE=19>
1750 </NOSCRIPT>
1751 E-mail<font size="1">(省略可)</font>:
1752 <SCRIPT Language="JavaScript">
1753 <!--
1754 document.write("<INPUT TYPE=text NAME=mail SIZE=19 VALUE=");
1755 document.write(Mail, ">");
1756 // -->
1757 </SCRIPT>
1758 <NOSCRIPT>
1759 <INPUT TYPE=text NAME=mail SIZE=19>
1760 </NOSCRIPT>
1761 <ul>
1762 <textarea rows=5 cols=60 wrap=OFF name=MESSAGE></textarea>
1763 </ul>
1764 <input type=hidden name=bbs value=$FORM{'bbs'}>
1765 <input type=hidden name=key value=$key>
1766 EOF
1767 #-----------------------------------------------------------------------
1768 eval{flock(SHTM,8);};
1769 close(SHTM);
1770 # パーミッション調整
1771 chmod(0666,$workfile);
1772 }
1773
1774 sub hirakata{
1775 # ひらがなとカタカナの相互変換
1776 my ($check, $value, $i, $k, $ii, $kk);
1777 $check = '(?:^|[\0-\200\240-\337])(?:[\201-\237\340-\374]{2})';
1778 $value = "$FORM{'FROM'}<>$FORM{'mail'}<>$FORM{'MESSAGE'}<>$FORM{'subject'}";
1779 &jcode::h2z_sjis(\$value);
1780 $value =~ s/($check)/$1\0/g;
1781 for ( $i = 64; $i <= 147; $i++ ) {
1782 next if $i == 127;
1783 $k = $i + 94;
1784 $k++ if $i <= 126;
1785 $ii = sprintf("%o", $i); $ii = "\\$ii";
1786 $kk = pack("C", $k);
1787 $value =~ s/\203$ii/\202\0$kk\0/g;
1788 }
1789 for ( $i = 159; $i <= 241; $i++ ) {
1790 $k = $i - 94;
1791 $k-- if $i <= 221;
1792 $ii = sprintf("%o", $i); $ii = "\\$ii";
1793 $kk = pack("C", $k);
1794 $value =~ s/\202$ii/\203\0$kk\0/g;
1795 }
1796 $value =~ s/\0//g;
1797 ($FORM{'FROM'}, $FORM{'mail'}, $FORM{'MESSAGE'}, $FORM{'subject'}) = split /<>/, $value;
1798 }

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24