#!/usr/bin/perl
#BEGIN { use KCatch qw(source); }
# =====================================================================
# Web掲示板「RoRo BBS」(ROoftop ROmance/意訳:屋上の物語) Ver1.6
#
# ダダ email:dada@sygnas.tv url:http://sygnas.tv/
# =====================================================================
#
# ※文字コードはShift_JIS、TAB幅「4」でご覧ください。
# ※DBモジュールを使いますので「Fcntl」「Config」「AnyDBM_Files」
# がない環境だと動作しません。
# ※ファイルロック用にシンボリックリンクを使いますので、Win系のサーバー
# だと正常動作しないかもしれません(手抜き)。
#
# =====================================================================
# 2001.12.?? Ver1.6
# ログ形式を変更。スレ毎の関連発言数を %SLEDに記録するようにした。
# 過去ログの吐き出しが正常に行われていなかったのを修正。
# 2001.11.03 Ver1.5
# rorobbs.cgi?nowrite=true で書き込みフォーム非表示を追加
# 2001.09.17 Ver1.4
# 全スレッド表示機能を追加。
# 2001.??.?? Ver1.3
# スレッドのソートがおかしかったのを修正。
# メ−ル通知オプションの判定が反転していたのを修正。
# 2001.06.07 Ver1.2
# 本文のほかに題名と投稿者名も全角半角変換するようにした
# 投稿者のブラウザ情報を記録するようにした(活用方法は各自で:-))
# 管理者のみが発言できるモードを追加(投稿パスワードで判断)
# 文字コードの指定がおかしかったのを修正
# 2001.04.23 Ver1.1
# スレッド単位発言通知機能を追加。
# %%%MAIL_INFO_FRM%%%の場所にチェックボックスが挿入されます。
# CGIは■Ver1.1■の記述のあるとこが変更されてます。
# CGIライブラリもVerUP dada041.pl → dada042.pl。
# 2001.04.12 Ver1.0
# 最初のバージョン公開
# =====================================================================
# ===============================================
# 設定項目
# -----------------------------------------------
# 最初の「#!/usr/local/bin/perl」を環境に合わせて変更してください。
# その他の設定は付属の「config.txt」を修正してください。
# ===============================================
require './jcode.pl';
require './dada042.pl'; # ■Ver1.1■から「dada042.pl」
use Fcntl;
use Config; # perlの設定を読むモジュール
use AnyDBM_File;
# ===============================================
# メイン
# ===============================================
&init_cgi; # 初期化
$umask_old = umask;
umask( 000 );
$flags = O_CREAT|O_RDWR|&BINARY; # DB開くときに必要
tie( %BBSLOG, 'AnyDBM_File', $CFG{DB_LOG}, $flags, 0666 ) || &ht_error("Can't open DB -$CFG{DB_LOG}-");
tie( %SLED, 'AnyDBM_File', $CFG{DB_SLED}, $flags, 0666 ) || &ht_error("Can't open DB -$CFG{DB_SLED}-");
umask( $umask_old );
&count if $CFG{COUNT}; # 閲覧者集計
#print "Content-type: text/html\n\n";
if( $FORM{md} eq 'write' ) { &write; } # レス書き
elsif( $FORM{md} eq 'regist' ) { ®ist; } # 登録
elsif( $FORM{md} eq 'gifindex' ) { &gifindex; } # アイコン一覧
elsif( $FORM{md} eq 'delete' ) { &delete; } # 削除
elsif( $FORM{md} eq 'search' ) { &search; } # 検索
elsif( $FORM{md} eq 'new' ) { &new; } # 新着順表示
elsif( $FORM{md} eq 'sled' ) { &sled_list; } # 全スレッド表示【1.4】
elsif( $FORM{md} eq 'backup' ) { &backup; } #
else { &read; }
untie( %BBSLOG );
untie( %SLED );
exit;
# ===============================================
sub BINARY{
return O_BINARY if $Config{osname} =~ /^(MS)?Win/;
}
# 初期化
# ===============================================
sub init_cgi{
@DAY_JP = qw( 日 月 火 水 木 金 土 );
@DAY_US = qw( Sun Mon Tue Wed Thu Fri Sat );
@MON_US = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Nov Dec );
$CNV{HAN} = '0-9A-ZA-ZA-Z!"\'#$%&()=|@[]{}<>?+*/\@-';
$CNV{ZEN} = '0-9A-Za-za-z!”’#$%&()=|@[]{}<>?+*/¥@−';
&dada::form_decode( 'sjis','wrap','noconv' );
if( !$FORM{cfg} || ! -e $FORM{cfg}.'.txt' ){ $FORM{cfg} = 'config'; }
%CFG = &dada::read_cfg( $FORM{cfg}.'.txt' );
$IMODE = &dada::chk_imode; # imodeかどうかチェック
if( $IMODE ){
$CFG{MAX_SLED} = 7; # imodeの時表示するスレッド数
$CFG{MAX_RES} = 5; # 同じくレス数
$CFG{HT_HEAD} = $CFG{HT_HEAD_I};
$CFG{HT_FOOT} = $CFG{HT_FOOT_I};
$CFG{HT_INPUT} = $CFG{HT_INPUT_I};
$CFG{HT_INRES} = $CFG{HT_INRES_I};
$CFG{HT_NEXT} = $CFG{HT_NEXT_I};
$CFG{HT_SLED_LIST} = $CFG{HT_SLED_LIST_I};
$CFG{HT_SLED_HEAD} = $CFG{HT_SLED_HEAD_I};
$CFG{HT_SLED_RES} = $CFG{HT_SLED_RES_I};
$CFG{HT_SLED_FOOT} = $CFG{HT_SLED_FOOT_I};
$CFG{MAIL_INFO_FRM} = $CFG{MAIL_INFO_FRM_I} # 発言通知チェックボックス ■Ver1.1■
}
&get_cookie; # クッキー読みだし
}
# 登録
# ===============================================
sub regist{
my $date;
my $i = 1;
my ( $resno, $count ); ### ■Ver1.6■レス番号と関連発言数
my $now = time;
my %T = &dada::get_time;
my $host = &dada::get_host;
my $pass = &mkpass( $FORM{pass} );
# 荒らし排除
if($FORM{email} eq 'info@dpn.cx'){
&ht_error( '投稿は禁止されています' );
}
if($FORM{email} !~ /\!$/){
&ht_error( '投稿は禁止されています' );
}
$FORM{email} =~ s/\!$//;
&chkform; # フォームの内容をチェック
&chkdouble if $CFG{DOUBLE}; # 二重投稿チェック
&dada::lock1( $CFG{LOCK} ); # ロック
# 新規スレの場合は番号付け
# --------------
if( !$FORM{num} ){
$BBSLOG{LAST} ++;
$FORM{num} = $BBSLOG{LAST};
$SLED{$FORM{num}} = $now.'_1_1'; # ■Ver1.6■スレ番号をkeyに、時刻と最終番号、関連発言数
}else{
# メール通知リスト作成
$SLED{$FORM{num}} =~ /^\d+_(\d+)_(\d+)$/; $resno=$1; $count=$2; ### ■Ver1.6■要素取得
&mailinfo_chk( $resno -1 ) if $CFG{MAIL_INFO};
$SLED{$FORM{num}} = $now.'_'.($resno +1).'_'.($count +1);
$FORM{num} .= "_".$resno;
}
&newsort( $FORM{num},$now ); # 発言番号順を登録
# 時間関係
# --------------
$T{mon} = sprintf( "%02d",$T{mon} );
$T{mday} = sprintf( "%02d",$T{mday} );
$T{hour} = sprintf( "%02d",$T{hour} );
$T{min} = sprintf( "%02d",$T{min} );
$T{sec} = sprintf( "%02d",$T{sec} );
$date = "$T{year}/$T{mon}/$T{mday}";
if( $CFG{DAY} eq 'JP' ) { $date .= "($DAY_JP[$T{wday}])"; }
else { $date .= "($DAY_US[$T{wday}])"; }
$date .= " - $T{hour}:$T{min}:$T{sec}";
# 結合
# Ver1.1で $FORM{mailinfo} を追加。「YES」もしくは何も書き込まれない
# ブラウザ情報を追加■Ver1.2■
# --------------
$BBSLOG{$FORM{num}} = join(
"\t",$now,$date,$FORM{name},$FORM{email},$FORM{url},$FORM{color},$FORM{gif},
$FORM{subject},$FORM{comment},$host,$pass,$FORM{mailinfo},$ENV{HTTP_USER_AGENT}
);
&dada::lock2( $CFG{LOCK} ); # ロック解除
&set_cookie; # クッキー保存
# メールで管理者にしらせる
# ----------------------------
if( $CFG{MAILCHK} ){
if( $FORM{MAILADMIN} || $FORM{email} ne $CFG{MAIL_TO} ){
&mail( $date );
}
}
# メールで希望者に通知 ■Ver1.1■
if( $CFG{MAIL_INFO} && $BCCS ){
&mail( $date,'USER' );
}
my $cfg = $FORM{cfg};
%FORM = ();
$FORM{cfg} = $cfg;
&read;
# ログのバックアップ
$FORM{md} = 'backup';
&backup if $CFG{BACKUP};
}
# フォーム内容をチェック&書き換え
# ===============================================
sub chkform{
my ( $error,$tmp );
my $passmode;
if ($FORM{url}) { &ht_error("URLの入力は禁止です"); }
# SJISでいいのかな……
if ($FORM{comment} !~ /(\x82[\x9F-\xF2])|(\x83[\x40-\x96])/) {
&ht_error("本文に日本語(ひらがな、カタカナ)を入力してください。" );
}
$urlnum = ($FORM{comment} =~ s/http/http/ig);
if ($urlnum >= 3) { &ht_error("URLの多数書き込みは禁止です"); }
# 空欄チェック
# ------------------
$error .= '【名前】' if !$FORM{name};
$error .= '【題名】' if !$FORM{subject} && !$FORM{num};
$error .= '【本文】' if !$FORM{comment};
$error .= '【パスワード】' if !$FORM{pass};
&ht_error( $error."が入力されていません" ) if $error;
# 管理者のみの発言許可■Ver1.2■
# ------------------
if( $CFG{ADMINONLY} ){
$passmode = &decpass( $FORM{pass} ); # パスワードチェック
&ht_error( 'パスワードが違います' ) if $passmode eq 'USER';
}
# メ−ル通知チェック ■Ver1.1■
# ------------------
if( !$FORM{email} && $FORM{mailinfo} eq 'YES' ){
$error .= '
メ−ル通知するにはメールアドレスが必要です
';
}
if($FORM{email} eq 'info@fclub.cn'){
&ht_error( '書き込みが禁止されています' );
}
# 書き換え
# ------------------
while( $FORM{comment} =~ /((?:^|
|\r\n|\n|\r|>)+)>/i ){
$tmp = $1;
$FORM{comment} =~ s/$tmp>/$tmp>/i;
}
# タグの扱い
# ------------------
if( $CFG{TAG_DEL} == 2 ){ # タグを完全に不許可
$FORM{comment} =~ s/&(?!amp;|.|$)/&$1/g;
$FORM{comment} =~ s/</g;
$FORM{comment} =~ s/>/>/g;
$FORM{comment} =~ s/"/"/g;
}elsif( $CFG{TAG_DEL} == 1 ){ # 部分的に許可
$FORM{comment} =~ s/\<(?!\/?($CFG{TAG_OK})( [^>]*)?>)([^>]*)>/<$3>/oisg;
}
# 半角カナを全角に変換■Ver1.2■
if( $CFG{H2Z} ){
&jcode::h2z_sjis( \$FORM{comment} );
&jcode::h2z_sjis( \$FORM{subject} );
&jcode::h2z_sjis( \$FORM{name} );
}
# 改行を「
」に
$FORM{comment} =~ s/\x0D\x0A/
/g;
$FORM{comment} =~ s/\x0D/
/g;
$FORM{comment} =~ s/\x0A/
/g;
}
# スレッドソート
# 【1.4】サブルーチンにしました
# ===============================================
sub sled_sort{
my( $key );
foreach $key ( sort{ $SLED{$b} <=> $SLED{$a} } keys %SLED ){
push( @TIMES,$key ); # スレッドを時間順にソート
} # ■Ver1.3■ソート方法が文字列対象「cmp」になっていた^^;
}
# 表示
# ===============================================
sub read{
my $i;
my $startsled;
@TIMES; # スレッド毎の最終更新時間
$| = 1;
&ht_head;
&sled_sort; # スレッドを時間順にソート
$FORM{pg} = 1 if !$FORM{pg}; # 何番目のスレッドから表示開始するか
$startsled = ($CFG{MAX_SLED} * $FORM{pg}) - $CFG{MAX_SLED} if !$FORM{num};
if( !$IMODE && $FORM{nowrite} ne 'true' ){ # ■Ver1.5■書き込みフォーム非表示を追加
&form_write ; # 書き込みフォーム
}
if(( @TIMES && !$IMODE )||( @TIMES && $IMODE && !$FORM{num} )){
&sled_list( $startsled ) if @TIMES; # スレッド一覧
}
&form_type2 if $CFG{COMLENGTH} && $FORM{num}; # レス書きの時はシンプルに
# スレッドを表示。imodeは↑の一覧だけ
# --------------------------------
if( $IMODE && !$FORM{num} ){
1;
}elsif( !@TIMES && !$FORM{num} ){
print "
書き込みがありません
\n";
}elsif( $FORM{num} ){
&read_sled( $FORM{num} );
}else{
$FORM{pg} = 1 if !$FORM{pg};
foreach $i ( $startsled .. $#TIMES ){
$TIMES[$i] =~ s/^\d+_(\d+)_\d+$/$1/;
&read_sled( $TIMES[$i] );
last if $i >= $startsled + $CFG{MAX_SLED} -1;
}
}
if( $IMODE ){
&ht_next;
&form_write; # imodeは最後に書き込みフォーム
}else{
&ht_next;
}
&ht_foot;
}
# レス書き込みフォーム表示
# ===============================================
sub write{
&ht_head;
&form_write;
&form_type2 if !$IMODE; # レス書きの時はシンプルに
&read_sled( $FORM{num} );
&ht_foot;
}
# シンプルな表示
# ===============================================
sub form_type2{
$CFG{HT_SLED_HEAD} = $CFG{HT_WRITE_HEAD};
$CFG{HT_SLED_FOOT} = $CFG{HT_WRITE_FOOT};
$CFG{HT_SLED_RES_HEAD} = $CFG{HT_WRITE_RES_HEAD};
$CFG{HT_SLED_RES} = $CFG{HT_WRITE_RES};
$CFG{HT_SLED_RES_FOOT} = $CFG{HT_WRITE_RES_FOOT};
}
# 書き込みフォーム表示
# ===============================================
sub form_write{
my ( $colors,$cname,$cnum );
my ( $gifs,$gname,$gfile );
&init_htrep( 'FORM' );
# 色
# ------------------
$HTREP{color} = '';
$HTREP{colorlst} = '';
foreach $colors ( split( "\n",$CFG{COLOR} )){
$colors =~ s/\t//g;
( $cnum,$cname ) = split( ',',$colors );
if( $COOKIE{color} eq $cnum ){
$HTREP{color} .= "";
$HTREP{colorlst} .= "