#! /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';           # 本スクリプトのバージョン

$bg_col      = '#e0e0e0';       # 背景色
$title_col   = '#000080';       # タイトルの色
$text_col    = '#000000';       # テキストの色
$link_col    = '#0000ff';       # リンクの色
$alink_col   = '#ff0000';       # リンク中の色
$vlink_col   = '#800080';       # 既リンクの色
#----------------------------------------------------------
$indexname   = '戻る';          # domain.cgiからの戻り先
$index       = 'ssboard.cgi';   # domain.cgiからの戻り先(URL)

#----------------------------------------------------------
# 管理用パスワード
#   当然のことですが、できるだけ類推できにくいものを設定し
#   てください。できれば８文字より長いものにしましょう
#     ・ssboard.cgiと別のパスワードでも構いません
#     ・同じパスワードの方が便利かな？
#----------------------------------------------------------
$user_pass = '1234';


#----------------------------------------------------------
# CERN系のサーバーなどで、ファイル関係でエラーが出る場合、
# 以下に設置するディレクトリのサーバー内でのフルパスを指定
# してみると、正常に動作することがあるかもしれません ^^;;
#
# 最後は / で終わること。
#     例：$path = '/home/user/foo/public_html/cgi-bin/bbs/';
#----------------------------------------------------------
$path = "";

#----------------------------------------------------------
# ファイル入出力時にファイルロックを行う設定。これにより、
# 同時アクセス時の問題が多少マシになる(?)
# サーバーが flock()関数を使える設定の場合のみ利用できる。
#     0:ファイルロックを行わない
#     1:flock()でファイルロックを行う
#----------------------------------------------------------
$lockmode = 0;

#----------------------------------------------------------
# 利用制限を行うドメインのリストファイル名
#     ・最初はサイズ０の空ファイル
#     ・パーミッションを666に設定すること
#----------------------------------------------------------
$domainlist = "domain.lst";

#----------------------------------------------------------
# 日本語コード変換ライブラリの指定
#----------------------------------------------------------
require "$path"."jcode.pl";


#=====================================================================
#  これより、処理の開始
#=====================================================================

&form;          # フォーム入力されたデータの解析と格納

#-----------------------------------------------------
# フォームから渡されてきた引数の解析
#-----------------------------------------------------

if ( $FORM{'task'} eq 'add_domain' ) {
    &add_domain;
}
elsif ( $FORM{'task'} eq 'add_domain2' ) {
    &add_domain2;
}
elsif ( $FORM{'task'} eq 'edt_domain' ) {
    &edt_domain;
}
elsif ( $FORM{'task'} eq 'edt_domain2' ) {
    &edt_domain2;
}
elsif ( $FORM{'task'} eq 'del_domain' ) {
    &del_domain;
}
elsif ( $FORM{'task'} eq 'del_domain2' ) {
    &del_domain2;
}
else {
    &main;
}
exit;

#=====================================================================
#  処理はここまで（以下は、サブルーチン）
#=====================================================================


#-----------------------------------------------------
# ドメイン管理機能（メイン画面）
#-----------------------------------------------------
sub main {

    &html_header("SSBoard：ドメインの管理");

    print "<BLOCKQUOTE>\n";
    print "SSBoardの利用制限を行うドメイン名の管理を行います<BR>\n";
    print "これにより、特定のドメイン名のユーザーの書き込みを禁止したり、あるいは表\示も禁止したりする事が出来ます。\n";

    print "<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<SELECT NAME=\"task\">\n";
    print "    <OPTION VALUE=\"-\"> 実行する機能\の選択　　　　</OPTION>\n";
    print "    <OPTION VALUE=\"-\"> ------------</OPTION>\n";
    print "    <OPTION VALUE=\"add_domain\"> ドメインの追加</OPTION>\n";
    print "    <OPTION VALUE=\"edt_domain\"> ドメインの編集</OPTION>\n";
    print "    <OPTION VALUE=\"del_domain\"> ドメインの削除</OPTION>\n";
    print "</SELECT>\n";
    print "<INPUT TYPE=\"submit\" VALUE=\"　実行　\">\n";
    print "</FORM>\n";
    print "</BLOCKQUOTE>\n<HR><CENTER><A HREF=\"$index\">$indexname</A></CENTER><HR>\n";

    print "</BODY>\n";
    print "</HTML>\n";
    
}


