#!/usr/local/bin/perl5 $SCRIPT_ID = 'HTB 1.2a'; # Perl5以上必須 # 制作 ひろPis inoue_h@mwc.biglobe.ne.jp #=============================================================================== #　基本的な設定　#　お使いの環境に合わせて設定する必要が有ります。 require './jcode.pl'; #　日本語変換ライブラリをインクルード #　掲示板スクリプトのURL $script = 'http://two-mix.freak.ne.jp/cgi-bin/bbs/htb.cgi'; #　掲示板のURL $reload = 'http://two-mix.freak.ne.jp/cgi-bin/bbs/'; #　ホームページのURL $home = 'http://two-mix.freak.ne.jp/main.htm'; $bbs_html = './index.html'; #　掲示板ファイル $datafile = './htb.dat'; #　ログファイル $past_dir = './past/'; #　過去ログディレクトリ $wwwcflag = 'flagment.html'; #　WWWCフラグファイル名 $password = 'dc_htb'; #　管理者削除キー $title = 'Signal to Noise Ratio なんでも掲示板'; #　掲示板タイトル $ttcolor = '#000000'; #　掲示板タイトルの色 $sjcolor = '#000000'; #　題名の文字色 $sbcolor = '#00FFFF'; #　題名のバックカラー（ヌルにすると罫線を表示します） $hacolor = '#CCCCFF'; #　クライアント情報文字色 $text = '#000000'; #　文字色 $bgcolor = '#FFFFFF'; #　背景色 $link = '#0000FF'; #　リンク文字色 $vlink = '#33CCFF'; #　訪問済リンク文字色 $alink = '#CC66FF'; #　押下中リンク文字色 $bgimage = ''; #　背景画像 $rsub_sw = 0; #　返信の題名表示（0:非表示　1:表示） $host_sw = 1; #　リモートホスト表示（0:非表示　1:表示） $inyo_sw = 0; #　引用文を斜体にする（0:しない　1:する） $jump_sw = 0; #　リロード方法（0:Locationで直接　1:HTTP-EQUIVで間接） $in_line = 1; #　アクティブリンク（0:不可　1:許可） #　アクティブリンク許可時にリンクするファイルの種類 $hlfiles = '/|.html|.htm|.shtml|.asp|.cgi|.txt|.lzh|.zip|.gif|.jpg|.jpeg|.bmp|.ram|.ra|.rm|.wav|.au|.vqf|.vql'; #　（追加する際は'|'で区切って下さい） #　掲示板information $bbsinfo = '投稿しても画面が更新されない場合はブラウザの更新ボタンでリロードして下さい。
この掲示板はWWWCに対応しています。'; #　アクセス拒否ホスト @deny_host = ( 'affrc\.go\.jp', 'inetc\.com', '202\.219\.98.', 'mpmol\.fi', 'tele\.net', 'rr\.com', 'tor\.acc\.ca', 'uwp\.edu', ); #　追加する際は以下のことに気を付けて下さい #　取得したホストネームに一部でも同じ文字列があると拒否します。 #　ピリオド等をうまく利用して指定しましょう。（ピリオドの前には\を付けて下さい） #　例：'com', ---　comという文字列があるホストをすべて拒否 #　例：'\.com', ---　comドメインからのアクセスを拒否 #=============================================================================== $lockfile = $past_dir . 'lock_htb.tmp'; $data_max = 50; $past_vol = 25; $tb_width = '90%'; $wwwcurl = 'http://www.nakka.com/wwwc/'; $wwwcimg = 'http://www.nakka.com/wwwc/wwwc_meta.gif'; $referer = $ENV{'HTTP_REFERER'}; $referer =~ s/\%7E/\~/ig; $spc = '　'; $td1 = "［HOME］\n"; $td2 = "［SERCH］\n"; $td3 = "［BBS］\n"; $td4 = "［WWWC］\n"; if (!$text) { $text = 'black'; } if (!$bgcolor) { $bgcolor = 'ivory'; } if (!$link) { $link = 'blue'; } $body = "/>/g; $value =~ s/"/"/g; $value =~ s/\n//g; $value =~ s/\t//g; $value =~ s/\,/\t/g; &jcode'h2z_sjis(*value); &jcode'convert(*value,'sjis'); if ($qst && $name ne 'mode') { &error('不正利用の可能性があります。'); } $FORM{$name} = $value; } #　クッキーの取得 $cookies = $ENV{'HTTP_COOKIE'}; @pairs = split(/;/,$cookies); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ s/ //g; $DUMMY{$name} = $value; } @pairs = split(/,/,$DUMMY{$script}); foreach $pair (@pairs) { ($name, $value) = split(/:/, $pair); $COOKIE{$name} = $value; } #　メイン分岐 if ($FORM{'mode'} eq 'new_article') { &upload; } elsif ($FORM{'mode'} eq 'regist') { ®ist; } elsif ($FORM{'mode'} eq 'delete') { &delete; } elsif ($FORM{'mode'} eq 'serch') { &serch; } #　フォームデータが空のときは単にHTMLを更新 &filelock; &dataload; &html($bbs_html,'',@DATA); if (-e $lockfile) { unlink "$lockfile"; } &reload; exit; #　HTMLデータ作成保存 sub html { local($filename,$past,@DATA) = @_; local($tmp1,$tmp2,$pvol,$plink,$fdate,$fname,$fsubject,$end_data,$resline,@NEW); $end_data = @DATA - 1; @NEW = (); foreach (0 .. $end_data) { $line = $DATA[$_]; ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$line); if (!$res) { push(@NEW,$line); } } if (!$past) { ($tmp1,$tmp2,$pvol) = split(/:/,$log_hdr); ($fdate,$code,$res,$fname,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$fsubject) = split(/\,/,$DATA[0]); $wwwc_chk = "\n"; $tdt = "$td1$td2$td4"; $res_bott = "\n"; if ($pvol) { $tmp2 = ''; foreach (1 .. $pvol) { $tmp1 = $past_dir . "htblog$_\.html"; if (-e $tmp1) { $tmp2 .= "$_$spc"; } } if ($tmp2) { $plink = "過去ログLink$spc$tmp2\n
\n"; } } &header; $bbs_value = <<_EOL_; $bbs_head
$plink
_EOL_ } else { $tdt = "$td1$td3$td4"; $bbs_value = <<_EOL_; $title　過去ログ $past $body
$tdt
$title　過去ログ $past
_EOL_ } @DATA = reverse(@DATA); foreach $line (@NEW) { ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$line); if ($res_bott) { $check = ""; } &new_article; $bbs_value .= <<_EOL_; $new_art
    _EOL_ foreach $resline (@DATA) { ($da,$co,$re,$na,$rh,$ra,$fh,$fa,$im,$em,$ur,$com,$sub,$rk,$ag) = split(/\,/,$resline); if ($code == $re) { if ($res_bott) { $check = ""; } &res_article; $bbs_value .= $res_art; } } $bbs_value .= "
