#! /usr/local/bin/perl # #========================================================================================== # # 多機能(?)掲示板システム 『SSBoard』 : メッセージ削除スクリプト # # Copyright Shinobu Suzuki 1998. All rights reserved. #----------------------------------------------------------------------------------------- # HomePage : http://www.aikis.or.jp/~s-suzuki/cgilabo/ # E-mail : s-suzuki@aikis.or.jp #========================================================================================== # 初期設定 #------------------------------------------------------------------------------------------ $version = '1.3'; # 本スクリプトのバージョン $script = 'ssboard.cgi'; # 掲示板スクリプト名 $bg_col = '#e0e0e0'; # 背景色 $title_col = '#000080'; # タイトルの色 $text_col = '#000000'; # テキストの色 $link_col = '#0000ff'; # リンクの色 $alink_col = '#ff0000'; # リンク中の色 $vlink_col = '#800080'; # 既リンクの色 $subject_col = '#ff0000'; # 題名の色 $name_col = '#009000'; # 投稿者名の色 $indexname = '戻る'; # remove.cgiからの戻り先 $index = 'ssboard.cgi'; # remove.cgiからの戻り先(URL) #---------------------------------------------------------- # 管理用パスワード # 当然のことですが、できるだけ類推できにくいものを設定し # てください。できれば8文字より長いものにしましょう # ・ssboard.cgiと別のパスワードでも構いません # ・同じパスワードの方が便利かな? #---------------------------------------------------------- $user_pass = "1234"; #---------------------------------------------------------- # ログファイル名についてはセキュリティ上、変更しておいた方 # がよいと思います。 #---------------------------------------------------------- $log_file = "ssboard.log"; #---------------------------------------------------------- # ボード情報定義ファイル名 # 例) $cfg_name = "ssboard.cfg"; #---------------------------------------------------------- $cfg_file = ""; #---------------------------------------------------------- # ボード定義情報:デフォルト値 # ・定義ファイルを使用する場合は、そちらが優先されます。 # ・定義ファイルには、他にも項目がありますが、このスクリ # プトでは、以下の項目だけしか参照していません。 # ・定義ファイルを使用する場合は、この項目は削除してもか # まいませんが削除しない方がなにかと安全です。 #--- こ こ か ら ------------------------------------------ $security = '0'; # デフォルトセキュリティレベルの設定 # 0:制限なし # 1:JPドメインのみ許可 # 2:プロキシの禁止 # 3:JPおよびプロキシ $maintenance = '0'; # 掲示板メンテナンス中の制限フラグ # 0:通常の運用 1:書き込みを禁止 2:表示も禁止 #--- こ こ ま で ------------------------------------------ #---------------------------------------------------------- # 許可したいプロキシ(と誤判定されるドメイン)を設定する #---------------------------------------------------------- @proxylist = ( "aikis.or.jp", "cypress.ne.jp" ); #---------------------------------------------------------- # 利用制限するドメインリストのファイル名 # 省略すると、ドメイン制限は行われません # $domain_file = "domain.lst"; #---------------------------------------------------------- $domain_file = ""; #---------------------------------------------------------- # ファイル入出力時にファイルロックを行う設定。これにより、 # 同時アクセス時の問題が多少マシになる(?) # サーバーが flock()関数を使える設定の場合のみ利用できます # 0:ファイルロックを行わない # 1:flock()でファイルロックを行う #---------------------------------------------------------- $lockmode = 0; #---------------------------------------------------------- # CERN系のサーバーなどで、ファイル関係でエラーが出る場合、 # 以下に設置するディレクトリのサーバー内でのフルパスを指定 # してみると、正常に動作することがあるかもしれません ^^;; # # 最後は / で終わること。 # 例:$path = '/home/user/foo/public_html/cgi-bin/bbs/'; #---------------------------------------------------------- $path = ''; #---------------------------------------------------------- # 外部からの(イタズラ)書き込みを禁止する場合、以下に、ス # クリプトのURLを記入する。(サーバーやブラウザによっては # うまく働かないこともあります) # 例:$script_url = 'http://www.foo.com/~foo/ssboard.cgi'; #---------------------------------------------------------- $script_url = ''; #---------------------------------------------------------- # 書き込みの後のリロードに失敗する場合(File Not Foundので # る場合)、CGIスクリプトを設置するディレクトリ名をURLで指 # 定すると成功する場合があるそうです。 # ※この機能については未確認です # ※biglobeでは成功するそうです # ※v1.27より記述方法を変更しています # ※最後は / で終わること。 # 例:$rerload_url = 'http://www.aikis.or.jp/~s-suzuki/multibbs/'; #---------------------------------------------------------- $reload_url = ''; #========================================================================================= # 設定ここまで # これより、処理の開始 #========================================================================================= $| = 1; # ファイルバッファリングをしない &form; # フォーム入力された値の分解 &init; # 各種データ変数の初期化 &read_domainlist; # 制限するドメインリストの読み込み &read_cfg; # ボード定義情報の読み込み #---------------------------------------------------------- # スクリプトの動作を決定($FORM{'task'}で判定) #---------------------------------------------------------- if ( $FORM{'task'} eq 'list' ) { # 削除データのリスト表示 &removelist; } elsif ( $FORM{'task'} eq 'remove' ) { # データの削除ルーチンへ &remove_data; } else { &main; } #========================================================================================= # 処理はここまで(以下は、各サブルーチン) #========================================================================================= #----------------------------------------------------------------- # メイン画面 #----------------------------------------------------------------- sub main { if ($CFG_DATA{'maintenance'} ne "0" ) { &error("ただ今、メンテナンス中です。"); } &html_header("SSBoard:メッセージの削除"); print "
\n"; print "
削除するメッセージのパスワードか、管理者用パスワードを入力して下さい。


