#!/usr/local/bin/perl
#[↑必要に応じて編集してください]
use strict;

#
# [  プレーン掲示板 　　　                 ]
# [    originarry written by YYY Perl Lab  ]
# [              arranged by kei           ]
# [                                        ]
#
#================================================================#
# 設置の際にやること…
# (0)必要に応じてこのファイルを編集。必須設定項目は☆で示してあります
# (1)".htaccess"というファイルを編集してCGIを使えるようにする。.htaccessのパーミッションは644
# (2)掲示板本体(このファイル)をアップ
# (3)掲示板のパーミッションを755に変更
# (4)掲示板と同じディレクトリに"dat"というディレクトリを作る
# (5)"dat"のパーミッションを777に変更
# (6)必要に応じて"img"ディレクトリを作り、中に画像を入れる
# 
# 
# 携帯からアクセス時のURLは、
# http://..[このCGIの名前].cgi?type=m
# になります。

#================================================================#
# 以下の設定をお願いします。書き換えるのは''の中だけです。
# 必須項目は * で示してあります
#================================================================#

#========== [表示系の設定]==========#

# 掲示板タイトル
$main::title     = '* BBS';

# 掲示板タイトルの色(スタイルシートです)
$main::title_col = '#fc0';
#その他の色は，下でスタイルシートを編集してください

# 新しい記事の表示。画像指定には<img>タグを使って下さい
$main::newstr    = '<font color="red">[New!]</font>';

# 携帯から書き込んだときの画像
$main::mface     = 'img/m.gif';

# * 「サイトトップへ」のリンク(PC用)
$main::top_url   = '<a href="../">[サイトトップへ]</a>';

# * 「サイトトップへ」のリンク(携帯用)
$main::top_url_m   = '<a href="../">[戻る]</a>';

# メールアドレス欄を 1:表示する 0:表示しない
$main::mail_show = '1';

# IP・ユーザー情報を 0:表示しない 1:コメントに表示 2:本文に表示
$main::IP_show = '1';

#========== [管理系の設定]==========#

# * 管理人の連絡先... 書き込みエラーに際に表示されます。
# アドレスを書く場合は、上のコメントを外してください
# $main::mailto: = '<a href="mailto:"></a>';
$main::mailto = '管理人';
;

# * 携帯からの操作を許可するか 0:全て可能 1:書き込み不可 2:不可
$main::mflag = 1; 

# メールアドレスは 0:無くても書けるしない 1:必須
$main::mail_w = '0';

# タイトルは 0:無題も可 1:必須
$main::title_w = '0';

# タグを許可 0:しない 1:する
$main::tags = '0';

# 本文中のアドレスを自動リンク 0:しない 1:する
$main::link = '1';

# 投稿の最大文字数
# (0:内容 1:名前 2:題名 3:E-Mail 4:URL 5:削除キー)
@main::max_length = (2000, 50, 100, 100, ,100, 10);

# 禁止文字列(カンマ区切り)
# (0:内容 1:名前 2:題名)
@main::ng_word = ('', '', '');

# E-Mailの正規表現
$main::regex_email = '';

# URLの正規表現
$main::regex_url   = '';

# 一ページ表示記事数(PC)
$main::mom_max = 12;

# 一ページ表示記事数(携帯)
$main::i_mom_max = 3;

# 最大保存記事数
$main::max_log = 100;

# * 管理用パスワード(任意の記事を削除できます)
$main::admin = 'xyzzy';

# * 暗号化パスワード(任意の数字を入れてください)
$main::crypt_key = '876975';


#========== [アクセス制限の設定]==========#

# 同一ホストからの連続投稿制限
#- チェックする時間(秒)
$main::interval   = 300;  
#- $interval 秒以内での最大投稿回数
$main::max_regist = 3;

# アクセス制限
#- Proxy制限（ 0:OFF 1:閲覧のみ 2:ON ）
$main::proxy_limit = 0;

#- 無条件許可ホスト名
@main::allow_host  = ( '0.0.0.0'          );

#- 投稿禁止ホスト名
@main::deny_host1  = ( '0.0.0.0' );

#- アクセス禁止ホスト名
@main::deny_host2  = ( '0.0.0.0' );


#========== [ファイル関連の設定]==========#

# 掲示板データファイルの名前
$main::dat_file  = 'dat/simple.dat';  

# 掲示板本体ファイルの名前
$main::cgi_file  = './';


# 掲示板ロックファイルの名前
$main::lock_file = 'dat/lock';

# 掲示板「顔」アイコンの場所(無くてもいいです)
$main::face_dir  = './img2';

#================================================================#
# 　　　　スタイルシート
#================================================================#

$main::style = <<"_END_";

body{
  font-family:gothic;
  font-size:10pt;
  margin:10pt 30pt;
  scrollbar-base-color: #fc0;
  scrollbar-track-color: #fff;

}