\n\n\n
\n\n"; } &footer; $bbs_value .= "

\n$bbs_foot"; if (!open(OUT,">$filename")) { &error('ファイルのオープンに失敗しました。'); } eval 'flock(OUT,2);'; print OUT $bbs_value; close(OUT); } #　送信画面表示 sub upload { $COOKIE{'url'} =~ s/\*/\:/g; if ($COOKIE{'url'}) { $urlad = "http:\/\/$COOKIE{'url'}"; } $tdt = "$td1$td2$td3$td4"; print "Content-type: text/html\n\n"; &header; print $bbs_head; if ($FORM{'code'} == 0) { $bott = '送　信'; &form; print "
\n"; } else { @pairs = split(/&/,$formdata); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); if ($name eq 'quote') { push(@target,$value); } } &filelock; &dataload; if (-e $lockfile) { unlink "$lockfile"; } $rcom = ''; @DATA = reverse(@DATA); foreach $line (@DATA) { ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$line); if ($FORM{'code'} == $code) { $rline = $line; } foreach $tcode (@target) { if ($tcode == $code) { $comment =~ s/\t/\,/g; $comment =~ s/\r/\r> /g; $rcom .= "> $comment\r\r"; } } } ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$rline); $rco = $code; $rsub = "RE［$code］: $subject"; $bott = '返　信'; &form; $check = "削除\n"; &new_article; print <<_EOL_; \n
$new_art
    _EOL_ foreach $line (@DATA) { ($da,$co,$re,$na,$rh,$ra,$fh,$fa,$im,$em,$ur,$com,$sub,$rk,$ag) = split(/\,/,$line); if ($rco == $re) { $check = "削除\n"; &res_article; print $res_art; } } print <<_EOL_;

\n
削除キー
削除する記事をチェックしてから削除キーを入力して削除ボタンを押して下さい。
削除キーが一致しない記事は削除されません。