\n"; print "
\n"; print "パスワード\n"; print "\n"; print "
\n"; print "\n"; print "
$indexname
\n"; print "
\n"; print "\n"; print "\n"; exit; } #----------------------------------------------------------------- # 削除するメッセージのリスト表示と選択画面 #----------------------------------------------------------------- sub removelist { if ($CFG_DATA{'maintenance'} ne "0" ) { &error("ただ今、メンテナンス中です。"); } if ( $FORM{'pwd'} eq "" ) { &error("パスワードが入力されていません。"); } if ($crypt_mode eq "NG") { if ($mode eq "user") { &error("crypt()が使えないので削除できません。"); } } &security_check; &read_log; &html_header("SSBoard:削除するメッセージの一覧"); print "\n"; print "
\n"; print "\n"; print "\n"; foreach $line (@lines) { ($count,$date,$editpwd,$name,$email,$url,$value,$subject,$rhost) = split(/\,/,$line); if ( $mode eq "user" ) { if ( $editpwd ne "" ) { $temp = crypt( $FORM{'pwd'}, substr($editpwd,0,2) ); if ( $temp eq $editpwd ) { print ""; print "削除 "; print "$count $subject "; print "投稿者:$name"; print " ($date)

\n"; print "$value\n


\n"; } } } else { print ""; print "削除 "; print "$count $subject "; print "投稿者:$name"; print " ($date)

\n"; print "$value\n


\n"; } } print "\n"; print "

\n"; print "先頭へ
"; print "\n"; print "\n"; print "