a:link {  color: #3c3;}
a:hover {color: #6f6;}
a:visited {color: #1b1;}
a:visited:hover { color: #6f6;}
a:active { color: #fa0;}

a.footer:link {  color: #aad;}
a.footer:hover {color: #ccf;}
a.footer:visited {color: #aad;}
a.footer:visited:hover {color: #ccf;}
a.footer:active {  color: #ccf;}


h2{
  font-size :18pt;
  color:#000;
  background-color:${main::title_col};
  border-style:solid;
  border-color:#666;
  border-width:0pt 3pt 2pt 0pt;
  margin:10pt 5pt;
  padding:5pt 20pt;  
}

h3{
  font-size :12pt;
  font-weight:bolder;
  color:#000;
  background-color:#fc0;
  border-style:solid;
  border-color:#f60;
  border-width:2pt 0pt 2pt;
  margin:5pt 30pt 3pt 10pt ;
  padding:0pt 30pt;  
}

table.mom{
  max-width:760px;
  position:center;
  width:95%;
  border-color:#aaa;
  border-style:solid;
  border-width:2px;
  background-color:#transparent;
  margin:10px ;
}  

td{
  margin:3px;
}

td.id{
  font-size:9pt;
  width:10%;
  background-color:#eef;
  text-align:center;
  color:#093;
}

td.id1{
  font-size:9pt;
  width:10%;
  background-color:#fdd;
  text-align:center;
  color:#a00;
}


td.title{
  width:40%;
  background-color:#fff;
  text-align:left;
  font-weight:600;
  padding:2px 10px;
  color:#00c;
}

td.title1{
  width:40%;
  background-color:#fff;
  text-align:left;
  font-weight:600;
  padding:2px 10px;
  color:#a00;
}

span.black{
  font-weight:100;
  font-size:9pt;
  color:#000;
  margin:0px;
}

form.del{
  font-weight:100;
  font-size:9pt;
  text-align:right;
  color:#000;
  margin:0px;

}

td.name{
  width:20%;
  background-color:#fff;
  text-align:left;
  font-weight:600;
  padding:0px ;
  color:#00c;
}

td.name1{
  width:20%;
  background-color:#fff;
  text-align:left;
  font-weight:600;
  padding:0px ;
  color:#f00;
}


td.date{
  width:30%;
  background-color:#fff;
  text-align:left;
  font-size:8pt;
  padding:0px 10px;
  color:#00c;
}

td.date1{
  width:30%;
  background-color:#fff;
  text-align:left;
  font-size:8pt;
  padding:0px 10px;
  color:#a00;
}

td.url{
  width:100%;
  background-color:#ddd;
  text-align:left;
  font-size:9pt;
  padding:0px 100px;
  color:#00c;
}

td.wtext{
  width:100%;
  background-color:#fff;
  text-align:left;
  padding:5px 10px;
  color:#000;
}

td.spacer{
  width:10%;
  background-color:transparent;
  text-align:center;
  font-size:9pt;
  padding:0px 10px;
  color:#ddd;
}

td.cut{
  width:100%;
  background-color:#eee;
  text-align:center;
  color:#006;
}

div.footer {
  max-width:800px;
  position:center;
  width:95%;
  font-size:9pt;
  text-align:right;
  color:#888;
  margin:2pt 10%;

}

div.form{
  max-width:800px;
  width:95%;
  text-align:left;
  position:left;
  border-color:#aaa;
  border-style:double;
  background-color:#ccc;
  border-width:5px;
  margin:10px;
}

div{
  max-width:800px;
  position:center;
  width:100%;
}

div.color0{background-color:#ccf;}
div.color1{background-color:#cfc;}
div.color2{background-color:#fcc;}
div.color3{background-color:#cff;}
div.color4{background-color:#ffa;}
div.color5{background-color:#fcf;}

h4.form{
  font-size:11pt;
  font-weight:600;
  padding :1pt, 20pt;
  background-color:#ddd;
  color:#00a;
}

form{
  position:center;
  max-width:800px;
  width:100%;
  margin:0px;
  font-weight:bolder;
}

div.navi{
  align:center;
  width:100%;
  margin:10px ;
}


table.navi{
  align:center;
  position:center;
  max-width:800px;
  width:100%;
  background-color:#ddb;
  border-color:#aaa;
  font-size:11pt;
  border-style:none;
  border-width:2px;
  margin:0px ;
}  

table.navith{
  position:center;
  max-width:800px;
  width:100%;
  font-size:11pt;
  background-color:#aaa;
  border-color:#aaa;
  border-style:none;
  border-width:0px;

  margin:0px ;

}  

td.navi_l{
  width:25%;
  background-color:#eee;
  text-align:center;
  color:#006;
}
td.navi_m{
  width:50%;
  background-color:#eee;
  text-align:center;
  color:#006;
}
td.navi_r{
  width:25%;
  background-color:#eee;
  text-align:center;
  color:#006;
}

div.back{
  padding:2px 20px;
  font-size:11pt;
}

span.gray{
  font-size:8pt;
  color:#bbb;
}
span.red{
  font-weight:bolder;
  color:#f00;
}
div.error{
  font-size:12pt;
  font-color:#000;
  background-color:#ddd;
  border-style:double;
  border-color:#ccc;
  border-width:5px;
  margin:10pt 10pt;
  padding:10pt 20pt;  
}
hr{
  color:#aaf;
  margin:3pt 5pt;
}
_END_


#================================================================#
# 　　　　設定はここまでです。以下はスクリプトです。
#================================================================#


#----- Formのハッシュキー
@main::key_regist = ( 'name', 'email', 'wtext', 'title', 'url',
       'delkey', 'face', 'priority', 'momid', 'thsize');

#----- 保存するハッシュキー
@main::key_log  = ( 'id', 'name', 'email', 'wtext', 'title', 'url',
     'delkey', 'face', 'priority', 'momid', 'time', 'host', 'agent', 'thsize' );
# thsize : スレッドの大きさ(1〜) レスの場合は0 

#----- 保存するクッキー
@main::key_cookie  = ( 'name', 'email', 'wtext', 'lastview', 'url','delkey', 'face', 'title');
@main::key_delete  = ( 'id', 'delkey');
@main::key_show = ('type', 'mode', 'id', 'page');

#require "jcode.pl";

#------------------------------------------
#  ログファイルクラス
#------------------------------------------
{ package Log;

  #----- グローバル変数
  @Log::log;
  $Log::max_id;
  
  sub get_lock { 
    my( $made_time, $i) ;

    foreach $i ( 1..5 ) {
      if( mkdir( $main::lock_file, 0777 ) ) {
        last ;
      } elsif( $i == 1 ) {
        $made_time = ( stat( $main::lock_file ) )[ 9 ] ;
        if( $made_time < time() - 120 ) {
          free_lock() ;
        }
      } elsif( $i < 8 ) {
        sleep( 2 ) ;
      } else {
        Error::fatal( 'アクセスが集中しています。一度戻って、再試行して下#さい');
      }
    }
    # 強制終了
    $SIG{'PIPE'}=$SIG{'INT'}=$SIG{'HUP'}=$SIG{'QUIT'}=$SIG{'TERM'}='sigexit';
  }

  sub sigexit {
    free_lock() ;
    exit( 0 ) ;
  }

  sub free_lock {
    rmdir( $main::lock_file ) ;
  }

  #=====< 投稿 >=====#
  sub regist {
    my %DATA  = %{$_[0]};
    my(@tmp, $mom, $momid, $thsize, $i, $X);
    # idを決める
    $DATA{'id'} = $Log::max_id++;
    # ログに追加
    unshift( @Log::log, \%DATA );
    # 切り詰め
    if($#Log::log > $main::max_log){
      @Log::log = @Log::log[ 0 .. $main::max_log - 1 ];
    }
    # 書き込み
    save();
  }


  #=====< 書き込み >=====#
  sub save {
    my $log;
    if( !open( DB, "> $main::dat_file" ) ) { Error::fatal( "データファイルに書き込めません" ); }
    print DB "$Log::max_id\n";
    foreach $log ( @Log::log ) {

      my @temp;
      foreach( @main::key_log ) { push( @temp, $$log{$_} ); }
      print DB join( "<>", @temp ) . "\n";
    }
    print DB "\n";
    close( DB );
    chmod 0666, $main::dat_file;
  }


  #=====< 読み込み >=====#
  sub load {
    my ($cur, $logx);
    if( !(-f  $main::dat_file)){
      if( !open( DB, "> $main::dat_file" ) ) { Error::fatal( "データファイルを作れません" ); }
      print DB "0";
      close DB;
      chmod 0666, $main::dat_file;
    }
    if( !open( DB,  $main::dat_file ) ) { Error::fatal( "データファイルを読み込めません" ); }
    my @temp = <DB>;
    close( DB );

    $cur = 0;
    $Log::max_id = $temp[$cur];
    chomp($Log::max_id);
    if($Log::max_id eq ''){$Log::max_id = 20;}

    #----- ハッシュ化
    while(++$cur <= 0+$#temp){
      $logx = $temp[$cur];
      my %hash;
      my $i = 0;
      chomp( $logx );
      unless( $logx ) { next; }
      foreach( split( /<>/, $logx ) ) {
	  $hash{$main::key_log[$i++]} = $_;
      }
      push( @Log::log, \%hash );
    }
  }

  #=====< ログを返す >=====#
  sub log {
    #ページ単位でログを返す。引数はページ。
    my( $page , $type ) = @_;
    my ($mom_max, $X);
    if ($type eq 'm'){
      $mom_max = $main::i_mom_max;
    } else {
      $mom_max = $main::mom_max;
    }

    #----- 表示記事数まで切り詰め
    #ただし、カウントするのは親記事だけ。
    my $flag = 1;
    my $start = $page * $mom_max;
    my $end   = ( $page + 1 ) * $mom_max - 1;
    if( $page < 0 || $end < $start ) { return 2; }
    my $cnt = -1;
    my (@temp, $i, $mom, $size);
    #----- ログを返す
    for($i = 0; $i <= $#Log::log; $i++){
      $X = $Log::log[$i];
      if($i < $start){next;}
      if($i > $end){$flag = 0; last;}
      push (@temp, $Log::log[$i]);
    }
    return ( $flag, \@temp );
  }

  sub find_id {
    #ID検索
    my( $target_id ) = @_;
    my($i, $X);
    for($i = 0; $i <= $#Log::log; $i ++){
      $X = $Log::log[$i];
      if($$X{'id'} == $target_id ) { return $i; }
    }
    Error::no_mom();
  }
  sub find_id {
    #ID検索
    my( $target_id ) = @_;
    my($i, $X);
    for($i = 0; $i <= $#Log::log; $i ++){
      $X = $Log::log[$i];
      if($$X{'id'} == $target_id ) { return $i; }
    }
    Error::no_mom();
  }

  sub IP_to_date {
    #IP検索
    my( $IP ) = @_;
    my($i, $X, @ret);
    for($i = 0; $i <= $#Log::log; $i ++){
      $X = $Log::log[$i];
      if($$X{'host'} eq $IP ) {
	push(@ret, $$X{'time'});
      }
    }
    return @ret;
  }


  #=====< 記事を削除 >=====#
  sub delete {
    # 記事を抜くだけ。
    # チェックは前もってしておく。
    my( $index ) = @_;
    # ログから削除
    splice(@Log::log, $index, 1);
    # 書き込み
    save();
  }
}


#------------------------------------------
#  投稿チェッククラス
#------------------------------------------
{ package Check;

  #=====< 内容チェック >=====#
  sub wtext {
    my( $value ) = @_;
    my $result = check( $value, $main::max_length[0], "<BR>", 1, $main::ng_word[0] );
    if( $result == 1 ) { Error::regist( "本文を入力して下さい" ); }
    if( $result == 2 ) { Error::regist( "投稿文が長すぎます（最大 $main::max_length[0] 文字）" ); }
    if( $result == 3 ) { Error::regist( "$main::ng_word[0] を含む文は投稿できません" ); }
    if($main::link == 1){
      auto_link($value);
    }
  }


  #=====< 名前チェック >=====#
  sub name {
    my( $value ) = @_;
    my $result = check( $value, $main::max_length[1], "<BR>", 1, $main::ng_word[1] );
    if( $result == 1 ) { Error::regist( "名前がありません" ); }
    if( $result == 2 ) { Error::regist( "名前が長すぎます（最大 $main::max_length[1] 文字）" ); }
    if( $result == 3 ) { Error::regist( "$main::ng_word[1] を含む名前では投稿できません" ); }
  }

  #=====< 題名チェック >=====#
  sub title {
    my( $value , $type) = @_; # $type = 0:返信・1:親
    my $result = check( $value, $main::max_length[2], "", $main::title_w, $main::ng_word[2] );
    if( $result == 1 ) { Error::regist( "題名がありません" ); }
    if( $result == 2 ) { Error::regist( "題名が長すぎます（最大 $main::max_length[2] 文字）" ); }
    if( $result == 3 ) { Error::regist( "$main::ng_word[2] を含む題名は投稿できません" ); }
  }

  #=====< E-Mailチェック >=====#
  sub email {
    my( $value ) = @_;
    my $result = check( $value, $main::max_length[3], "", 0, $main::title_w, $main::regex_email );
    if( $result == 1 ) { Error::regist( "E-Mailを記入して下さい" ); }
    if( $result == 2 ) { Error::regist( "E-Mailが長すぎます（最大 $main::max_length[3] 文字）" ); }
    if( $result == 4 ) { Error::regist( "E-Mailの形式が正しくありません" ); }
  }


  #=====< URLチェック >=====#
  sub url {
    my( $value ) = @_;
    my $result = check( $value, $main::max_length[4], "", 0, 0, $main::regex_url );
    if( $result == 2 ) { Error::regist( "URLが長すぎます（最大 $main::max_length[3] 文字）" ); }
    if( $result == 4 ) { Error::regist( "URLの形式が正しくありません" ); }
  }

  #=====< delkeyチェック >=====#
  sub delkey {
    my( $value ) = @_;
    my $result = check( $value, $main::max_length[5], "", 1, 0);
    if( $result == 1 ) { Error::regist( "削除キーがありません" ); }
    if( $result == 2 ) { Error::regist( "削除キーが長すぎます（最大 $main::max_length[5] 文字）" ); }
    $$value = crypt( $$value, $main::crypt_key);
  }
  
  #=====< 内容チェック >=====#
  sub check {
    #-----------------------------------------------------
    # $value      : チェックする値
    # $max_length : 最大文字数
    # $ret_code   : 改行コードの変換
    # $is_Empty   : 空白の処理（0:OFF 1:ON）
    # $ng_word    : 禁止ワード
    # $regex      : 正規表現（マッチしなかったらエラー）
    #-----------------------------------------------------

    my( $value, $max_length, $ret_code, $is_empty, $ng_word, $regex ) = @_;

    #----- 空白チェック
    if( $is_empty == 1 && !$$value ) { return 1; }

    #----- 長さチェック
    if( length( $$value ) > $max_length ) { return 2; }

    #----- 禁止ワードチェック
    foreach( split( /,/, $ng_word ) ) {
      if( index( $$value, $_ ) > -1 ) { return 3; }
    }

    #----- 正規表現チェック
    if( $regex && $$value =~ /$regex/i ) { return 4; }

    #----- 汚染文字の除去
    $$value =~ s/\0//g;
    $$value =~ s/&/&amp;/g;
    $$value =~ s/"/&quot;/g;
    if($main::tags == 0){
      $$value =~ s/</&lt;/g;
      $$value =~ s/>/&gt;/g;
    }
    #----- 改行コード変換
    $$value =~ s/\r\n/$ret_code/g;
    $$value =~ s/\r/$ret_code/g;
    $$value =~ s/\n/$ret_code/g;

    return 0;
  }

  sub auto_link {
    my $value = $_[0];
    $$value =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\" target=\"_blank\">$1\:$2<\/a>/ig;
  }

  #=====< 連続投稿のチェック >=====#
  sub continuous_regist {
    my( $host ) = @_;
    my $count = 0;
    my(@times) = Log::IP_to_date($host);
    foreach(@times){
      if($_ + $main::interval > time()){
        $count ++;
      }
    }
    if($count >= $main::max_regist){
      Error::regist( "$main::interval秒以内の連続投稿は$main::max_regist回までに制限されています" );
    }
  }

}

#------------------------------------------
#  フォーム取得
#------------------------------------------
{ package Form;

  #=====< Declare >=====#
  %Form::FORM;

  #=====< 複数データをハッシュで取得 >=====#
  sub hash {
    my( @key ) = @_;
    my %hash;
    foreach( @key ) { $hash{$_} = $Form::FORM{$_}; }
    return \%hash;
  }

  #=====< フォーム要素に直接アクセスする >=====#
  sub data {
    return $Form::FORM{$_[0]};
  }


  #=====< Prse PostData >=====#
  sub parse_form {
    if( $main::ENV{'REQUEST_METHOD'} eq "POST" ) {
      parse_post();
    } else {
      parse_get();
    }
  }


  #=====< Parse Post Form >=====#
  sub parse_post {
    read( STDIN, my $query, $main::ENV{'CONTENT_LENGTH'} );
    my $x;
    foreach $x ( split( /&/, $query ) ) {
      my( $name, $value ) = split( /=/, $x );
      $value =~ tr/+/ /;
      $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack( "C", hex( $1 ) )/eg;
#      jcode::convert( \$value, "sjis" );
      $Form::FORM{$name} = $value;
    }
  }


  #=====< Parse GET Form >=====#
  sub parse_get {
    my( $self ) = @_;
    my $x;
    foreach $x ( split( /&/, $main::ENV{'QUERY_STRING'} ) ) {
      my( $name, $value ) = split( /=/, $x );
      $value =~ tr/+/ /;
      $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack( "C", hex( $1 ) )/eg;
#      jcode::convert( \$value, "sjis" );
      $Form::FORM{$name} = $value;
    }
  }
}




#------------------------------------------
#  環境変数処理クラス
#------------------------------------------
{ package ENV;

  #=====< ユーザー情報(Hostname UserAgent)を返す >=====#
  sub user_info {
    my $agent = $main::ENV{"HTTP_USER_AGENT"};
    if( length( $agent ) > 200 ) { $agent = substr( $agent, 0, 200 ); }
    return( $main::ENV{"REMOTE_ADDR"}, $agent );

  }


  #=====< Refererを調べる >=====#
  sub referer {
    my $url = "http://" . $main::ENV{'HTTP_HOST'} . $main::ENV{'SCRIPT_NAME'};

    if( index( $main::ENV{"HTTP_REFERER"}, $url ) > -1 ) {
      return 0;
    } else {
      return substr( $main::ENV{"HTTP_REFERER"}, 0, 100 );
    }
  }

  #=====< Proxy変数を調べる >=====#
  sub proxy {

    #----- 変数をチェック
    my $flag = 0;
    $flag ||= $main::ENV{"HTTP_CACHE_CONTROL"};
    $flag ||= $main::ENV{"HTTP_PROXY_CONNECTION"};
    $flag ||= $main::ENV{"HTTP_VIA"};
    $flag ||= $main::ENV{"HTTP_X_FORWARDED_FOR"};
    $flag ||= $main::ENV{"HTTP_FORWARDED"};

    #----- ホスト名のチェック
    my $proxy_regex = "proxy|via|cache|squid|dns|server|www";
    $flag ||= ( $main::ENV{"REMOTE_ADDR"} =~ /$proxy_regex/i );
    $flag ||= ( $main::ENV{"HTTP_USER_AGENT"} =~ /$proxy_regex/i );

    if( $flag ) { return 1; }
    else       { return 0; }
  }


  #=====< アクセス制限 >=====#
  sub access_limit {
    my($type) = @_;
    if($type eq 'm'){
      return $main::mflag;
    }
    #----- 許可　拒否ホスト
    if( grep( index( $main::ENV{"REMOTE_ADDR"}, $_ ) > -1, @main::allow_host ) ) { return 0; }
    if( grep( index( $main::ENV{"REMOTE_ADDR"}, $_ ) > -1, @main::deny_host1 ) ) { return 1; }
    if( grep( index( $main::ENV{"REMOTE_ADDR"}, $_ ) > -1, @main::deny_host2 ) ) { return 2; }

    #----- Proxy制限
    if( proxy() == 1 ) {
      if( $main::proxy_limit == 1 ) { return 1; }
      if( $main::proxy_limit == 2 ) { return 2; }
    }
    return 0;
  }

}
#------------------------------------------
#  エラー処理クラス
#------------------------------------------
{ package Error;
  #----- エラーメッセージ用バッファー
  @Error::buffer;

  #=====< 致命的エラー >=====#
  sub fatal {
    my( $message ) = @_;

    #----- Errorが起こったらそのままexit
    HTML::error( $message );
    my $action = Form::data("action");
    if($action){
      Log::free_lock(); 
    }
    exit;
  }


  #=====< 環境変数エラー >=====#
  sub env {
    my( $message ) = @_;
    push( @Error::buffer, "環境変数エラー : " . $message );
  }

  #=====< 親記事が無いエラー >=====#
  sub no_mom {
    my( $message ) = @_;
    HTML::error("IDエラー". $message );
    my $action = Form::data("action");
    if($action){
      Log::free_lock(); 
    }
    exit;
  }

  #=====< 投稿エラー >=====#
  sub regist {
    my( $message ) = @_;
    push( @Error::buffer, "投稿エラー : " . $message );
  }


  #=====< アクセスエラー >=====#
  sub access {
    my( $message ) = @_;
    HTML::error( "アクセス制限 : " . $message );
    exit;
  }


  #=====< 削除エラー >=====#
  sub delete {
    my( $message ) = @_;
    HTML::error( "削除エラー : " . $message );
    Log::free_lock(); 
    exit;
  }


  #=====< バッファーにエラーがあったら表示して終了する >=====#
  sub is_error {
    if( @Error::buffer ) {
	my $action = Form::data("action");
	if($action){
	    Log::free_lock(); 
	  }
	HTML::error( join( "<BR>\n", @Error::buffer ) );
	exit;
    }
  }
}



#------------------------------------------
#  HTML表示クラス
#------------------------------------------
{ package HTML;

  #=====< Header >=====#
  sub header {
    my ($type, $mode) = @_;
    if($type eq 'm'){
      print <<"_END_";
Content-type: text/html

<html>
<head>
<title> $main::title </title>
</head>

<body>
<font color="blue">$main::title</font><br>
<hr>
$main::top_url_m <br>
_END_
    if($main::mflag == 0){
	print"<a href=\"#btm\" name=\"top\">［↓新規書込］</a><br>";
    }



    } else {
      print <<"_END_";
Content-type: text/html

<html>
<head>
<style type="text/css">
$main::style
</style>
<meta http-equiv="content-type" content="text/html; charset=shift_jis">
<title> $main::title </title>
</head>

<body>
<div class="back" align="center">
$main::top_url
　　<a href="$main::cgi_file">[\表\示更新]</a>
</div>
<h2>$main::title</h2>
_END_

    }
  }

  #=====< Footer >=====#
  sub footer {
    my $type = $_[0];
    if($type eq 'm'){

      print <<"_END_";
</body>
</html>
_END_

    } else {
      print <<"_END_";
<hr>
<div class="footer">
* by <a href="http://www.sodan.ecc.u-tokyo.ac.jp/~kei/" class="footer" target="_top">Kei</a>,
May 1, 2003. 
Thanx2<a href="http://yyycgi.s16.xrea.com/" class="footer" target="_top">Π</a> *
</div>
</body>
</html>
_END_

    }
  }

  #=====< Post Form >=====#
  sub form {
    my($type, $is_mom, $momid) = @_;
    my($title_str, $mail_str);
    if($type eq 'm'){
      if($main::mail_w == 1){
        $mail_str ='mail<font color="red">必須</font>';
      } else {
        $mail_str ='mail';
      }
      if($main::title_w == 1){
        $mail_str = 'title<font color="red">必須</font>';
      } else {
        $mail_str = 'title';
      }
      print  <<"_END_";
<font color="blue">◆新規書き込み◆</font><br>
<a href="#top" name="btm">[↑トップへ]</a><br>
<form action="./simple.cgi" method="get">
<input type="hidden" name="action" value="regist">
<input type="hidden" name="type" value="m">
Name<input type=text name="name" size=3 maxlength=30 >
$mail_str <input type=text name="email" size=3 maxlength=40><br>
$title_str <input type=text name="title" size=10 maxlength=80><br>
<textarea name="wtext" rows=2 ></textarea><br>
削除キー<input type=password name="delkey" size=3>
<input type="hidden" name="thsize" value="1">
<input type="hidden" name="face" value="$main::mface">
<input type=submit value="\書\込"><br>
_END_

  } else {
    if($main::mail_w == 1){
      $mail_str ='メール<span class="red">必須</span>';
    } else {
      $mail_str ='メール';
    }
    if($main::title_w == 1){
      $title_str = '題名<span class="red">(必須)</span>';
    } else {
      $title_str = '題名';
    }
    print <<"_END_";
<div class="form"><h4 class="form">◆新規書込はこちらから◆</h4>
<form action="$main::cgi_file" method="post">
<input type="hidden" name="action" value="regist">
<table class="form">
<tr>
  <td class="fname">名前:<input type=text name="name" size=20 maxlength=30 value=$Cookie::COOKIE{'name'}>
  </td>
  <td class="fmail">$mail_str:<input type=text name="email" size=20 maxlength=40 value=$Cookie::COOKIE{'email'}>
  </td>
</tr>
<tr>
 <td class="furl" colspan="2">URL :<input type=text name="url" size=60 maxlength=80 value=$Cookie::COOKIE{'url'}></td>
</tr>
<tr>
 <td class="ftitle" colspan="2">$title_str:<input type=text name="title"   size=60 maxlength=80 value=$Cookie::COOKIE{'title'}></td>
</tr>
<tr>
 <td class="fwtext" colspan="2"><textarea name="wtext" rows=8 cols=60>$Cookie::COOKIE{'wtext'}</textarea></td>
</tr>
<tr>
 <td class="fwtext" colspan="2">
_END_
    my @face_list;
    if (opendir(DIR, $main::face_dir)) {
      @face_list = readdir(DIR);
      closedir(DIR);
      print "<input type=\"radio\" name=\"face\" value=\"\" checked>(なし)";
    } 
    my $file;
    foreach $file (@face_list){
      if ($file =~ /(.*)\.(.*)/) {
          $_ = $2;
          if(m/jpeg|jpg|gif|png/i){
              $file = $main::face_dir . "/".$file;
              print "<input type=\"radio\" name=\"face\" value=\"$file\">";
              print "<img src=\"$file\" height=\"50px\" width=\"50px\" >　　";
          }
      }
    }

    print <<"_END_";
 </td>
</tr>
 <tr>
  <td class="fdelkey">削除キー:<input type=password name="delkey" size=10 maxlength="10"  value="$Cookie::COOKIE{'delkey'}" style="ime-mode: disabled;"></td>
  <td class="fpriority">
<input type="hidden" name="thsize" value="1">
<input type=submit value="書込"></td>
</td>
</tr>
</table>
</form>
</div>
<br>    
_END_
    }
  }


  #=====< Mom-article >=====#
  sub mom {
    my($type, $data_, $lastview, $cl) = @_;
    my $date_str;
    my %DATA = %$data_;
    if( $DATA{'email'} && $main::mail_show ) {
      $DATA{'name'} = "<a href=\"mailto:$DATA{'email'}\">$DATA{'name'}</a>";
    }
    if($type eq 'm'){
      $date_str = Date::toStr($DATA{"time"},1);
      print <<"_END_";
<font color="red">●$DATA{"title"}</font><br>
by $DATA{"name"}<br>
$date_str<br>
<font color="green">
$DATA{"wtext"}
</font>
<form action="$main::cgi_file" method="get">
<input type="hidden" name="mode" value="m">
<input type="hidden" name="action" value="delete">
<input type="password" name="delkey" size="2">
<input type="hidden" name="id" value="$DATA{"id"}">
<input type="submit" value="削除">
</form>
<hr>
_END_

    } else {
      $date_str = Date::toStr($DATA{'time'},0);
      print <<"_END_";
<div class="color$cl" align="center">
<table class="mom" align="center">
<tr>
 <td class="id">
_END_
      if($lastview < $DATA{'time'}){
        print $main::newstr;
      } else {
        print "[$DATA{'id'}]";
      }
      print <<"_END_";
 </td>
 <td class="title"><span class="black">題名 : </span>$DATA{"title"}</td>
 <td class="name"><span class="black">名前 : </span>$DATA{"name"}</td>
 <td class="date">$date_str</td>
</tr>
_END_

    if( $DATA{'url'} ) {
      if($DATA{'url'} < 40){
      print <<"_END_";
<tr>
 <td class="url" colspan="4"><a href="$DATA{'url'}">$DATA{'url'}</a></td>
</tr>
_END_
      } else {
      my $url_str = substr($DATA{'url'},0,40);
      print <<"_END_";
<tr>
 <td class="url" colspan="4"><a href="$DATA{'url'}">$url_str...</a></td>
</tr>
_END_
      }
    }
    if( -f $DATA{'face'}){
       print <<"_END_";
<tr><td class="spacer"><img src="$DATA{'face'}" height="50px" width="50px"></td>
<td colspan="3" class="wtext">$DATA{'wtext'}
_END_
    } else {
       print <<"_END_";
<tr><td class="face"></td>
<td colspan="3" class="wtext">$DATA{'wtext'}
<form action="$main::cgi_file" method="post" class="del">
_END_
    }
    if($main::IP_show == 1){
      print "<!-- $DATA{'name'}さんのIP:$DATA{'host'}・Agent:$DATA{'agent'} -->";
    } elsif ($main::IP_show == 2){
      print "<br><span class=\"gray\">IP:$DATA{'host'}・Agent:$DATA{'agent'}
      </span>";
    }
    print <<"_END_";


<input type="hidden" name="action" value="delete">
    記事を削除
    <input type="password" name="delkey" size="8"  value="$Cookie::COOKIE{'delkey'}" style="ime-mode: disabled;">
    <input type="hidden" name="id" value="$DATA{"id"}">
    <input type="submit" value="削除">
</form>
  </td>
</tr>
</table>
</div>
<br>
_END_

    }
  }

  #=====< 記事が無い >=====#
  sub no_article {
    print "記事がありません";
  }

  #=====< 案内リンク >=====#
  sub navi {
    my($type, $mode, $id, $end_flag, $page ) = @_;
    my($back, $next, $html);
    $back = $page - 1;
    $next = $page + 1;
    if($type eq 'm'){
      if( $page > 0 ) {
	print <<"_END_";
<a href="$main::cgi_file?page=$back&type=m&mode=$mode&id=$id">［←戻］</a>
_END_
      } else {
        print "　　　　";
      }
      if( $end_flag == 0 ) {
        print <<"_END_";
<a href="$main::cgi_file?page=$next&type=m&mode=$mode&id=$id">［次→］</a><br>
_END_
      } else {
        print "<br>";
      }
    } else {
      if( $page > 0 ) {
        print << "_END_";
<table class="navi"><tr>
<td class="navi_l"><a href="$main::cgi_file?page=$back&mode=$mode&id=$id">【←戻る】</a></td>
_END_
      } else {
	print <<"_END_";
<table class="navi"><tr>
<td class="navi_l">　　　　</td>
_END_
      }
      print <<"_END_";
<td class="navi_m">　　　　</td>
_END_
      if( $end_flag == 0 ) {
        print <<"_END_";
<td class="navi_r"><a href="$main::cgi_file?page=$next&mode=$mode&id=$id">【次へ→】</a></td>
</tr></table></div><br>
_END_
      } else {
        print <<"_END_";
<td class="navi_r">　</td>
</tr></table></div><br>
_END_
      }
    }
  }

  #=====< Error >=====#
  sub error {
    my( $error ) = @_;
    Cookie::save();
    
print <<"_END_";
Content-type: text/html

<html>
<head>
<title>$main::title</title>

<meta http-equiv="content-type" content="text/html; charset=shift_jis">
</head>
<body>
<h2>エラー</h2>
<div class="error">
メッセージ:$error
<hr>
エラーです。入力項目を確認して下さい。<br />
心当たりの無いエラーの場合は、$main::mailtoまでご連絡下さい。
</div>

</body>
</html>
_END_
  }
}


#==========================================
#  BBSクラス
#==========================================
{ package BBS;

  #**===< 記事の削除 >===**#
  sub delete {
    my %DATA = %{$_[0]};
    my $index = Log::find_id(Form::data("id"));
    my $X = $Log::log[$index];
    if(($main::admin ne "" )&& ($main::admin eq $DATA{'delkey'})){
      Log::delete($index);
    } else {
      my %temp = %$X;
      if($temp{"delkey"} eq crypt($DATA{'delkey'}, $main::crypt_key)){
        Log::delete($index);
      } else {
        Error::delete( "削除キーが間違ってます" );
      }
      Error::is_error();
    }
  }
  #**===< 掲示板に投稿する >===**#
  sub regist {
    my %DATA = %{$_[0]};
    #----- フォーム要素(日付・IP)を%DATAに追加
    $DATA{"time"} = time();
    ( $DATA{"host"}, $DATA{"agent"} ) = ENV::user_info();

    #----- ENVチェック
#    if( ENV::referer() ) { Error::env( "掲示板以外からの投稿はできません" ); }
    if(( $main::ENV{'REQUEST_METHOD'}) eq ("GET" && $DATA{'type'} ne 'm')) {
      Error::env( "この掲示板には投稿はできません。" );
    }

    Check::continuous_regist( $DATA{"host"} );

    #----- 投稿内容のチェック
    Check::name ( \$DATA{"name"}  );
    Check::title( \$DATA{"title"} , $DATA{"thsize"});
    Check::wtext( \$DATA{"wtext"} );
    Check::email( \$DATA{"email"} );
    Check::url  ( \$DATA{"url"}   );
    Check::delkey(\$DATA{"delkey"}   );

    #----- エラーがあったら表示して終了
    Error::is_error();
    #----- 書き込み
    Log::regist( \%DATA );
  }


  #=====< 掲示板を表示する >=====#
  sub show {
    my( %DATA ) = %{$_[0]};
    my $lastview = $_[1];
    my($mom, $size, $momid, $flag, $log_, $th_max, $mom_max, $i, $X);

    my $page = $DATA{'page'};
    if($page eq ''){$page = 0;}
    my $type = $DATA{'type'};
    my $mode = $DATA{'mode'};
    my $id =  $DATA{'id'};

    ( $flag, $log_ ) = Log::log( $page,  $type);

    my @log = @$log_;
    if ($type eq 'm'){
      $mom_max = $main::i_mom_max;
    } else {
      $mom_max = $main::mom_max;
    }

    HTML::header($type, $mode);
    if( $flag == 2 ) {
       HTML::no_article($type);
    } else {
       HTML::navi($type, $mode, '', $flag, $page);
       my $cl = rand(6);
       for($i=0;$i<= $#log; $i++){
	 HTML::mom($type, $log[$i], $lastview, ($cl + $i) % 6);
       }
      HTML::navi($type, $mode, '', $flag, $page);
    }
    
    if(($type ne 'm')||($main::mflag == 0)){
      HTML::form($type, 'mom', 0);#親記事である・momid
    }
    HTML::footer($type);
  }
}

#------------------------------------------
#  Dateクラス
#------------------------------------------
{ package Date;
  #=====< 日付を取得 >=====#
  sub toStr {
    my $m_time = $_[0];
    my $mode = $_[1];#0: 長い  

    #----- localtime の取得(秒単位)
    my( $sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst ) = localtime( $m_time );
    $wday = ( '日', '月', '火', '水', '木', '金', '土' )[$wday];
    if($mode == 0){
      return sprintf( "%04d %d/%d (%s) %02d:%02d", $year + 1900, $mon+1, $mday, $wday, $hour, $min );
    } else {
      return sprintf( "%d/%d %s %02d:%02d", $mon+1, $mday, $wday, $hour, $min );
    }
  }
}


#------------------------------------------
#  Cookieクラス
#------------------------------------------
{ package Cookie;
  %Cookie::COOKIE;
  
  sub clear {
    my $tmp = "";
    foreach (@main::cookie_keys){
      $tmp .= "Set-Cookie: ";
      $tmp .= "$_=; ";
      $tmp .= " expires=Thu, 1-Jan-1980 00:00:00 GMT;\n";
    }
    print $tmp;
  }

  sub get {
    my($name) = @_;
    return $Cookie::COOKIE{$name};
  }

  sub hash_set {
    my %temp = %{$_[0]};
    my $name;
    foreach $name (keys( %temp )){
      $Cookie::COOKIE{$name} = $temp{$name};
    }
  }

  sub set {
    my ($name, $value) = @_;
    $Cookie::COOKIE{$name} = $value;
  }

  sub load {
    my ($xx,$name,$value);
    foreach $xx (split(/; */, $main::ENV{'HTTP_COOKIE'})) {
      my ($name, $value) = split(/=/, $xx);
      $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
      $Cookie::COOKIE{$name} = $value;
    }
  }

  sub save {
    my ($tmp, $key, $val);
    $tmp = "";
    foreach $key (@main::key_cookie){
      $val = $Cookie::COOKIE{$key};
      $val =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
      $tmp .= "Set-Cookie: ";
      $tmp .= "$key=$val; ";
      $tmp .= "expires=Thu, 1-Jan-2030 00:00:00 GMT;\n";
    }
    print $tmp;
  }
}

#------------------------------------------
#  Mainクラス
#------------------------------------------
{ package main;

  #----- フォーム取り出し
  Form::parse_form();
  my $action = Form::data("action");
  my $type = Form::data("type");

  Cookie::load();
  my $lastview = $Cookie::COOKIE{'lastview'};
  Cookie::set('lastview', time()); 

  #----- アクセス制限
  my $limit = ENV::access_limit();
  if( $limit == 1 && $action ) {
    Error::access( "このホストからは投稿できません。"); 
  }
  if( $limit == 2) {
    Error::access( "この掲示板は表示できません。" ); 
  }

  #----- 掲示板操作
  if( $action eq "regist" ) { 
    Log::get_lock();
    Log::load();
    Cookie::hash_set(Form::hash( @main::key_cookie ));
    BBS::regist(Form::hash( @main::key_regist ) ); 
    Log::free_lock();
    Cookie::set('wtext', ''); 
    Cookie::set('title', ''); 
  } elsif( $action eq "delete" ) {
    Log::get_lock();
    Log::load();
    BBS::delete(Form::hash( @main::key_delete ));
    Log::free_lock();
  } else {
    Log::load();
  }

  Cookie::save();
  #----- 掲示板の表示
  BBS::show( Form::hash( @main::key_show ) , $lastview);
}