#-----------------------------------------------------
# ドメイン管理（ドメインの追加）
#-----------------------------------------------------
sub add_domain {

    &html_header("SSBoard：ドメインの追加");

    print "<BLOCKQUOTE>\n";
    print "SSBoardの利用制限を行うドメイン名の追加を行います<BR><BR>\n";

    print "<TABLE BORDER=0>";
    print "<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"hidden\" NAME=\"task\" VALUE=\"add_domain2\">\n";
    print "<TR>\n";
    print "    <TD>ドメイン名</TD>\n";
    print "    <TD><INPUT TYPE=\"text\" NAME=\"domain\" SIZE=\"30\"></TD>\n";
    print "</TR>\n";
    print "<TR>\n";
    print "    <TD>制限内容</TD>\n";
    print "    <TD><INPUT TYPE=\"radio\" NAME=\"level\" VALUE=\"0\" CHECKED>書込禁止　　　　";
    print "<INPUT TYPE=\"radio\" NAME=\"level\" VALUE=\"1\">表\示・書込禁止</TD>\n";
    print "</TR>\n";
    print "<TR>\n";
    print "    <TD>パスワード</TD>\n";
    print "    <TD><INPUT TYPE=\"password\" NAME=\"pwd\" SIZE=\"10\"> <INPUT TYPE=\"submit\" VALUE=\"　実行　\">\n</TD>\n";
    print "</TR>\n</FORM>\n</TABLE>\n";
    print "</BLOCKQUOTE>\n<HR>\n";

    print "</BODY>\n</HTML>\n";
    exit;
}


#-----------------------------------------------------
# ドメイン管理（ドメインの追加）
#-----------------------------------------------------
sub add_domain2 {

    if ( $FORM{'pwd'} ne $user_pass ) {
        &error("パスワードが間違っています。");
    }
    if ( $FORM{'domain'} eq "" ) {
        &error("ドメイン名が記入されていません。")
    }
    if ( $FORM{'level'} eq "" ) {
        &error("制限内容が選択されていません。")
    }

    #---------------------------------------
    # ドメインリストファイルの読み込み
    #---------------------------------------
    &read_domainlist;

    foreach $line (@lines) {
        push ( @new, $line );
    }
    push ( @new, "$FORM{domain},$FORM{'level'},\n" );

    #---------------------------------------
    # ドメインリストファイルへ書き込み
    #---------------------------------------
    &write_domainlist;

    &html_header("SSBoard：ドメインの追加");

    print "<BLOCKQUOTE>\n";
    print "ドメインの追加が完了しました。\n";
    print "</BLOCKQUOTE>\n\n";
    print "<DIV ALIGN=\"center\">\n<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"submit\" VALUE=\"　ＯＫ　\">\n";
    print "<HR>\n</HTML>\n</BODY>\n";
    exit;

}


#-----------------------------------------------------
# ドメイン制限の設定変更
#-----------------------------------------------------
sub edt_domain {

    #---------------------------------------
    # ドメインリストファイルの読み込み
    #---------------------------------------
    &read_domainlist;

    &html_header("SSBoard：ドメイン制限の編集");

    $i = 0;
    print "<BLOCKQUOTE>\n";

    print "<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"hidden\" NAME=\"task\" VALUE=\"edt_domain2\">\n";
    print "0:書込のみ禁止　　　";
    print "1:表\示・書込を禁止\n";
    print "<TABLE BORDER=1>\n";
    print "    <TR>\n";
    print "        <TH COLSPAN=2>設定</TH>\n";
    print "        <TH ROWSPAN=2>ドメイン名</TH>\n";
    print "    </TR>\n";
    print "    <TR>\n";
    print "        <TH>0</TH>\n";
    print "        <TH>1</TH>\n";
    print "    </TR>\n";

    foreach $line (@lines) {
        ($domain,$level) = split(/\,/,$line);
        print "    <TR>\n";
        print "        <TD><INPUT TYPE=\"radio\" NAME=\"DOMAIN:$domain\" VALUE=\"0\"";
        if ( $level eq "0" ) {
            print " CHECKED";
        }
        print "></TD>\n";
        print "        <TD><INPUT TYPE=\"radio\" NAME=\"DOMAIN:$domain\" VALUE=\"1\"";
        if ( $level eq "1" ) {
            print " CHECKED";
        }
        print "></TD>\n";
        print "        <TD>&nbsp;$domain&nbsp;</TD>\n";
        print "    </TR>\n";
        $i++;
    }
    if ( $i eq 0 ) {
        print "<TR><TD COLSPAN=3>ドメインは登録されていません。</TD></TR>\n";
        print "</TABLE>\n";
    }
    else {
        print "</TABLE>\n";
        print "<BR><INPUT TYPE=\"submit\" VALUE=\"　変更　\"> <INPUT TYPE=\"password\" NAME=\"pwd\" SIZE=10> 管理用マスターキー\n";
    }
    print "</BLOCKQUOTE>\n";
    print "<HR>\n</HTML>\n</BODY>\n";
    exit;
}


