/[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 - (hide 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 wakaba 1.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 wakaba 1.2 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 wakaba 1.1 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