#!/usr/bin/perl
use strict;
#---
#[BBS.CGI] by eucalyptus. 2002.
#---
use vars qw($version $read_cgi $bbs_cgi $expires $imode_flag $proxy_flag $setting_path $setting2_path $i_read_cgi $reload $temp_path $remake_flag $id_flag $sc_name);
$version = "1.0.0";
$sc_name = "Your BBS Name";
$read_cgi = "/test/read.cgi";
$i_read_cgi = "/test/ir.cgi";
$bbs_cgi = "/test/bbs.cgi";
$setting_path = "./setting";
$setting2_path = "./setting2";
$temp_path = "./temp";
$| = 1;
#タイムゾーン設定/シグナル設定
{ $ENV{'TZ'} = "JST-9"; }
sub SigExit { exit(0); }
{ $SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = "SigExit"; }
#FORMからブツを取り出す POST対応
use vars qw(%FORM %SETTING %THREAD);
{
my $buffer;
my (@pairs, $name, $value);
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split /&/,$buffer;
$buffer = '';
foreach (@pairs) {
($name, $value) = split /=/;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg;
$value =~ s/</g;
$value =~ s/>/>/g;
$value =~ s/\"/"/g;
$value =~ s/\r\n|\r|\n/
/g;
$value =~ s/
/
/g;
$FORM{$name} = $value;}}
}
#板名がおかしいかテスト
if ("$FORM{'bbs'}" eq ""){disperror("板の名前が指定されていません。");}
if ($FORM{'bbs'} =~ /\W/){disperror("板の名前に使用出来ない文字が含まれています。");}
if ((length($FORM{'bbs'})) > 10){disperror("板の名前が長すぎます。");}
#本文が空かテスト
if (!$FORM{'MESSAGE'}){disperror("本文がありません。");}
#timeとFLAGと板名に変数を保存
{
use vars qw($NOWTIME $current_bbs $HOST $disp_bbs);
$NOWTIME = time;
$current_bbs = $FORM{'bbs'};
$disp_bbs = $FORM{'bbs'};
$FORM{'FROM2'} = $FORM{'FROM'};
$FORM{'mail2'} = $FORM{'mail'};
}
#リメーク処理
{
if ($FORM{'mail'} eq "__TSU-KU-RI-KA-E"){
$remake_flag = 1;
$FORM{'mail'} = "sage";
subject_output ("$current_bbs");
print "Content-Type: text/html;\n\n
$current_bbs リメイク完了.";exit;}
}
#日付設定/ID生成
use vars qw($ID $DATE $DISP_DATE);
{
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($NOWTIME);
$wday = ("日", "月", "火", "水", "木", "金", "土")[$wday];
$DATE = sprintf("%04d/%02d/%02d(%s) %02d:%02d",$year + 1900, $mon + 1, $mday, $wday, $hour, $min);
$DISP_DATE = $DATE;
$sec = $mon * 12 + $mday;
($mday, $wday, $hour, $min) = split(/\./,$ENV{'REMOTE_ADDR'});
my $idnum = $mday + ($wday * 300) + ($hour * 500) + ($min * 1200);
my $idcrypt = substr(crypt($idnum,$sec), -8);
$ID = " ID:".$idcrypt;
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
my $exp = 24 * 60 * 60; $exp *= 30;
($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($NOWTIME + $exp);
$wday = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday];
$mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
$year = $year+1900;$mday = "0$mday" if ($mday < 10);
$expires = "$wday, $mday-$mon-$year 00:00:00 GMT";
}
#串チェック
##これは抜いたぞ
#携帯検出(i-mode / j-sky)
{
$imode_flag = 0;
if ($ENV{'HTTP_USER_AGENT'} =~ /DoCoMo/){$imode_flag=1;}
#ezweb
# if ($ENV{'HTTP_USER_AGENT'} =~ /UP.Browser/){disperror("hdml");}
if ($ENV{'HTTP_USER_AGENT'} =~ /UP.Browser/){$imode_flag=1;}
if ($ENV{'REMOTE_HOST'} =~ /skyweb/){$imode_flag=1;}
if ("$ENV{'HTTP_X_JPHONE_MSNAME'}" ne ""){$imode_flag=1;}
}
#BBS設定情報読み込み
{
my ($m_pass,$m_key,$m_value);
$m_pass = $setting_path . "/" . $current_bbs . ".txt";
undef %SETTING;
if(-e $m_pass){
open(FILE,$m_pass);
foreach (){
$_ =~ s/\n//g;
($m_key,$m_value) = split /=/;
$SETTING{$m_key} = $m_value;}
close(FILE);
}else{disperror("このサーバには、指定された板がありません。");}
$reload = $SETTING{'INDEX_URL'};
}
#スレッド情報/datがあるかチェック/変数に代入
{
if ($FORM{'subject'} eq ""){
undef %THREAD;
my ($m_pass,$m_key);
$m_pass = $SETTING{'DAT_SETTING_PATH'} ."/" . $FORM{'key'} . ".txt";
if(-e $m_pass){
open(FILE,$m_pass);
$m_key = ;
close (FILE);
($THREAD{'subject'},$THREAD{'FLAG'},$THREAD{'BBS'},$THREAD{'COUNT'}) = split(/\t/,$m_key);
}else{disperror("スレッド情報が見つかりません。");}
if ($THREAD{'FLAG'} =~ /stop/){disperror("指定されたスレッドには、書き込むことが出来ません。");}
$m_pass = $SETTING{'DAT_DATA_PATH'} ."/" . $FORM{'key'} . ".dat";
if(-e $m_pass){}else{disperror("スレッドファイルが見つかりません。");}
$current_bbs = $THREAD{'BBS'};
}
}
#スレたてなのか、カキコミなのか/キー名処理
{
if($FORM{'subject'} ne ""){
if ($SETTING{'BBS_MAKE_THREAD'} eq "1"){disperror("この板には、スレッドを立てることができません。");}
$FORM{'key'} = $NOWTIME;
}else{
if($FORM{'key'} =~ /\D/){disperror("スレッドの名前に使用出来ない文字が含まれています。");}
if($FORM{'key'} eq ""){disperror("スレッド名がありません。");}
}
}
#名前の設定
{
if($SETTING{'NANASHI_CHECK'} eq 1 && $FORM{'FROM'} eq ''){
disperror("名前を入れて下さい。");}
}
#datファイルサイズチェック
{
my $keyfile = $SETTING{'DAT_DATA_PATH'} . "/" . $FORM{'key'} . ".dat";
if(-s "$keyfile" > 512000) {disperror("スレッドサイズオーバーです。
指定されたスレッドには書き込めません。");}
}
#文字数制限
{
if(length($FORM{'subject'}) > $SETTING{'BBS_SUBJECT_COUNT'}){
disperror("スレッド名が長すぎます。");}
if(length($FORM{'FROM'}) > $SETTING{'BBS_NAME_COUNT'}){
disperror("名前が長すぎます。");}
if(length($FORM{'mail'}) > $SETTING{'BBS_MAIL_COUNT'}){
disperror("コマンドが長すぎます。");}
if(length($FORM{'MESSAGE'}) > $SETTING{'BBS_MESSAGE_COUNT'}){
disperror("本文が長すぎます。");}
}
#UNICODE対策/1行データからの改行削り
{
$FORM{'FROM'} =~ s/&/&/g;
$FORM{'FROM'} =~ s/"/"/g;
$FORM{'mail'} =~ s/&/&/g;
$FORM{'mail'} =~ s/"/"/g;
$FORM{'subject'} =~ s/&/&/g;
$FORM{'subject'} =~ s/"/"/g;
if ($SETTING{'BBS_UNICODE'} ne "pass"){
$FORM{'MESSAGE'} =~ s/[x0-9a-fA-F;]+/?/g;
}
$FORM{'FROM'} =~ s/
//g;
$FORM{'mail'} =~ s/
//g;
$FORM{'subject'} =~ s/
//g;
}
#スレッド名重複チェック/新スレ作成
{
my (@thread_title,$th_title,$th_key,$th_id,$datpath,$THREAD_TITLE_LOG,$datpath,$th_id2,$th_id3,$th_id4,$counter);
if($FORM{'subject'} ne "") {
$th_id2 = $ID . "_" . $current_bbs;
$THREAD_TITLE_LOG = $temp_path . "/threaddata.dat";
$th_id3 = $FORM{'key'} - 120;
$th_id4 = $FORM{'key'} - 3600;
$counter=0;
open(THLOG,"$THREAD_TITLE_LOG");
while (){
$_ =~ s/\n//g;
($th_key,$th_title,$datpath,$datpath,$th_id) = split(/\t/,$_);
if ($th_title eq $FORM{'subject'}){
disperror("同じ名前のスレッドがあります。");}
if ($th_key eq $FORM{'key'}){
disperror("同じキーのスレッドがあります。
リトライして下さい。");} if ($th_key > $th_id3){
disperror("error");}
if ($th_id eq $th_id2){
if ($th_key > $th_id4){
$counter++;
if ($counter > 2){disperror("error");}}
if ($SETTING{'THREAD_TATESUGI'} eq "1"){
disperror("error");}}
}
$FORM{'mail'} =~ s/stop//g;
open(THLOG,">>$THREAD_TITLE_LOG");
eval{flock(THLOG,2);};
print THLOG $FORM{'key'} . "\t" . $FORM{'subject'} . "\t" . $FORM{'mail'} . "\t" . $current_bbs . "\t" . $th_id2 . "\n";
close(THLOG);
$THREAD{'subject'} = $FORM{'subject'};
$THREAD{'FLAG'} = $FORM{'mail'};
$THREAD{'BBS'} = $disp_bbs;
$datpath = $SETTING{'DAT_DATA_PATH'} . "/".$FORM{'key'}.".dat";
open(DAT,">$datpath");
close (DAT);
$datpath = $SETTING{'DAT_SETTING_PATH'} . "/".$FORM{'key'}.".txt";
open(DAT,">$datpath");
print DAT "$FORM{'subject'}\t$FORM{'mail'}\t$current_bbs\t0";
close (DAT);
}
}
#スレの板と書き込み元板チェック
{
if($disp_bbs ne $THREAD{'BBS'}) {
if($SETTING{'ROOT_BBS'} ne "") {
disperror("その板からはこのスレッドには書き込めません。($disp_bbs $SETTING{'ROOT_BBS'} $THREAD{'BBS'} / ");}}
}
#------------------------------------------------------------------
#置き換え処理/オリジナル機能はこの下へ挿入しる!
#使える変数一覧: *がついてるのは読み込み専用
# $FORM{'MESSAGE'} 本文
# $FORM{'mail'} コマンド欄
# $FORM{'FROM'} 名前
# $THREAD{'subject'} スレ名
#*$THREAD{'FLAG'} 対象スレ1のコマンド欄 (スレスト時にはstopと入る)
#*$THREAD{'COUNT'} スレの書き込み数(概算) / 最大+5くらいで考えて
#*$THREAD{'BBS'} スレの板名
# $THREAD{'S_FLAG'} 1を入れるとスレスト/2を入れると上のヤシ書き込まずスレスト
# $THREAD{'S_FROM'} スレスト時名前
# $THREAD{'S_MAIL'} スレスト時メール欄
# $THREAD{'S_MSG'} スレスト時コメント
#*$disp_bbs 呼び出し元板
#*$ID ID
#*$DATE 日時
# $id_flag ID制御(文字列:ID欄/hidden:ID非表示/superhidden:強制非表示)
# $DISP_DATE 書き込み時の日時欄
# $THREAD{'N_FLAG'} 現在の書き込みの後に書くときは1
# $THREAD{'N_FROM'} 後付け時名前
# $THREAD{'N_MAIL'} 後付け時メール欄
# $THREAD{'N_DATE'} 後付け時日時欄
# $THREAD{'N_MSG'} 後付け時コメント
#------------------------------------------------------------------
#キャップとかの記号置き換え
$FORM{'FROM'} =~ s/★/☆/g;
$FORM{'FROM'} =~ s/◆/◇/g;
$FORM{'mail'} =~ s/★/☆/g;
$FORM{'mail'} =~ s/◆/◇/g;
#トリップ
{
if($FORM{'FROM'} =~ /([^\#]*)\#(.+)/){
my $main_message = $1;
my $key = $2;
my $salt = substr($key."H.", 1, 2);
$salt =~ s/[^\.-z]/\./go;
$salt =~ tr/:;<=>?@[\\]^_`/ABCDEFGabcdef/;
$key = substr(crypt($key, $salt),-8);
if($main_message ne ""){
$FORM{'FROM'} = "$main_message ◆$key ";
}else{$FORM{'FROM'} = " ◆$key ";}
}}
#キャップ
{
if($FORM{'mail'} =~ /([^\#]*)\#(.+)/){
my $main_message = $1;
my $key = $2;
my $capfile = $setting2_path . "/capfile.txt";
my ($name,$cap);
open (FILE,"$capfile");
eval{flock(FILE,2);};
while (){
chop;
($name,$cap) = split(/###/,$_);
if ($cap eq $key){
if($FORM{'FROM'} ne ""){$FORM{'FROM'} = $FORM{'FROM'} . " @";}
$FORM{'FROM'} = $FORM{'FROM'} . $name;
last;
}
}
close (FILE);
if($main_message ne ""){
$FORM{'mail'} = "$main_message";
}else{$FORM{'mail'} = "";}
}}
##1のコマンド欄で何かが起こる系
#ID強制/隠し/任意
{
if($THREAD{'FLAG'} =~ /ID=/){
if($THREAD{'FLAG'} =~ /ID=d/){
$id_flag = "ID:" . $ID;}
elsif($THREAD{'FLAG'} =~ /ID=h/){
$id_flag = "hidden";}
elsif($THREAD{'FLAG'} =~ /ID=o/){
$id_flag = "ID:???";
if ($FORM{'mail'} eq ""){
$id_flag = "ID:" . $ID;}}}
}
#強制名無し/名無し置き換え
{
if($THREAD{'FLAG'} =~ /NANASHI/){
$FORM{'FROM'} = "";
}
if($FORM{'FROM'} eq ""){
$FORM{'FROM'} = $SETTING{'NANASHI_NAME'};
}
}
#ふしあなさん
{
if($SETTING{'FUSIANA_TRAP'} eq ""){
$FORM{'FROM'} =~ s/fusianasan//g;}
if($FORM{'FROM'} =~ /fusianasan/){
my ($HOST,$HOST2);
$HOST = $ENV{'REMOTE_ADDR'};
if ($HOST =~ /\d$/) {
$HOST = gethostbyaddr(pack('c4',split(/\./, $HOST)), 2) || $HOST;}
if ($ENV{'HTTP_VIA'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/) {
$HOST2 = $ENV{'HTTP_VIA'};}
if ($ENV{'HTTP_X_FORWARDED_FOR'} =~ s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/) {
$HOST2 = $ENV{'HTTP_X_FORWARDED_FOR'};}
if ($ENV{'HTTP_FORWARDED'} =~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/){
$HOST2 = $ENV{'HTTP_FORWARDED'};}
$HOST2 = gethostbyaddr(pack('c4', split(/\./, $HOST2)), 2);
$HOST .= "<$HOST2>" if ($HOST2);
$FORM{'FROM'} =~ s/fusianasan/<\/b>$HOST/g;
}
}
#強制age/sage/supersage
{
if($THREAD{'FLAG'} =~ /AGE/){
$FORM{'mail'} =~ s/supersage//g;
$FORM{'mail'} =~ s/sage//g;}
if($THREAD{'FLAG'} =~ /SUPERSAGE/){
$FORM{'mail'} = $FORM{'mail'} . "super";}
if($THREAD{'FLAG'} =~ /SAGE/){
$FORM{'mail'} = $FORM{'mail'} . "sage";}
}
#名前の前にいろいろつける機能
{
if($THREAD{'FLAG'} =~ /NAME/){
my($logt,@logs,$tango,$ouen,$comnt);
open(LOG,"$setting2_path/name.txt");
@logs=;
close(LOG);
$logt=@logs;# ログ数の代入
$tango = int(rand($logt));
$ouen = $logs[$tango];
chop($ouen);
$FORM{'FROM'}=$ouen.$FORM{'FROM'};
}
}
#AA置き換え機能
{
my ($aaflag,$aafile);
if($SETTING{'AA_ENABLE'} eq "checked" && $THREAD{'FLAG'} !~ /AA=off/){$aaflag = 1;}
if($SETTING{'AA_ENABLE'} eq "option" && $THREAD{'FLAG'} =~ /AA=on/){$aaflag = 1;}
if($aaflag eq "1"){
my ($aafile);
if($FORM{'mail'} =~ /gikoippai/){
if ($FORM{'MESSAGE'} =~ /.*
.*
.*
/){
disperror("ギコいっぱいは、4行以上の書き込みには適\用出来ません。");}
if ($FORM{'MESSAGE'} =~ /^
/){
disperror("ギコいっぱいは、空白行には適\用出来ません。");}
if ($FORM{'MESSAGE'} =~ /
( | )+
/){
disperror("ギコいっぱいは、空白行には適\用出来ません。");}
$FORM{'MESSAGE'} =~ s/
/
\tUU ̄ ̄\tU U\t\t\_____________
∧ ∧ / ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄
〜′ ̄ ̄( ゚Д゚)< /g;
$FORM{'MESSAGE'} = " ∧ ∧ / ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄ ̄
〜′ ̄ ̄( ゚Д゚)< $FORM{'MESSAGE'}
\tUU ̄ ̄\tU U\t\t\_____________";
$FORM{'MESSAGE'} =~ s/\t/ /g;}
elsif($FORM{'mail'} =~ /chigyo/){
my ($aalen,$aaline,@aalines);
if ($FORM{'MESSAGE'} =~ /.*
/){
disperror("稚魚AA\機\能\は、2行以上の書き込みには適\用出来ません。");}
if ($FORM{'MESSAGE'} eq " "){
disperror("1行目が空白です。稚魚AA\機\能\を適\用出来ません。");}
$FORM{'MESSAGE'} =~ s/
.*$//g;
$FORM{'MESSAGE'} =~ s/
//g;
if(length($FORM{'MESSAGE'}) > 50){
disperror("1行の長さが50(全角25)文字以上あります。稚魚AA\機\能\を適\用出来ません。");}
@aalines = (" /∪\"," ∧ ∧"," /■\");
$aalen = int(rand(3));
$aaline = $aalines[$aalen] . "
";
@aalines = ("∋ ・Д・)","∋ ゚パ )","∋ ・ゐ・)","∋ ・∀・)","∋ ´Д`)","∋ ´∀`)","∋ *・∀・)","∋ ゚Д゚)");
$aalen = int(rand(8));
$aaline = $aaline . $aalines[$aalen] . " ". $FORM{'MESSAGE'} . "
";
$aalen = int(rand(5));
if ($aalen > 1){
@aalines = (" ∂ 魚)e"," ∂ 老)e"," ∂ ゑ)e"," ∂ 影)e");
$aalen = int(rand(4));
$aaline = $aaline . $aalines[$aalen] . "
";
}
$aalen = int(rand(4));
if ($aalen > 2){$aaline = $aaline . " ┃┃
";}
$FORM{'MESSAGE'} = $aaline . " ┛┗ ";
$FORM{'MESSAGE'} =~ s/\t/ /g;}
else{
if($FORM{'mail'} =~ /fuwafuwa/){$aafile = "fuwafuwa";}
if($FORM{'mail'} =~ /seito/){$aafile = "seito";}
if($FORM{'mail'} =~ /sakuratan/){$aafile = "sakuratan";}
if("$aafile" ne ""){
if ($FORM{'MESSAGE'} =~ /.*
/){
disperror("AA置き換え機能は、2行以上の書き込みには適\用出来ません。");}
if ($FORM{'MESSAGE'} eq " "){
disperror("1行目が空白です。AA置き換え\機\能\を適\用出来ません。");}
$FORM{'MESSAGE'} =~ s/
.*$//g;
$FORM{'MESSAGE'} =~ s/
//g;
if(length($FORM{'MESSAGE'}) > 50){
disperror("1行の長さが50(全角25)文字以上あります。AA置き換え\機\能\を適\用出来ません。");}
my ($aalen,$aalen2,$aaline,@aalines);
$aafile = $setting2_path . "/" . $aafile . ".txt";
open (FILE,"$aafile");
eval{flock(FILE,2);};
@aalines = ;
close (FILE);
$aalen2 = $#aalines;$aalen2++;
$aalen = int(rand($aalen2));
$aaline = $aalines[$aalen];
$aaline =~ s/\[message\]/$FORM{MESSAGE}/g;
$FORM{'MESSAGE'} = "$aaline";
$FORM{'MESSAGE'} =~ s/\r//g;
$FORM{'MESSAGE'} =~ s/\n//g;
}
}
}
}
#レスポンスアンカー
{
$FORM{'MESSAGE'} =~ s/>>([0-9]+)(?![-\d])/>>$1<\/a>/g;
$FORM{'MESSAGE'} =~ s/>>([0-9]+)\-([0-9]+)/>>$1-$2<\/a>/g;
}
#------------------------------------------------------------------
#ここまで
#------------------------------------------------------------------
#ID
{
if($SETTING{'DISP_ID'} eq "optional"){
if ($id_flag eq ""){
$id_flag = "ID:???";
if ($FORM{'mail'} eq ""){$id_flag = $ID;}}}
if($id_flag eq "hidden"){$id_flag = "";}
if ($SETTING{'DISP_ID'} eq "checked"){
$id_flag = $ID;}
if($id_flag ne ""){$DISP_DATE = $DATE . " " .$id_flag;}
if ($id_flag eq "superhidden"){$DISP_DATE = $DATE;}
}
#クッキードゾー
{
if($imode_flag ne "1"){
if($SETTING{'BBS_NAMECOOKIE_CHECK'} eq "checked"){
print "Set-Cookie: NAME=$FORM{'FROM2'}; expires=$expires; path=/\n";}
if($SETTING{'BBS_MAILCOOKIE_CHECK'} eq "checked"){
print "Set-Cookie: MAIL=$FORM{'mail2'}; " if ($FORM{'mail'} !~ /NANASI/ && $FORM{'mail'} !~ /LIMIT/);
print "expires=$expires; path=/\n";
}
}
}
#threaddata.datを使ってファイルロック
open(THLOG,">>./temp/threaddata.dat");
eval{flock(THLOG,2);};
#再びスレッドデータ読み込み
{
my ($m_pass,$m_key);
$m_pass = $SETTING{'DAT_SETTING_PATH'} . "/" . $FORM{'key'} . ".txt";
if(-e $m_pass){
open(MPASS,$m_pass);
$m_key = ;
close (MPASS);
($THREAD{'subject'},$THREAD{'FLAG'},$THREAD{'BBS'},$THREAD{'COUNT'}) = split(/\t/,$m_key);
}else{disperror("スレッド情報が見つかりません。");}
if ($THREAD{'FLAG'} =~ /stop/){disperror("指定されたスレッドには、書き込むことが出来ません。");}
}
#dat吐き出し
{
my $datafile = $SETTING{'DAT_DATA_PATH'} . "/" . $FORM{'key'} . ".dat";
open(OUT, ">> $datafile");
eval{flock(OUT,2);};
if ($THREAD{'S_FLAG'} ne "2"){
$THREAD{'COUNT'}++;
print OUT "$FORM{'FROM'}<>$FORM{'mail'}<>$DISP_DATE<> $FORM{'MESSAGE'} <>$FORM{'subject'}\n";}
if ($THREAD{'N_FLAG'} eq "1"){
$THREAD{'COUNT'}++;
print OUT "$THREAD{'N_FROM'}<>$THREAD{'N_MAIL'}<>$THREAD{'N_DATE'}<> $THREAD{'N_MSG'} <>\n";}
if ($THREAD{'S_FLAG'} eq "1"){
$THREAD{'COUNT'}++;
print OUT "$THREAD{'S_FROM'}<>$THREAD{'S_MAIL'}<>$THREAD{'S_DATE'}<> $THREAD{'S_MSG'} <>\n";}
if ($THREAD{'S_FLAG'} eq "2"){
$THREAD{'COUNT'}++;
print OUT "$THREAD{'S_FROM'}<>$THREAD{'S_MAIL'}<>$THREAD{'S_DATE'}<> $THREAD{'S_MSG'} <>\n";}
# Over 1000 Thread
if ($THREAD{'COUNT'} > 999) {
print OUT "LIMIT<><>LIMIT<> 1000突破!
続きは新しいスレッドで・・・。 <>\n";
$THREAD{'COUNT'}++;
$THREAD{'S_FLAG'} = "1";}
close(OUT);
}
#スレッドデータ書き出し
{
my ($m_pass,$m_key);
$m_pass = $SETTING{'DAT_SETTING_PATH'} . "/" . $FORM{'key'} . ".txt";
if ($THREAD{'S_FLAG'} eq "1"){$THREAD{'FLAG'}= $THREAD{'FLAG'} . " stop";}
open(MPASS,">$m_pass");
eval{flock(MPASS,2);};
print MPASS $THREAD{'subject'} . "\t" . $THREAD{'FLAG'} . "\t" . $THREAD{'BBS'} . "\t" . $THREAD{'COUNT'};
close (MPASS);
}
#サブジェクトとか作成
{
my $sub_flag = $SETTING{'ROOT_BBS'};
subject_output ("$current_bbs");
if ($sub_flag ne ""){
subject_output ("$sub_flag");
}
if ($disp_bbs ne $current_bbs){
subject_output ("$disp_bbs");
}
}
#統計データの書き込み
{
my $RES_LOG = $temp_path . "/resdata.dat";
open(RESLOG,">>$RES_LOG");
eval{flock(RESLOG,2);};
print RESLOG $NOWTIME . "\t" . $current_bbs . "\t" . $ID . "\n";
close(RESLOG);
}
#threaddata.datを使ってファイルアンロック
close(THLOG);
#インフォ表示
{
if ($ENV{'HTTP_USER_AGENT'} =~ /kage/){
print "Status: 302 Moved Temporarily\n";
print "Location: /$disp_bbs/index.html \n\n";}
elsif ($ENV{'HTTP_USER_AGENT'} =~ /Katjusha/){
print "Status: 302 Moved Temporarily\n";
print "Location: /$disp_bbs/index.html \n\n";}
elsif ($ENV{'HTTP_USER_AGENT'} =~ /Indy Lib/){
print "Content-Type: text/html;\n\n書きこみました。書きこみが終わりました。
画面を切り替えるまでしばらくお待ち下さい。
\n\n";exit;}
elsif ($ENV{'HTTP_USER_AGENT'} =~ /onazilla/){
print "Content-Type: text/html; charset=shift_jis\n\n書き込み終了 - $sc_name ■書き込みました。
Monazillaツールを検出しました。
書き込み確認:indexへ / 書き込んだスレッドへ。
[BBS.CGI] for $sc_name
Version : ".$version."
";exit;
}
elsif ($ENV{'HTTP_USER_AGENT'} =~ /Hotzonu/){
print "Content-Type: text/html; charset=shift_jis\n\n書き込み終了 - $sc_name■書き込みました。
Hotzonuを検出しました。
書き込み確認:indexへ / 書き込んだスレッドへ。
";
if ($SETTING{'INDEX_AD_3'} ne ""){
open (IN,$SETTING{'INDEX_AD_3'});
while () { print; }
close (IN);}
print "
[BBS.CGI] for $sc_name
Version : ".$version."
";exit;
}
elsif ($imode_flag eq "1"){
print "Content-Type: text/html;\n\n書込終了■書込み終了
スレ一覧へ";exit;}
else{
my $jump = "http://$ENV{'SERVER_NAME'}/$disp_bbs/index.html";
if ($ENV{'HTTP_REFERER'} =~ /read.cgi/){
if ($FORM{'resno'} eq ""){$FORM{'resno'} = "l5";}
$jump = "http://$ENV{'SERVER_NAME'}$read_cgi/$disp_bbs/$FORM{'key'}/$FORM{'resno'}";}
print "Content-Type: text/html; charset=shift_jis\n\n書き込み終了 - $sc_name■書き込みました。
そのまましばらくお待ち下さい。
";
if ($SETTING{'INDEX_AD_3'} ne ""){
open (IN,$SETTING{'INDEX_AD_3'});
while () { print; }
close (IN);}
print "
[BBS.CGI] for $sc_name
Version : ".$version."
";exit;
}
}
exit;
#サブジェクト作成のサブルーチン
sub subject_output {
#subject.txt読み出し/順番並び替え
my ($target_bbs)=@_;
my ($m_pass,$m_key,$m_value,$temp1,$temp2);
$m_pass = $setting_path . "/" . $target_bbs . ".txt";
undef %SETTING;
if(-e $m_pass){
open(FILE,$m_pass);
foreach (){
$_ =~ s/\n//g;
($m_key,$m_value) = split /=/;
$SETTING{$m_key} = $m_value;}
close(FILE);
}else{disperror("このサーバには、指定された板がありません。");}
my (@sub_array,$subject,$file,$value,%INDEX,$filename,$count,$count2,$count3,$name,$mail,$time,$message,$subject,$count4,$flag_,$keyfile,$line,$start,$end,$mailto,$next_th,$count_temp);
my $th_title = $THREAD{'subject'} . " (" . $THREAD{'COUNT'} . ")";
my $target_datname = $FORM{'key'} . ".dat";
my $record = $target_datname . "<>" . $th_title;
my $subject = $SETTING{'SUBJECT_PATH'} . "/subject.txt";
undef @sub_array;
$next_th = 2;
if ($FORM{'subject'} ne ""){
push(@sub_array,$record);
$next_th = 0;}
elsif ($FORM{'mail'} !~ /sage/){
push(@sub_array,$record);
$next_th = 0;}
open(SUBR,"$subject");
eval{flock(SUBR,1);};
$count4 = -1;
while(){
$_ =~ s/\n//g;
($file, $value) = split /<>/;
unless($file){next;}
$filename = $SETTING{'DAT_DATA_PATH'} . "/" . $file;
if(-e $filename){
$count4++;
if ($count4 == $SETTING{'BBS_MAX_LIVE_THREAD'}){last;}
if ($count4 == $SETTING{'BBS_MAX_MENU_THREAD'}){
if ($next_th == 2){push(@sub_array,$record);$next_th = 0;}}
if ($file ne $target_datname){
push(@sub_array,$_);
if ($next_th == 1){
push(@sub_array,$record);
$next_th = 0;
}
}else{
if ($next_th != 0){
if ($FORM{'mail'} =~ /supersage/){
$next_th = 1;
next;}
elsif ($FORM{'mail'} =~ /sage/){
push(@sub_array,$record);
$next_th = 0;}
}
}
}
}
close(SUBR);
if ($next_th == 1){
push(@sub_array,$record);
$next_th = 0;
}
#subject.txt書き出し
if ($remake_flag ne "1"){
open(SUBR,">$subject");
eval{flock(SUBR,2);};
$, = "\n";
print SUBR @sub_array;
$, = "";
print SUBR "\n";
close (SUBR);
}else{
undef @sub_array;
open(SUBR,"$subject");
eval{flock(SUBR,1);};
while(){
$_ =~ s/\n//g;
($file, $value) = split /<>/;
unless($file){next;}
$filename = $SETTING{'DAT_DATA_PATH'} . "/" . $file;
if(-e $filename){
push(@sub_array,$_);
}}
close(SUBR);
}
#suball.html書き出し判定
my $suball = $SETTING{'SUBJECT_PATH'} . "/suball.html";
($temp1) = (stat($suball))[9];
$temp2 = $NOWTIME - 10800;
if ($remake_flag eq "1"){$temp1 = 1;}
if ($temp1 < $temp2){&thread_all($target_bbs);}
#統計情報書き出し判定
my $STAT_LOG = $temp_path . "/stat_" . $target_bbs . ".dat";
($temp1) = (stat($STAT_LOG))[9];
$temp2 = $NOWTIME - 30;
if ($remake_flag eq "1"){$temp1 = 1;}
if ($temp1 < $temp2){&stat_out($target_bbs);}
#i-mode用HTML書き出し
my $index = $SETTING{'SUBJECT_PATH'} . "/i/index.html";
open(SUBR,">$index");
eval{flock(SUBR,2);};
print SUBR "".$target_bbs ."\@$sc_name$sc_name
$SETTING{'BBS_TITLE'}
";
if ($SETTING{'INDEX_AD_IMODE'} ne ""){
open (IN,$SETTING{'INDEX_AD_IMODE'});
while () { print SUBR; }
close (IN);}
$count = 0;
foreach (@sub_array){
$count++;
($file, $value) = split /<>/;
$file =~ s/.dat//g;
print SUBR $count . ":".$value ."
";
if ($count > 30){last;}
}
$count++;
print SUBR "
".$count . ":新スレを立てる
";
print SUBR "