#-----------------------------------------------------
# ドメイン制限の設定変更
#-----------------------------------------------------
sub edt_domain2 {

    if ( $FORM{'pwd'} ne $user_pass ) {
        &error("パスワードが間違っています。");
    }

    #---------------------------------------
    # ドメインリストファイルの読み込み
    #---------------------------------------
    &read_domainlist;

    foreach $line (@lines) {
        ($domain,$level) = split(/\,/,$line);
        push( @new, "$domain,$DOMAIN_LEVEL{$domain},\n" );
    }

    #---------------------------------------
    # ドメインリストファイルへ書き込み
    #---------------------------------------
    &write_domainlist;

    &html_header("SSBoard：ドメイン制限の編集");

    print "<BLOCKQUOTE>\n";
    print "ドメイン制限の設定変更が完了しました。\n";
    print "</BLOCKQUOTE>\n\n";
    print "<DIV ALIGN=\"center\">\n<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"submit\" VALUE=\"　ＯＫ　\">\n";
    print "<HR>\n</HTML>\n</BODY>\n";
    exit;
}


#-----------------------------------------------------
# 制限するドメインの削除（選択画面）
#-----------------------------------------------------
sub del_domain {

    #---------------------------------------
    # ドメインリストファイルの読み込み
    #---------------------------------------
    &read_domainlist;

    &html_header("SSBoard：制限するドメインの削除");

    $i = 0;
    print "<BLOCKQUOTE>\n";

    print "<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"hidden\" NAME=\"task\" VALUE=\"del_domain2\">\n";

    foreach $line (@lines) {
        ($domain,$level) = split(/\,/,$line);
        print "<INPUT TYPE=\"checkbox\" NAME=\"target\" VALUE=\"$domain\">　";
        print "$domain<BR>\n";
        $i++;
    }
    if ( $i eq 0 ) {
        print "ドメインは登録されていません。<BR>\n";
    }
    else {
        print "<BR><INPUT TYPE=\"submit\" VALUE=\"　削除　\"> <INPUT TYPE=\"password\" NAME=\"pwd\" SIZE=10> 管理用マスターキー\n";
    }
    print "</BLOCKQUOTE>\n";
    print "<HR>\n</HTML>\n</BODY>\n";
    exit;
}


#-----------------------------------------------------
# 制限するドメインの削除
#-----------------------------------------------------
sub del_domain2 {

    $temp = crypt( $FORM{'pwd'}, substr($user_pass,0,2) );
    if ( $temp ne $user_pass ) {
        &error("パスワードが間違っています。");
    }

    #---------------------------------------
    # ドメインリストファイルの読み込み
    #---------------------------------------
    &read_domainlist;

    $flag = 0;
    foreach $line (@lines) {
        ($domain,$level) = split(/\,/,$line);
        foreach $target (@RM) {
            if ( $domain eq $target ) {
                $flag = 1;
                last;
            }
        }
        push ( @new, $line ) if ( $flag == 0 );
    }

    #---------------------------------------
    # ドメインリストファイルへ書き込み
    #---------------------------------------
    &write_domainlist;

    &html_header("SSBoard：制限するドメインの削除");

    print "<BLOCKQUOTE>\n";
    print "指定されたドメインの削除が完了しました。\n";
    print "</BLOCKQUOTE>\n\n";
    print "<DIV ALIGN=\"center\">\n<FORM METHOD=\"post\" ACTION=\"domain.cgi\">\n";
    print "<INPUT TYPE=\"submit\" VALUE=\"　ＯＫ　\">\n";
    print "<HR>\n</HTML>\n</BODY>\n";
    exit;

}