_EOL_ } &footer; print $bbs_foot; exit; } #　送信フォーム sub form { print <<_EOL_;
※半角カナ、機種依存文字、タグは使用できません。
※必須入力項目はお名前と内容です。

お名前
E-mail $spc削除キー （半角英数8文字以内）
題名
内容
URL
$spc 返信を新しい記事として送信する
_EOL_ } #　新しい投稿 sub new_article { if ($in_line) { $comment =~ s/((http|ftp):\/\/[!#-9A-~]+($hlfiles))/$1<\/a>/g; } if ($inyo_sw) { $comment = "$comment\r"; $comment =~ s/(>.*?)\r/$1<\/i>\r/g; } $comment =~ s/\r/
\n/g; $comment =~ s/\t/\,/g; if ($email) { $name = "$name"; } if ($url) { $url =~ s/\*/\:/g; $urlad = " 【HOME】"; } else { $urlad = ''; } if (!$host_sw) { $rhost = ''; } $new_art = <<_EOL_; $spc\[$code\] $subject $spc$name さん$spc【$date】$urlad $spc$check
$spc$rhost$spc$agent $res_bott
$comment
_EOL_ } #　返信投稿 sub res_article { if ($in_line) { $com =~ s/((http|ftp):\/\/[!#-9A-~]+($hlfiles))/$1<\/a>/g; } if ($inyo_sw) { $com = "$com\r"; $com =~ s/(>.*?)\r/$1<\/i>\r/g; } $com =~ s/\r/
\n/g; $com =~ s/\t/\,/g; if ($em) { $na = "$na"; } if ($ur) { $ur =~ s/\*/\:/g; $urlad = " 【HOME】"; } else { $urlad = ''; } if (!$host_sw) { $rh = ''; } if ($rsub_sw) { $sub = "\n$sub
"; } else { $sub = ""; } $res_art = <<_EOL_;

  • $sub $na さん$spc【$da】$urlad $spc$check
    $rh$spc$ag
    $com
    _EOL_ } #　HTMLヘッダ sub header { $bbs_head = <<_EOL_; $wwwc_chk $title $body
    $tdt
    $title WWWC
    $bbsinfo
    _EOL_ } #　HTMLフッタ sub footer { $bbs_foot = <<_EOL_;
    $tdt
    - $SCRIPT_ID -

    _EOL_ #　著作権表示は改竄禁止です。 } #　再読込 sub reload { if (!$jump_sw) { print "Location: $reload\n\n"; exit; } else { print "Content-type: text/html\n\n"; print <<_EOL_; $title Reload $body 自動で掲示板に戻らないときはここを押して下さい。 _EOL_ } exit; } #　投稿データ保存 sub regist { local($dmy,$line,$value,$end_data,$target,$pastname); if ($FORM{'name'} eq "") { &error('お名前が記入されていません。'); } if ($FORM{'comment'} eq "" || $FORM{'comment'} eq $FORM{'rcom'}) { &error('コメントが記入されていません。'); } if ($FORM{'rmvkey'} && $FORM{'rmvkey'} =~ /\W/) { &error('半角英数字以外の文字が有ります。'); } $len_com = length($FORM{'comment'}); if ($len_com > 5120) { &error('コメントが長すぎます。'); } $ret_nn = ($FORM{'comment'} =~ tr/\r//); if ($ret_nn > 100 || (($ret_nn > 20 && ($len_com / $ret_nn) < 10))) { &error('改行が多すぎます。'); } if ($FORM{'email'} && !($FORM{'email'} =~ /(.*)\@(.*)\.(.*)/)) { &error('メールアドレスが不正です。'); } if ($FORM{'new'}) { $FORM{'res'} = ''; } if (!$FORM{'subject'}) { $FORM{'subject'} = '無題'; } $FORM{'url'} =~ s/^http:\/\///; $FORM{'url'} =~ s/\:/\*/g; if ($FORM{'rmvkey'}) { &encode($FORM{'rmvkey'}); } &filelock; &dataload; ($dmy,$new_code,$past) = split(/:/,$log_hdr); foreach $line (@DATA) { ($da,$co,$re,$na,$rh,$ra,$fh,$fa,$im,$em,$ur,$com,$sub,$rk) = split(/\,/,$line); if ($sub eq $FORM{'subject'} && $com eq $FORM{'comment'}) { if (-e $lockfile) { unlink "$lockfile"; } &reload; } push(@new,$line); } $new_code++; $value = "$date_now\,$new_code\,$FORM{'res'}\,$FORM{'name'}\,$rmthost\,$rmtaddr\,$fwdhost\,$fwdaddr\,$img\,$FORM{'email'}\,$FORM{'url'}\,$FORM{'comment'}\,$FORM{'subject'}\,$rmvkey\,$ENV{'HTTP_USER_AGENT'}\,\n"; unshift(@new,$value); @DATA = (); if (@new > $data_max) { foreach (1 .. $past_vol) { $value = pop(@new); push(@DATA,$value); } $end_data = @new - 1; foreach (0 .. $end_data) { $target = $end_data - $_; ($date,$code,$res) = split(/\,/,$new[$target]); if (!$res) { last; } $value = pop(@new); push(@DATA,$value); } $end_data = @new - 1; foreach (1 .. $end_data) { $target = $end_data - $_; $line = $new[$target]; ($da,$co,$re) = split(/\,/,$line); if ($re && $re < $code) { splice(@new,$target,1); push(@DATA,$line); } } @DATA = reverse(@DATA); $past++; $pastname = $past_dir . 'htblog' . $past . '.html'; &html($pastname,$past,@DATA); @DATA = (); } $log_hdr = "$SCRIPT_ID:$new_code:$past:\n"; &datasave; &html($bbs_html,'',@new); if (-e $lockfile) { unlink "$lockfile"; } &set_cookie; &flagsave; &reload; } #　記事の削除 sub delete { local($code,$line,$don,$mtc,@target); @pairs = split(/&/,$formdata); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); if ($name eq 'remove') { push(@target,$value); } } if (@target < 1) { &reload; } if ($FORM{'rmvkey'} eq $password) { $master = 1; } &filelock; &dataload; @DATA = reverse(@DATA); $don = 0; foreach $line (@DATA) { chop($line); ($da,$co,$re,$na,$rh,$ra,$fh,$fa,$im,$em,$ur,$com,$sub,$rk,$ag) = split(/\,/,$line); $mtc = 0; if ($rk =~ /^\$1\$/) { $crptkey = 3; } else { $crptkey = 0; } foreach $code (@target) { if ($co == $code) { if ($master || ($rk ne '' && crypt($FORM{'rmvkey'}, substr($rk,$crptkey,2)) eq $rk)) { $mtc = 1; $don = 1; } } elsif ($re == $code && $don) { $mtc = 1; } } if (!$mtc) { unshift(@new,"$line\n"); } } &datasave; &html($bbs_html,'',@new); if (-e $lockfile) { unlink "$lockfile"; } &reload; } sub flagsave { $flag = <<"EO_F"; \n\nWWWC-Check $title $wwwc_chk \n $title WWWC-Check
    WWWC

    このページには、WWWCのMETAタグによる更新情報が埋め込まれています。
    WWWCを使うことにより、新規投稿の有無の確認がかんたんにできるように
    なります。また、新規投稿の確認のためだけに掲示板にアクセスすることは、
    むだにCGIを起動させ、サーバの負荷を増加させることにもつながります。

    快適なアクセスのために、WWWCの利用をおすすめします。

    最新の投稿情報$spc$date_now$spc$FORM{'name'}さん$spc$FORM{'subject'}

    $title \n EO_F if (!open(HTML,">$cgi_dir$wwwcflag")) { &error('WWWCフラグファイルの書込に失敗しました。'); } eval 'flock(HTML,2);'; print HTML $flag; close(HTML); } #　簡易ワード検索（index関数） sub serch { local($sword) = $FORM{'word'}; local($wd,$flag,$line,$kensu,@wchk,@word,@new); $tdt = "$td1$td3$td4"; print "Content-type: text/html\n\n"; &header; print <<_EOL_; $bbs_head

    ワード検索

    検索するキーワードを入力して下さい。
    スペースで区切って複数のキーワードを指定できます。


    AND検索$spc OR検索$spc$spc

    ※アルファベットの大文字小文字は区別されます。

    _EOL_ if ($FORM{'serch'}) { if ($sword eq '') { &footer; print <<_EOL_;
    キーワードが入力されていません。

    $bbs_foot _EOL_ exit; } $sword =~ s/\s+/ /g; $sword =~ s/　+/ /g; @word = split(/ /,$sword); if (@word > 0) { @new = (); &filelock; &dataload; if (-e $lockfile) { unlink "$lockfile"; } foreach $line (@DATA) { ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$line); $flag = 0; foreach $wd (@word){ if (index($comment,$wd) >= 0) { $flag = 1; if($FORM{'andor'}) { last; } } else { if(!$FORM{'andor'}) { $flag = 0; last; } } } if ($flag == 1) { push(@new,$line); } } } $kensu = @new; if ($FORM{'andor'}) { $sword =~ s/ /<\/font> or /g; } else { $sword =~ s/ /<\/font> and /g; } $sword = "$sword"; print "\n"; print "
    \n"; print "キーワード： $sword
    \n"; print "検索結果$spc： $kensu件
    \n"; print "
    \n"; if ($kensu) { foreach $line (@new) { ($date,$code,$res,$name,$rhost,$raddr,$fhost,$faddr,$img,$email,$url,$comment,$subject,$rkey,$agent) = split(/\,/,$line); &new_article; print "\n"; print "$new_art
    \n"; } } else { print "\n"; print "

    \n"; print "該当する情報は見つかりませんでした。\n"; print "

    \n
    \n"; } } &footer; print "

    \n$bbs_foot\n"; exit; } #　クッキー書込 sub set_cookie { $ENV{'TZ'} = "GMT"; ($c_sec,$c_min,$c_hour,$c_mday,$c_mon,$c_year,$c_wday,$c_yday,$c_isdst) = localtime(time + 30 * 86400); if ($c_year < 10) { $c_year = "0$c_year"; } if ($c_sec < 10) { $c_sec = "0$c_sec"; } if ($c_min < 10) { $c_min = "0$c_min"; } if ($c_hour < 10) { $c_hour = "0$c_hour"; } if ($c_mday < 10) { $c_mday = "0$c_mday"; } $c_year += 1900; $month = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$c_mon]; $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$c_wday]; $date_gmt = "$youbi, $c_mday\-$month\-$c_year $c_hour:$c_min:$c_sec GMT"; $cook="name\:$FORM{'name'}\,email\:$FORM{'email'}\,url\:$FORM{'url'}\,rmvkey\:$FORM{'rmvkey'}\,date\:$date_now"; print "Set-Cookie: $script=$cook; expires=$date_gmt\n"; } #　データ読込 sub dataload { if (!open(DT,"$datafile")) { &error('ファイルの読み込みに失敗しました。'); } eval 'flock(DT,2);'; @DATA =
    ; close(DT); $log_hdr = shift(@DATA); } #　データ書込 sub datasave { if (!open(DT,">$datafile")) { &error('ファイルの書き込みに失敗しました。'); } eval 'flock(DT,2);'; print DT $log_hdr; print DT @new; close(DT); } #　プロセスロック sub filelock { local($dflag) = 0; foreach (1 .. 10) { unless (-e $lockfile) { if (open(LOCK,">$lockfile")) { close(LOCK); $dflag = 1; last; } } else { sleep(1); } } if (!$dflag) { &error('別のプロセスによりロックされています。
    数分経ってもロックが解除されないときは管理者まで連絡して下さい。'); } } #　削除キーの暗号化 sub encode { $now = time; ($p1, $p2) = unpack("C2", $now); $wk = $now / (60*60*24*7) + $p1 + $p2 - 8; @saltset = ('a'..'z','A'..'Z','0'..'9','.','/'); $nsalt = $saltset[$wk % 64] . $saltset[$now % 64]; if (!eval '$rmvkey = crypt($_[0], $nsalt);') { &error('暗号処理コマンドが使えないので動作できません。'); } } #　ドメインチェック sub dmaincheck { $rmthost = $ENV{'REMOTE_HOST'}; $rmtaddr = $ENV{'REMOTE_ADDR'}; if ($rmthost eq $rmtaddr || !$rmthost) { $rmthost = gethostbyaddr(pack('C4',split(/\./,$rmtaddr)),2); } $fwdaddr = $ENV{'HTTP_X_FORWARDED_FOR'}; if ($fwdaddr =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ ){ $fwdhost = gethostbyaddr(pack('C4',split(/\./,$fwdaddr)),2); if (!$fwdhost) { $fwdhost = $fwdaddr; } } foreach $deny (@deny_host) { if ($deny && ($rmthost =~ /$deny/i || $rmtaddr =~ /$deny/i)) { &error('アクセスは拒否されました。'); } } $rmthost =~ s/\,//g; $rmtaddr =~ s/\,//g; $fwdhost =~ s/\,//g; $fwdaddr =~ s/\,//g; } #　エラー画面表示 sub error { if (-e $lockfile) { unlink "$lockfile"; } print "Content-type: text/html\n\n"; &header; print <<_EOL_; $bbs_head

    ＥＲＲＯＲ

    $_[0]
    • _EOL_ exit; }