\n"; print "\n"; exit; } #----------------------------------------------------------------- # リストアップされたメッセージのデータ削除 #----------------------------------------------------------------- sub remove_data { if ($crypt_mode eq "NG") { if ($mode eq "user") { &error("crypt()が使えないので削除できません。"); } } if ($CFG_DATA{'maintenance'} ne "0" ) { &error("ただ今、メンテナンス中です。"); } &security_check; &read_log; foreach $line (@lines) { ($count,$date,$editpwd,$name,$email,$url,$value,$subject,$rhost) = split(/\,/,$line); $del = 0; foreach $target (@RM) { if ($target eq "") { last; } if ($target eq $count) { if ($mode eq "user") { $temp = crypt( $FORM{'pwd'}, substr($editpwd,0,2) ); if ( $temp ne $editpwd ) { &error("パスワードが違います。"); } } $del = 1; } } if ($del == 0) { push(@new,$line); } } #-------------------------------------------------- # 記録ファイルをオープンしてデータを書き出す #-------------------------------------------------- &write_log; #-------------------------------------------------- # 記録処理後、再読み込み(リロード)する #-------------------------------------------------- print "Location:$reload_url$script\n\n"; exit; } #--------------------------------------------------------------------- # 各種データ変数の初期化 #--------------------------------------------------------------------- sub init { #------------------------------------------------------------- # 記入者のリモートホスト名を取得 # ホスト名が取得できない場合、アドレスを取得する #------------------------------------------------------------- $remote_host = $ENV{'REMOTE_HOST'}; if ( $remote_host eq "" ) { $remote_host = $ENV{'REMOTE_ADDR'}; } #------------------------------------------------------------- # IPアドレスのみの場合 nslookで検索 #------------------------------------------------------------- if( $remote_host=~/([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/ ) { $remote_host = &nslook($remote_host); } #------------------------------------------------------------- # 制限中のドメインのチェック #------------------------------------------------------------- if( $domain_file ne "" ) { foreach $domain (@domainlist2) { &domain_error if($remote_host=~/$domain/i); } } #------------------------------------------------------------- # crypt()が使用できるかの判定 #------------------------------------------------------------- $now = time; ($p1, $p2) = unpack("C2", "admin"); $wk = $now / (60*60*24*7) + $p1 + $p2 - 8; @saltset = ('a'..'z','A'..'Z','0'..'9','.','/'); $nsalt = $saltset[$wk % 64] . $saltset[$now % 64]; $pass1 = crypt( $user_pass, $nsalt); $pass2 = crypt( $user_pass, substr($pass1, 0, 2) ); if ( $pass1 eq $pass2 ) { $crypt_mode = "OK"; } else { $crypt_mode = "NG"; } } #----------------------------------------------------------------- # フォーム投稿されたデータを解析し、配列にリストする #----------------------------------------------------------------- sub form { #-------------------------------------------------- # フォームから入力されたデータを$bufferに格納 #-------------------------------------------------- if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } #-------------------------------------------------- # 動作モードの判定(管理者・ユーザーの各モード) #-------------------------------------------------- $mode = "user"; @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); if ( $name eq "pwd" ) { if( $value eq $user_pass ) { $mode = "admin"; } last; } } #-------------------------------------------------- # $bufferに格納されたFORM形式のデータを取り出す #-------------------------------------------------- foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #-------------------------------------------------- # 削除するメッセージ番号のリストアップ #-------------------------------------------------- if ($name eq "target") { push(@RM,$value); #---------------------------------------------- # 親メッセージの場合、コメントの有無に関わらず # コメントもリストアップする #---------------------------------------------- if ( substr($value, 0, 1) eq "#" ) { for( $i=0; $i<10; $i++ ) { $temp1 = substr( $value, 1, 4 ); $temp2 = sprintf "@%s%02d", $temp1, $i; push(@RM,$temp2); } } } $FORM{$name} = $value; } } #----------------------------------------------------------------- # ボード定義情報の初期化と、ファイルからの読み込み # このスクリプトでは、securityセクションのみ参照している #----------------------------------------------------------------- sub read_cfg { $CFG_DATA{'security'} = $security; $CFG_DATA{'maintenance'} = $maintenance; #--------------------------------------- # ファイルからの読み込み #--------------------------------------- if ( open(DB,"$path$cfg_file")) { if( $lockmode == 1 ) { eval { flock( DB, 1 );}; # ファイルをロック if ( $@ ne "" ) { &error("flock()がサポートされていません。"); } @cfg = ; flock( DB, 8 ); # ロック解除 } else { @cfg = ; } close(DB); } foreach $line (@cfg) { ($name,$value) = split(/\,/,$line); $CFG_DATA{$name} = $value; } } #----------------------------------------------------------------- # ログファイルの読み込み(@linesに格納) #----------------------------------------------------------------- sub read_log { if (!open(DB,"$path$log_file")) { &error("ファイルの入出力にエラーが発生しました。"); } if( $lockmode == 1 ) { eval { flock( DB, 1 );}; # ファイルをロック if ( $@ ne "" ) { &error("flock()がサポートされていません。"); } @lines = ; flock( DB, 8 ); # ロック解除 } else { @lines = ; } close(DB); } #----------------------------------------------------------------- # ログファイルの書き出し #----------------------------------------------------------------- sub write_log { if (!open(DB,">$path$log_file")) { &error("ファイルの入出力にエラーが発生しました。"); } if( $lockmode == 1 ) { eval { flock( DB, 2 );}; # ファイルをロック if ( $@ ne "" ) { &error("flock()がサポートされていません。"); } print DB @new; flock( DB, 8 ); # ロック解除 } else { print DB @new; } close(DB); } #----------------------------------------------------------------- # ドメインリストの読み込み #----------------------------------------------------------------- sub read_domainlist { if( $domain_file eq "" ) { return; } $filename = "$path"."$domain_file"; if (!open(DB,"$filename")) { &error("ドメインファイルが見つかりません。"); } if( $lockmode == 1 ) { eval { flock( DB, 1 );}; # ファイルをロック if ( $@ ne "" ) { &error("flock()がサポートされていません。"); } } @data = ; if( $lockmode == 1 ) { flock( DB, 8 ); # ロック解除 } close(DB); foreach $temp (@data) { ($domain,$level) = split(/\,/,$temp); if ( $level eq "0" ) { push( @domainlist1, "$domain" ); } else { push( @domainlist2, "$domain" ); } } } #----------------------------------------------------------------- # エラーメッセージの出力 #----------------------------------------------------------------- sub error { $error_msg = $_[0]; &html_header("SSBoard:エラーのおしらせ"); print "

