#!/usr/local/bin/perl ### delete.cgi ver 2.04 (2001/07/10) #$baseurl="http://www.onpuch.jp/cgi-bin/onpuch/"; $method="GET"; ##一度に表示する $thread=50; $res=100; #システム情報 use vars qw($NOWTIME); $NOWTIME = time; #================================================== # システム関連(タイムゾーン・シグナル) #================================================== #タイムゾーンをセットする { $ENV{'TZ'} = "JST-9"; } #シグナル対処関数 sub SigExit { exit(0); } #対応シグナル { $SIG{'PIPE'} = $SIG{'INT'} = $SIG{'HUP'} = $SIG{'QUIT'} = $SIG{'TERM'} = "SigExit"; } #================================================== # 初期情報の取得(POST) #================================================== my $m_query = undef; my (@m_elements, $m_element, $m_key, $m_value); use vars qw(%FORM); if($ENV{'REQUEST_METHOD'} eq 'POST'){ read(STDIN,$query,$ENV{'CONTENT_LENGTH'}); } $query.= "&$ENV{'QUERY_STRING'}"; my (@elements, $element, $key, $value); @elements = split /&/, $query; foreach $element (@elements){ $element=~tr/+/ /;#+を空白に変換 ($key,$value)=split /=/, $element; $value =~ s/%([\dA-Fa-f]{2})/pack("C",hex($1))/ge; $FORM{$key} = $value; } if($FORM{'address'}){ $FORM{'address'} =~/bbs=([^&]+)/;$FORM{'bbs'} =$1; $FORM{'address'} =~/key=([^&]+)/;$FORM{'key'} =$1; } #================================================== # エラーレスポンス(BBS情報) #================================================== #BBS名がない場合ばいばい #BBS名に不正な文字があった場合もばいばい { unless($FORM{'bbs'}){ DispError("ERROR!","データがありません!"); } if($FORM{'bbs'} =~ /(\.|\/)/){ DispError("ERROR!","データがありません!"); } } #================================================== # 初期情報の取得(設定ファイル) #================================================== #設定ファイルを読む { my $m_pass = "../" . $FORM{'bbs'} . "/" . "SETTING.TXT"; use vars qw(%SETTING); if(-e $m_pass){ open(FILE,$m_pass); my $m_str=; foreach $m_str (){ chomp($m_str); $m_str =~ /([^=]*)=([^=]*)/; my ($m_name,$m_value)=($1,$2); #my ($m_name, $m_value) = split(/=/, $m_str); $m_value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; $SETTING{$m_name} = $m_value; } close(FILE); }else{ #設定ファイルがない(ERROR) DispError("ERROR!","データがありません!"); } } #================================================== # システム関連(ファイル・ディレクトリパス) #================================================== #各種PATH生成 { use vars qw($WWWPATH); use vars qw($PATH); use vars qw($DATPATH); use vars qw($TEMPPATH); use vars qw($IMODEPATH); $PATH = "../" . $FORM{'bbs'} . "/"; $DATPATH = $PATH . "dat/"; $TEMPPATH = $PATH . "html/"; $IMODEPATH = $PATH . "i/"; } #================================================== # ファイル操作(サブジェクトファイル読み込み) #================================================== #サブジェクトファイル更新 #サブジェクトファイルを読み込む { my $subject = $PATH . "subject.txt"; use vars qw(@PAGEFILE); use vars qw(%SUBJECT); use vars qw($FILENUM); #サブジェクトファイルを読み込む open(SUBR,"<$subject"); #SUBJECTを開く my @SUBJECTLIST = ; #内容を全て読み込む close(SUBR); #閉じる #サブジェクト内容をハッシュに格納 foreach(@SUBJECTLIST){ chomp($_);#改行を取る my ($file, $value) = split(/<>/,$_); my $filename = $DATPATH . $file; if(-e $filename){ #datが存在する場合のみ最後に追加 $file =~ /(\d+)/; $file=$1; push(@PAGEFILE,$file); $SUBJECT{$file} = $value; } } #サブジェクト数を取得 $FILENUM=@PAGEFILE; if($FORM{'subject'}){ $FILENUM++; } } unless($FORM{'key'} && !-e "../$FORM{'bbs'}/dat/$FORM{'key'}.dat"){ if ($FORM{'mode'} eq "res_del"){&res_del;} if ($FORM{'mode'} eq "thread_del"){&thread_del;} if ($FORM{'mode'} eq "thread_move"){&thread_move;} if ($FORM{'mode'} eq "view"){&view;} if ($FORM{'mode'} eq "stop"){&stop;} } #================================================== #  #================================================== print "Content-type: text/html; charset=shift_jis\n\n"; print <<"EOF"; $SETTING{'BBS_TITLE'} $SETTING{'BBS_TITLE'} 戻る
EOF $page=$FORM{'page'}||1; $st=($page-1)*$thread; $nextfl=1; print "page:$page\n"; if($FORM{'page'}=~/(\d+)/){$page=$1;} foreach(@PAGEFILE[$st..$st+$thread-1]){ unless($_){$nextfl=0;last;} print <<"EOF"; EOF } print "
スレッドキータイトル    
$_$SUBJECT{$_}
\n"; if($nextfl){ $page++; print <<"EOF";
EOF } print <<"EOF"; EOF exit; sub view { my $datafile = $DATPATH . $FORM{'key'} . ".dat"; open(NUM,"<$datafile"); my @temp=; close(NUM); my $num=@temp; my $log = $PATH . "log/" . $FORM{'key'} . ".cgi"; open(WIP,"<$log"); my @log=; close(WIP); foreach (@log) { $_ =~ /(\d+)<>(.+)/; $log{$1} = $2; } ($name,$mail,$date,$message,$subject) = split(/<>/,$temp[0]); chomp($subject); print "Content-type: text/html; charset=shift_jis\n\n"; print <<"EOF"; $SETTING{'BBS_TITLE'} $FORM{'bbs'}:$subject ($FORM{'key'})
削除メッセージ(空だと透明):
EOF $page=$FORM{'page'}||1; $st=($page-1)*$res; $nextfl=1; print "page:$page\n"; if($FORM{'page'}=~/(\d+)/){$page=$1;} $n+=$st; foreach(@temp[$st..$st+$res-1]){ unless($_){$nextfl=0;last;} ($name,$mail,$date,$message,$subject) = split(/<>/,$_); $date =~ s/ ID:(.+)$//g; $message =~ s/
//g; $message=substr($message,0,28); $message =~ s//>/g; $n++; ($host) = (split /<>/,$log{$n})[1]; #if($mail) {$name="$name"} print "\n"; } print "
 
名前投稿日内容ホスト
$n$name$date$message $host
\n"; if($nextfl){ $page++; print <<"EOF";
EOF } print <<"EOF"; EOF exit; } sub res_del { my $datafile = $DATPATH . $FORM{'key'} . ".dat"; open(NUM,"<$datafile"); my @temp=; close(NUM); my $num=@temp; ($name,$mail,$date,$message,$subject) = split(/<>/,$temp[0]); $i=1; $fl=0; foreach (@temp){ ($name,$mail,$date,$message,$subject) = split(/<>/,$_); if($FORM{$i} eq "1"){ if ($FORM{'mes'} ne ""){ $line="$FORM{'mes'}<>$FORM{'mes'}<>$FORM{'mes'}<>$FORM{'mes'}<>$FORM{'mes'}\n"; } else{$line="";$fl=1;} if ($i eq "1" && $FORM{'mes'} eq "") {DispError("ERROR!","1は透明あぼーんできません");} }else{ if($fl){#透明以下のレスは>>のズレを修正_未実装 $line=$_; } else {$line=$_;} } push(@ALOG,$line); $i++; } open(OUT, "> $datafile"); eval{flock(OUT,2);}; foreach (@ALOG){print OUT $_;} eval{flock(OUT,8);}; close(OUT); chmod(0666,"$datafile"); &location; } sub thread_del { my $datafile = $DATPATH . $FORM{'key'} . ".dat"; my $subject = $PATH . "subject.txt"; use vars qw(@PAGEFILE); use vars qw(%SUBJECT); use vars qw($FILENUM); my $key = $FORM{'key'}; $delfile = $DATPATH . $key . ".dat"; unlink($delfile); $delfile = $TEMPPATH . $key . ".html"; unlink($delfile); open(SUBR,"<$subject"); #SUBJECTを開く my @SUBJECTLIST = ; #内容を全て読み込む close(SUBR); #閉じる #サブジェクト内容をハッシュに格納 foreach(@SUBJECTLIST){ chomp($_);#改行を取る my ($file, $value) = split(/<>/,$_); my $filename = $DATPATH . $file; if(-e $filename){ #datが存在する場合のみ最後に追加 push(@PAGEFILE,$file); $SUBJECT{$file} = $value; } } $FILENUM=@PAGEFILE; my $keyfile = $FORM{'key'} . ".dat"; my $line = $SUBJECT{$keyfile}; $line =~ /(.+)\<(\d+)\>$/; open(SUBW,">$subject"); eval{flock(SUBW,2);}; foreach (@PAGEFILE) { if ($_ ne $keyfile) { print SUBW "$_<>$SUBJECT{$_}\n"; } } eval{flock(SUBW,8);}; close(SUBW); chmod(0666,"$subject"); &location; } sub thread_move { my $datafile = $DATPATH . $FORM{'key'} . ".dat"; print "Content-type: text/html; charset=shift_jis\n\n"; print <<"EOF"; スレッド移転 EOF if($FORM{'mode2'} eq 'thread_move'){ open(IN,"$datafile");@log=;close(IN); $subject=(split /<>/,$log[0])[4];chomp($subject); print <<"EOF";
次のスレッドを移転します。 $FORM{'bbs'}:$subject ($FORM{'key'})
移動先:
跡なし
EOF }elsif($FORM{'mode2'} eq 'thread_move2'){ $datn = substr($FORM{'key'},0,3); $kako=0;$m_to=$FORM{'m_to'}; if($FORM{'m_to'} eq 'kakolog'){ $FORM{'log'}=1; $FORM{'m_to'}="$FORM{'bbs'}/kako/$datn"; $kako=1; }else{ $FORM{'m_to'}="$FORM{'m_to'}/dat"; } $fr = "../$FORM{'bbs'}/dat/$FORM{'key'}.dat"; $to = "../$FORM{'m_to'}/$FORM{'key'}.dat"; $frh = "../$FORM{'bbs'}/html/$FORM{'key'}.html"; if($kako){$toh = "/dev/nul"}else{$toh="../$m_to/html/$FORM{'key'}.html";} print <<"EOF";
EOF if($FORM{'log'}){print "跡なし";}else{print "跡あり";} ## 跡なしの場合移転元のsubject.txtから元スレを抜く if($FORM{'log'}){ open(FILE,"../$FORM{'bbs'}/subject.txt"); @subject =; close(FILE); open(FILE,">../$FORM{'bbs'}/subject.txt"); eval{flock(FILE,2)}; foreach(@subject){ chomp($_); ($dat,$sub)=split /<>/; if($dat ne "$FORM{'key'}.dat"){ print FILE "$_\n"; } } eval{flock(FILE,8)}; close(FILE); chmod(0666,"../$FORM{'bbs'}/subject.txt"); undef @subject; } ## 過去ログ行きの場合ディレクトリ作成 if($kako){ if(!-d "../$m_to/kako/"){ mkdir("../$FORM{'bbs'}/kako/",0777); chmod (0777,"../$FORM{'bbs'}/kako/"); } if(!-d "../$m_to/kako/$datn/"){ mkdir ("../$FORM{'bbs'}/kako/$datn/",0777); chmod (0777,"../$FORM{'bbs'}/kako/$datn/"); } } ## 移転先にファイル移動 rename($fr,$to); rename($frh,$toh); if(!$FORM{'log'}){ open(FILE,">$fr"); eval{flock(FILE,2)}; print FILE "移転したよ<>移転したよ<>移転したよ<>移転しました
こちらです。$baseurl$m_to/index.html<>移転しました\n"; eval{flock(FILE,8)}; close(FILE); chmod(0666,"$fr"); } ## 移転先のsubject.txt書き換え open(FILE,"$to");@log =;close(FILE); $subject=(split /<>/,$log[0])[4];$line=@log;chomp($subject); open(FILE,"../$m_to/subject.txt"); @subject =; close(FILE); $subl="$FORM{'key'}.dat<>$subject ($line)\n"; unshift(@subject,$subl); open(FILE,">../$m_to/subject.txt"); eval{flock(FILE,2)}; foreach(@subject){ chomp($_); print FILE "$_\n"; } eval{flock(FILE,8)}; close(FILE); chmod(0666,"../$m_to/subject.txt"); print "
\n"; print "
\n"; $url="remake.cgi?bbs=$FORM{'bbs'}&dat=$FORM{'key'}"; if($kako){$url.="&bbs2=$FORM{'bbs'}&kako2=true&key2=$FORM{'key'}\n";} else{$url.="&bbs2=$m_to&key2=$FORM{'key'}\n";} print "
\n"; print "押してください"; } print <<"EOF"; EOF exit; } sub stop { my $datafile = $DATPATH . $FORM{'key'} . ".dat"; open(NUM,"<$datafile"); my @temp=; close(NUM); my $num=@temp; open(OUT, ">> $datafile"); eval{flock(OUT,2)}; print OUT "真・スレッドストッパー<>真・スレッドストッパー<>停止<>書けませんよ( ̄ー ̄)ニヤリッ<>\n"; eval{flock(OUT,8)}; close(OUT); #パーミッション調整 umask(0); chmod(0666,$datafile); chmod(0777,"$DATPATH"); chmod(0777,"$PATH"); &location } sub location{ $PATH = "./remake.cgi?bbs=$FORM{'bbs'}&key=$FORM{'key'}"; if ($SETTING{'BBS_LOCATION_CHECK'} eq 'checked') { print "Location: $PATH\n\n"; } else { print "Content-Type: text/html; charset=shift_jis\n\n"; print < 削除中 削除中 EOF } exit; } #エラー画面(エラー処理) #DispError(TITLE,TOPIC); sub DispError{ my $title=$_[0]; my $topic=$_[1]; print "Content-type: text/html; charset=shift_jis\n\n"; #----------------------------------------------------------------------- print < $title
$topic
key =$FORM{'key'} bbs =$FORM{'bbs'} address =$FORM{'address'}
EOF #----------------------------------------------------------------------- exit; }