#-----------------------------------------------------------------
# ドメインリストファイルの読み込み
#     ドメインリストファイルの内容を、配列 @lines に格納する
#-----------------------------------------------------------------
sub read_domainlist {

    $filename = "$path"."$domainlist";  # ログファイル名

    if (!open(DB,"$filename")) {
        &error('記録ファイルの入出力にエラーが発生しました。');
    }
    if( $lockmode == 1 ) {
        eval { flock( DB, 1 );};    # ファイルをロック
        if ( $@ ne "" ) {
            &error("flock()がサポートされていません。");
        }
    }
    @lines = <DB>;
    close(DB);

    if( $lockmode == 1 ) {
        flock( DB, 8 );     # ロック解除
    }
}



#-----------------------------------------------------------------
# ドメインリストファイルへの書き込み
#     ドメインリストファイルに、配列 @new を書き込む
#-----------------------------------------------------------------
sub write_domainlist {

    #---------------------------------------
    # ドメインリストファイルへ書き込み
    #---------------------------------------
    if (!open(DB,">$filename")) {
        &error('記録ファイルの入出力にエラーが発生しました。');
    }

    if( $lockmode == 1 ) {
        eval { flock( DB, 2 );};    # ファイルをロック
        if ( $@ ne "" ) {
            &error("flock()がサポートされていません。");
        }
    }
    print DB @new;
    close(DB);

    if( $lockmode == 1 ) {
        flock( DB, 8 );     # ロック解除
    }
}


#-----------------------------------------------------------------
# フォーム投稿されたデータを解析し、配列にリストする
#-----------------------------------------------------------------
sub form {

    #--------------------------------------------------
    #  フォーム入力されたデータを$bufferに格納
    #--------------------------------------------------
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }
    else {
        $buffer = $ENV{'QUERY_STRING'};
    }

    #--------------------------------------------------
    #  $bufferに格納されたFORM形式のデータを取り出す
    #--------------------------------------------------
    @pairs = split(/&/,$buffer);
    foreach $pair (@pairs) {

        ($name, $value) = split(/=/, $pair);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

        #--------------------------------------------------
        # タグは全面禁止
        #--------------------------------------------------
        $value =~ s/</&lt;/g;
        $value =~ s/>/&gt;/g;



        #--------------------------------------------------
        # 記録するデータの半角カナを全角カナに変換する
        # これを利用するには、jcode.plのv2.0以降を使うこと
        #--------------------------------------------------
        &jcode'h2z_sjis(*value);

        #--------------------------------------------------
        # 記録するデータはsjisに統一する
        #--------------------------------------------------
        &jcode'convert(*value,'sjis');

        #--------------------------------------------------
        # ドメイン制限のための処理
        #--------------------------------------------------
        if ( substr( $name, 0, 6 ) eq "DOMAIN" ) {
            ($temp,$domain) = split(/:/,$name);
            $DOMAIN_LEVEL{$domain} = $value;
        }

        #--------------------------------------------------
        # 削除するメッセージ番号のリストアップ
        #--------------------------------------------------
        if ($name eq "target") {
            push(@RM,$value);
        }

        $FORM{$name} = $value;
    }
}


#-----------------------------------------------------------------
# HTMLヘッダ部の出力
#-----------------------------------------------------------------
sub html_header {

    $header_title = $_[0];

    print "Content-type: text/html\n\n";
    print "<HTML>\n";
    print "<HEAD>\n";
    print "<TITLE>$header_title</TITLE>\n";
    print "</HEAD>\n\n";
    print "<BODY BGCOLOR=\"$bg_col\" TEXT=\"$text_col\" LINK=\"$link_col\" VLINK=\"$vlink_col\" ALINK=\"$alink_col\">\n\n";
    print "<FONT COLOR=$title_col SIZE=5>$header_title</FONT><BR>\n";
    print "<HR>\n\n";
}


#-----------------------------------------------------------------
# エラーメッセージの出力
#-----------------------------------------------------------------
sub error {

    $error_msg = $_[0];

    print "Content-type: text/html\n\n";
    print "<HTML>\n<HEAD>\n<TITLE>SSBoard：ドメインの管理</TITLE></HEAD>\n";
    print '<BODY BGCOLOR="#8899aa" TEXT="#000000" LINK="#ffff55" VLINK="#ffff55" ALINK="#FF0000">' . "\n";
    print "<H2>おしらせ</H2>\n";
    print "<I>$error_msg</I>\n";
    print "<P>\n</BODY>\n</HTML>\n";

    exit;
}