$error_msg
\n"; print "\n"; exit; } #----------------------------------------------------------------- # ドメイン・エラーメッセージの出力 #----------------------------------------------------------------- sub domain_error { &html_header("SSBoard:エラーのおしらせ"); print "
現在アクセスしているホスト情報(ドメイン)ではご利用になれません。
\n"; print "アクセスしているホスト情報は以下のように判定されています。
\n"; print "もし判定がおかしい場合、管理者まで連絡してください。

\n"; print "ホスト情報:$remote_host
>\n"; print "\n"; exit; } #----------------------------------------------------------------- # プロキシ・エラーメッセージの出力 #----------------------------------------------------------------- sub proxy_error { &html_header("SSBoard:エラーのおしらせ"); print "
プロキシ経由での利用はできません。
\n"; print "プロキシの判定がおかしい場合、以下のホスト情報を添えて"; print "管理者まで連絡してください。

\n"; print "REMOTE_HOST = $remote_host
\n"; print "HTTP_PROXY_CONNECTION = $ENV{'HTTP_PROXY_CONNECTION'}
\n"; print "HTTP_CACHE_INFO = $ENV{'HTTP_CACHE_INFO'}
\n"; print "HTTP_VIA = $ENV{'HTTP_VIA'}
\n"; print "HTTP_CLIENT_IP = $ENV{'HTTP_CLIENT_IP'}
\n"; print "HTTP_X_FORWARDED_FOR = $ENV{'HTTP_X_FORWARDED_FOR'}
\n"; print "HTTP_FORWARDED = $ENV{'HTTP_FORWARDED'}
\n"; print "HTTP_USER_AGENT = $ENV{'HTTP_USER_AGENT'}
\n"; print "\n"; exit; } #----------------------------------------------------------------- # IPアドレスからホスト名を取得する #----------------------------------------------------------------- sub nslook { local($x)=@_; local($ip,$addr); if ($x =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ ){ $ip="$1.$2.$3.$4"; $addr = (gethostbyaddr(pack('C4',$1,$2,$3,$4),2))[0]; if ($addr ne "") { return $addr; } else { return $ip; } } return ""; } #----------------------------------------------------------------- # 各種のセキュリティ対策 #----------------------------------------------------------------- sub security_check { #-------------------------------------------------- # 制限中のドメインのチェック #-------------------------------------------------- foreach $domain (@domainlist1) { &domain_error if($remote_host=~/$domain/i); } foreach $domain (@domainlist2) { &domain_error if($remote_host=~/$domain/i); } #-------------------------------------------------- # 外部からの書き込みチェック(POSTのみ許可) #-------------------------------------------------- if ($ENV{'REQUEST_METHOD'} ne "POST") { &error("method=getでの投稿は受け付けられません。"); } #------------------------------------------------------------ # 各種のセキュリティ処理 #------------------------------------------------------------ if ( $CFG_DATA{'security'} eq "1" || $CFG_DATA{'security'} eq "3" ) { $temp = reverse $remote_host; #------------------------------------------------------------ # JPドメインの判定 #------------------------------------------------------------ if ( "pj." ne substr( $temp, 0, 3 ) ) { &domain_error; } } if ( $CFG_DATA{'security'} eq "2" || $CFG_DATA{'security'} eq "3" ) { #------------------------------------------------------------ # プロキシの排除 #------------------------------------------------------------ $proxycheck = 0; $proxycheck = 1 if($ENV{'HTTP_PROXY_CONNECTION'}); $proxycheck = 1 if($ENV{'HTTP_CACHE_INFO'}); $proxycheck = 1 if($ENV{'HTTP_VIA'}); $proxycheck = 1 if($ENV{'HTTP_CLIENT_IP'}); $proxycheck = 1 if($ENV{'HTTP_X_FORWARDED_FOR'}); $proxycheck = 1 if($ENV{'HTTP_FORWARDED'}); $proxycheck = 1 if($ENV{'HTTP_USER_AGENT'}=~/via/i); if( $proxycheck == 1 ) { $proxycheck2 = 1; foreach $temp2 (@proxylist) { $proxycheck2 = 0 if($remote_host=~/$temp2/i); } if( $proxycheck2 == 1 ) { &proxy_error; } } } } #----------------------------------------------------------------- # HTMLヘッダ部の出力 #----------------------------------------------------------------- sub html_header { $header_title = $_[0]; print "Content-type: text/html\n\n"; print "\n"; print "\n"; print "$header_title\n"; print "\n\n"; print "\n\n"; print "$header_title
\n"; print "
\n\n"; }