#!/usr/bin/perl -I../share $| = 1; # # RCS Infomation. # 削除変更禁止 ----------------------------------------------------------------------------------------- # $CGI{'RCS_ID'} = "$Id: chat.pl 3.5 2002/11/27 01:49:39 Administrator Exp Administrator $damy"; $CGI{'RCS_SOURCE'} = "$Source: D:/Users/Administrator/projects/works/salut/C-001_tkchat1-S/visit\\RCS/chat.pl $damy"; # ------------------------------------------------------------------------------------------------------ # $CGI{'ORG_ID'} = "tkschat1.pl 2.2 2002/05/05 19:35:15"; $CGI{'ORG_SOURCE'} = "D:/Users/Administrator/projects/works/salut/C-004_tkschat1/RCS/tkschat1.pl"; # ------------------------------------------------------------------------------------------------------ # # 以下，情報の変更・削除を禁じます --------------------------------------------------------------------- # # TKCHAT1 v2.0：チャット # Copyright(C) NTTPC Communications, Inc. 2001,2002,2003 # Programmed by Tomonori Kamitaki # # [注意事項] # スクリプト中の削除変更禁止やそれに関するコメントがあるコードは， # 著作権保護の為に一切の変更を認めません。 # # [利用規程および規約] # スクリプト配布元であるSalut!（サリュ）のホームページをご覧下さい。 # Salut!（サリュ）ホームページ => http://www.salut.ne.jp/ # # --------------------------------------------------------------------------------------------- ここまで # # 以下，情報の変更・削除を禁じます --------------------------------------------------------------------- # $CGI{'TITLE'} = "TKCHAT1"; $CGI{'COPYRIGHT'} = "Copyright(C) NTTPC Communications, Inc. 2001,2002,2003"; $CGI{'COPYRIGHT_URL'} = ""; $CGI{'VERSION'} = "Ver. 2.0"; $CGI{'REVISION'} = "Rev. $Revision: 3.5 $damy"; $CGI{'PROG_BY'} = "Tomonori Kamitaki"; $CGI{'PROG_MAIL'} = ""; $CGI{'INFOMATION'} = "TKCHAT1 by Salut! Web Master's Heaven"; $CGI{'INFOMATION_URL'} = "http://www.salut.ne.jp/"; $CGI{'SUPPORT_MAIL'} = ""; $CGI{'COOKIE_AUTHOR'} = "TKCHAT1"; # --------------------------------------------------------------------------------------------- ここまで # # 変数の設定 1（環境に応じて設定します）---------------------------------------------------------------- # # 文字エンコード指定：（ jis | sjis | euc ）から選択。（通常は，変更不要） # 文字コード変換へは，jcode.plを使用します。 $g_char_encoding = "sjis"; # ※省略時は，変換を省きます。 # ロックファイル保存用パス $g_lock_file = "../tmp/tkchat1.lok"; # ロックのタイプ（ lock_type : lockWithOpen = 0, lockWithSym = 1 ） $g_lock_type = 1; # ロックに高速リトライサイクルモードを使用する（ ON : = 1, OFF = 0 ） # このモードは，通常 [ ON = 1 ] でご使用下さい。 # このモードによって受ける恩威は，動作レスポンス向上とサーバでのプログラム常駐実時間の軽減です。 # 環境によって正しく動かない場合があります。その場合は，[ OFF = 0 ] にしてご使用下さい。 $g_lock_fast_cycle = 1; # ----------------------------------------------------------------------------------------- 変数の設定 1 # # 変数の設定 2（通常は変更不要：変更した場合の動作保証はありません）------------------------------------ # # tkchat1 の設定ファイル $g_usr{'config'} = "../share/global.cfg"; # 保存ログファイル名 $g_usr{'log_data'} = "../log/log.dat"; # 保存ログファイルのヘッダ $g_usr{'log_head'} = "../share/log_header.cfg"; # HTMLタグテンプレートファイル $g_usr{'html_after_leaving'} = "../share/tpl/after_leaving_tpl.html"; # 出口 $g_usr{'html_before_entrance'} = "../share/tpl/before_entrance_tpl.html"; # 入り口 $g_usr{'html_chat_view'} = "../share/tpl/chat_view_tpl.html"; # 発言の表示 $g_usr{'html_default'} = "../share/tpl/default_tpl.html"; # フレームセット $g_usr{'html_inside_chat'} = "../share/tpl/inside_chat_tpl.html"; # 発言入力フォーム $g_usr{'html_manual'} = "../share/tpl/manual_tpl.html"; # 使い方 $g_usr{'html_infomation'} = ""; # インフォメーション $g_usr{'html_error'} = "../share/tpl/error_tpl.html"; # エラーページ # ----------------------------------------------------------------------------------------- 変数の設定 2 # #ライブラリをロード require 'tk_util2.pl'; #グローバル変数 %g_in; $g_usr_pass; $g_usr_auth; # メイン処理 &main(); # メイン処理関数 sub main { my($error, %usr_cfg); # 入力内容を読み込み &tk_util2::parseInput(\%g_in, $g_char_encoding); # 設定ファイルの読込 if($error = &tk_util2::readDataFile($g_usr{'config'}, $tk_util2::k_config_a, \%usr_cfg)) { &error($error); } # 設定内容のチェック &usr_config_check(\%usr_cfg); $g_usr_pass = $usr_cfg{$usr_cfg{'id-0'}.'-USER_PASS'}; $g_usr_auth = $usr_cfg{$usr_cfg{'id-0'}.'-USER_AUTH'}; if($g_usr_auth) { $g_in{'USER_AUTH'} = 1; } else { $g_in{'USER_NONAUTH'} = 1; } # ファイルロックの開始 if($error = &lock_start($g_lock_file, $g_lock_type)) { &error($error, 0, 1); } # 処理の指定はあるかな？ if($g_in{'MODE'}) { # 処理関数のリファレンス・テーブル作成 %proc_mode = ( "DEFAULT" , \&mode_default, "ENTER" , \&mode_enter, "INPUT" , \&mode_input, "CHAT_VIEW" , \&mode_chat_view, "MANUAL" , \&mode_manual, "INFO" , \&mode_info ); # 指定された処理関数は，存在するかな？ if(exists $proc_mode{$g_in{'MODE'}}) { # あり # 処理関数へのリファレンスを取り出し $proc_ref = $proc_mode{$g_in{'MODE'}}; # 処理関数を実行 &$proc_ref(\%usr_cfg); } else { # 未定義処理：エラー表示を行う &error("プログラムは，未定義な処理内容をリクエストされました。
処理は続行不能\です。URLや入力フォーム等が間違っていないか確かめてから再度アクセスしてみて下さい。"); } } else { # 省略時の処理を実行 &mode_default(\%usr_cfg); } # ロックファイル終了 &lock_end($g_lock_file); } # デフォルトの処理（フレーム表示） sub mode_default { my($usr_cfg_ref) = @_; # 記事一覧を出力 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_default'}); } # 入り口の処理（フレーム上側） sub mode_enter { my($usr_cfg_ref) = @_; # 記事一覧を出力 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_before_entrance'}); } # 記事表示処理（フレーム下側） sub mode_chat_view { my($usr_cfg_ref) = @_; # パスワード入力チェック &usr_pass_check(); # 記事一覧を出力 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_chat_view'}); } # 新しい記事の書込処理 sub mode_input { my($usr_cfg_ref) = @_; my($error, %usr_log, %usr_cfg, %tpl_html, @p_index, %r_index); my($save_flag) = 1; my($html_file) = $g_usr{'html_inside_chat'}; # パスワード入力チェック &usr_pass_check(); # 入力フォームのチェック &input_form_check($usr_cfg_ref); # ログデータの読込 if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); } # プログラム依存コード ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- # if(exists $g_in{'ENTER_OR_LEAVE'}) { if($g_in{'ENTER_OR_LEAVE'}) { # 入室する $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_item_name'}} = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-name_item_name'}}.$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_item_name'}}; my($name) = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-name_item_name'}}; $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-name_item_name'}} = $g_in{'MASTER'}; # コメントの追加 &add_data_process(\%usr_log, $usr_cfg_ref); $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-name_item_name'}} = $name; } else { # 退室する：コメントの追加 &add_data_process(\%usr_log, $usr_cfg_ref); $html_file = $g_usr{'html_after_leaving'}; } } else { if(length($g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_item_name'}})) { # 入室済み：コメントの追加 &add_data_process(\%usr_log, $usr_cfg_ref); } else { # コメント無 $save_flag = 0; } } # 記事処理の為のインデックスを生成 &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index); # 最大記事登録数の制限チェック if(&check_max_log(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index)) { # 記事処理の為のインデックスを再生成 undef @p_index; undef %r_index; &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index); } # テンプレートHTMLの読込 if($error = &tk_util2::readDataFile($html_file, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # HTMLを表示 &show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index, 1); # 保存が必要？ if($save_flag) { # 必要：保存データのヘッダを読込み if($error = &tk_util2::readDataFile($g_usr{'log_head'}, $tk_util2::k_plain_txt, \@usr_log_head)) { &error($error); } # ログデータの保存 if($error = &tk_util2::saveDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, \@usr_log_head, "", "<>")) { &error($error); } } # ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- プログラム依存コード # } # 使い方ページ生成 sub mode_manual { my($usr_cfg_ref) = @_; # HTML処理 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_manual'}); } # インフォメーション・ページ生成 sub mode_info { my($usr_cfg_ref) = @_; # メッセージを表示 &error("インフォメーション・モードをリクエストされました。

インフォメーション・モードは，ユーザ自身でプログラムするモードです。
マニュアルページ以外で表\示させたい情報がある時に使用します。

この機能\は，サポート対象外ですが，CGIやPerl等の書籍，WWWページ情報などを参考にプログラムにチャレンジしてみるのも良いでしょう。

by ".$CGI{'PROG_BY'}."
"); } # ユーザー用パスワードのチェック sub usr_pass_check { if($g_usr_auth) { if(1) { # 暗号化対応のコード --------------------------------------------------------------------------- # # パスワードはあるか？ if(length($g_in{'USER_PASS'})) { # ある：パスワードは一致しているか？ if($g_in{'USER_PASS'} eq $g_usr_pass || &decrypt_data($g_usr_pass, $g_in{'USER_PASS'})) { # 一致 # 暗号化パスワードを作成する為にクリアテキストのパスワードを設定 $g_in{'USER_PASS'} = $g_usr_pass; # 暗号化パスワードを作成 &encrypt_data(\$g_in{'USER_PASS'}); } else { # 不一致：エラー処理 &error("パスワードが違います。"); } } else { # なし：エラー処理 &error("パスワードの入力がありません。"); } # --------------------------------------------------------------------------- 暗号化対応のコード # } else { # クリアテキスト -------------------------- # # パスワードはあるか？ if(length($g_in{USER_PASS})) { # ある：パスワードは一致しているか？ if($g_in{USER_PASS} eq $g_usr_pass) { # 一致：問題なし，処理を続行 return; } else { # 不一致：エラー処理 &error("パスワードが違います。"); } } else { # なし：エラー処理 &error("パスワードの入力がありません。"); } # -------------------------- クリアテキスト # } } } # 汎用ログ表示処理ルーチン sub general_purpose_log_view_process { my($usr_cfg_ref, $tpl_html_name) = @_; my($error, %usr_log, %tpl_html, @p_index, %r_index, %client_cookie); # ログデータの読込 if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); } # テンプレートHTMLの読込 if($error = &tk_util2::readDataFile($tpl_html_name, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # 記事処理の為のインデックスを生成 &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index); # 記事を表示 &show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index); } # 最大記事登録数の制限チェック sub check_max_log { my($usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref) = @_; my($oldest, $latest, $tmp, @del_index); # 最大ログ数以内であるか？ if($usr_log_ref->{'id-Nums'} <= $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-item_max"}) { # 最大ログ数以内です return 0; } else { # 最大ログ数を越えている：一番古い記事番号を取得 # とりあえずログの最初の記事番号を取得 $oldest = $usr_log_ref->{'id-0'}; # 一番古い記事番号を探す for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) { if($oldest > $usr_log_ref->{'id-'.$i}) { $oldest = $usr_log_ref->{'id-'.$i}; } } } # プログラム依存コード -------------------------------------------------------------------------------------------------------------- # # 記事番号を削除リストへ push(@del_index, $oldest); # 削除リストの記事を削除 &delete_data_process($usr_log_ref, \@del_index); # 変更通知を返す return 1; # -------------------------------------------------------------------------------------------------------------- プログラム依存コード # } # 入力フォームのチェック（名前，メール，タイトル，コメント，URL） sub input_form_check { my($config_ref) = @_; my($error); # プログラム依存コード ---------------------------------------------------------------------------------------------------------------------- # # 名前のチェック if(!(length($g_in{$config_ref->{$config_ref->{'id-0'}."-name_item_name"}}))) { # 不正：エラー表示文字を設定 $error .= "名前がありません。"."
"; } # コメントのチェック # if(!(length($g_in{$config_ref->{$config_ref->{'id-0'}."-comment_item_name"}}))) { # # 不正：エラー表示文字を設定 # $error .= "コメントがありません。"."
"; # } # ---------------------------------------------------------------------------------------------------------------------- プログラム依存コード # my($remote_host); # 環境変数[REMOTE_HOST]はセットされているか？ if(!$ENV{'REMOTE_HOST'}){ # なし：Socket読込 use Socket; # [REMOTE_ADDR]から[REMOTE_HOST]を取得 $remote_host = gethostbyaddr(inet_aton($ENV{'REMOTE_ADDR'}),AF_INET); } else { $remote_host = $ENV{'REMOTE_HOST'}; } # リモートホストのチェック if($config_ref->{$config_ref->{'id-0'}."-refusal_host"}) { # 拒否ホスト名を分解しながらリモートホストをチェック foreach (split(/,/, $config_ref->{$config_ref->{'id-0'}."-refusal_host"})) { $_ =~ s/\*/\.\*/g; # ホスト名(FQDN)は，拒否対象に該当するか？ if($remote_host =~ m/$_/) { # 該当する：エラー表示文字を設定 $error = "リモートホスト：".$remote_host."は，入室拒否リストに登録されています。"; # ループを抜ける last; } # ホスト名(IP)は，拒否対象に該当するか？ if($ENV{'REMOTE_ADDR'} =~ m/$_/) { # 該当する：エラー表示文字を設定 $error = "リモートホスト：".$ENV{'REMOTE_ADDR'}."は，入室拒否リストに登録されています。"; # ループを抜ける last; } } } # エラーはあったか？ if($error) { # ある：エラーを表示 &error("エラーが発生しました。詳細は以下の通りです。

".$error); } # 時間を取得 $g_in{$config_ref->{$config_ref->{'id-0'}."-date_item_name"}} = &get_time(); # リモートホストのホスト名もしくはIPアドレスを取得 if($remote_host) { # ホスト名を取得 $g_in{$config_ref->{$config_ref->{'id-0'}."-host_item_name"}} = $remote_host; } else { # IPアドレスを取得 $g_in{$config_ref->{$config_ref->{'id-0'}."-host_item_name"}} = $ENV{'REMOTE_ADDR'}; } } # 多重投稿のチェック sub multiplex_contribution_check { my($usr_log_ref, $usr_cfg_ref, $cookie_ref) = @_; my($error, $c_cm_num, $p_cm_num, $i, $j); # my($str); # カレントログ番号を取得 $c_cm_num = $usr_log_ref->{'id-'.($usr_log_ref->{'id-Nums'} - 1)}; # 前回のログ番号を取得 if($cookie_ref->{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_num_item_name'}}) { # クッキーの記事番号とカレントの記事番号は違うものであるか？ if($cookie_ref->{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_num_item_name'}} != $c_cm_num) { # 違う：クッキーから取得 $p_cm_num = $cookie_ref->{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_num_item_name'}}; } else { # 同じ：処理を中断（同じ記事番号であるという事は，削除された記事番号が再利用された場合に発生する事なので，多重投稿の対象にはならない） return; } # $str = "クッキー"; } else { # 直前のログから取得 $p_cm_num = $c_cm_num - 1; # $str = "直前ログ"; } # プログラム依存コード ---------------------------------------------------------------------------------------------------------------------------------- # # DATE COMMENT_NUM 以外のデータを比較 for($i = 0, $j = 0; $i < $usr_log_ref->{'csv-itName-nums'}; $i++) { # COMMENT_NUM, DATE は，比較対象から除外 if($usr_log_ref->{'csv-itName-'.$i} eq $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-date_item_name'}) { $j++; next; } if($usr_log_ref->{'csv-itName-'.$i} eq $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_num_item_name'}) { $j++; next; } # アイテム・データは同一であるか？ if($usr_log_ref->{$c_cm_num.'-'.$usr_log_ref->{'csv-itName-'.$i}} eq $usr_log_ref->{$p_cm_num.'-'.$usr_log_ref->{'csv-itName-'.$i}}) { # 同じです：一致エラー数をインクリメント $error++; # $str .= $usr_log_ref->{$c_cm_num.'-'.$usr_log_ref->{'csv-itName-'.$i}}." = ".$usr_log_ref->{$p_cm_num.'-'.$usr_log_ref->{'csv-itName-'.$i}}."
"; } } # ---------------------------------------------------------------------------------------------------------------------------------- プログラム依存コード # # 一致エラー数がデータ比較対照数と同じであったか？ if($error == ($usr_log_ref->{'csv-itName-nums'} - $j)) { # 同じです：エラー処理を実行 # プログラム依存コード ---------------------------- # &error("多重投稿です。"); # &error("多重投稿です。$str"); # ---------------------------- プログラム依存コード # } } # 記事表示 sub show_log_view { my($tpl_html_ref, $usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref, $mode_is_input) = @_; my($error, %cookie, $tmp, $i, $j); # 記事はあるのか？ if($usr_log_ref->{'id-Nums'}) { # ある：クッキーの取得 &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # モードは，入力なのか？ if($mode_is_input == 1) { # 多重投稿のチェック &multiplex_contribution_check($usr_log_ref, $usr_cfg_ref, \%cookie); # 記事番号をクッキーに保存 $cookie{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}} = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}}; } # tpl_htmlをセットアップ &setup_tpl_html($tpl_html_ref, $usr_cfg_ref, \%cookie, 0, 0, 0, 0); # クッキーを保存 &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # HTMLヘッダを出力 &out_html_header(); # メイン・ヘッダを出力 print $tpl_html_ref->{'MAIN_HEAD'}; # プログラム準依存コード ------------------------------------------------------------------------------------- # # 記事の処理ループ for(@$p_index_ref) { # 記事上側のデータ置換して出力 print &save_data_replace($tpl_html_ref->{'COMMENT_MAIN_HEAD'}, $tpl_html_ref, $usr_log_ref, \%cookie, $_); # 記事下側のデータ置換して出力 print &save_data_replace($tpl_html_ref->{'COMMENT_MAIN_FOOT'}, $tpl_html_ref, $usr_log_ref, \%cookie, $_); } # ------------------------------------------------------------------------------------- プログラム準依存コード # } else { # tpl_htmlをセットアップ &setup_tpl_html($tpl_html_ref, $usr_cfg_ref, $cookie_ref, 0, 0, 0, 0); # HTMLヘッダを出力 &out_html_header(); # メイン・ヘッダを出力 print $tpl_html_ref->{'MAIN_HEAD'}; } # メイン・フッタを出力 print $tpl_html_ref->{'MAIN_FOOT'}; } sub save_data_replace { my($ret, $tpl_html_ref, $save_data_ref, $cookie_ref, $key) = @_; # データ判別型特別置換文字列（ ==%%keyword::propaty%%== ）の処理 $ret =~ s/==%%(SAVE)::(.+?)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$save_data_ref->{$key.'-'.$2}, $cookie_ref)/geo; # 単純データ置換え文字列（ __%%keyword::propaty%%__ ）の処理 $ret =~ s/__%%SAVE::(.+?)%%__/$save_data_ref->{$key.'-'.$1}/go; # `結果を返す return $ret; } # ==%%keyword::propaty%%== の置換文字列の処理 sub special_replace { my($key, $pty, $tpl_html_str, $data_str_ref, $cookie_ref) = @_; # 定義されているのか？ if($$data_str_ref && !($$data_str_ref eq $cookie_ref->{'default-'.$pty})) { # なんらかの定義があれば置換する $tpl_html_str =~ s/__%%($key)::($pty)%%__/$$data_str_ref/go; # 処理結果を返す return $tpl_html_str; } else { # 何もしない（つまり空白） return; } } # 記事のインデックスを生成 sub get_usr_log_index { # プログラム依存コード --------------------------------------------------------------------------------------------------------------------------------------- # my($usr_log_ref, $usr_cfg_ref, $p_index_ref, $r_index_ref) = @_; my($i, $j, @p_index); for($i = 0, $j = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) { # 記事インデックスに追加 $p_index[$j++] = $usr_log_ref->{'id-'.$i}; } # 記事を降順にソート @{$p_index_ref} = sort {$b <=> $a} @p_index; # ----------------------------------------------------------------------------------------------------------------------------- プログラム依存コード：ここまで # } # tpl_html の初期化（tpl_html中の[ save ]以外のkeywordに対する置換処理） sub setup_tpl_html { my($tpl_html_ref, $usr_cfg_ref, $cookie_ref, $page_num, $cm_start, $cm_end, $p_index_num) = @_; my($error, $prev, $next, $hash_key, $chk1, $chk2, $i); # ページ処理を実行するか？ if($page_num) { # ページ処理用前処理 # 前ページはあるか？ if($cm_start > 0) { # 前ページあり $prev = $page_num - 1; } else { # 前ページなし $prev = 0; } # 次ページはあるか？ if($cm_end < $p_index_num) { # 次ページあり $next = $page_num + 1; } else { # 次ページなし $next = 0; } } # ハッシュ・キーを取り出す foreach $hash_key (sort keys %$tpl_html_ref) { # プログラム依存コード ---------------------------------------------------------- # # 削除変更禁止 ------------------------------------------------------------------ # $chk1 += $tpl_html_ref->{$hash_key} =~ s/__%%CGI::(INFOMATION)%%__/$CGI{$1}/go; # ------------------------------------------------------------------ 削除変更禁止 # # 削除変更禁止 ------------------------------------------------------------------ # $chk2 += $tpl_html_ref->{$hash_key} =~ s/__%%CGI::(INFOMATION_URL)%%__/$CGI{$1}/go; # ------------------------------------------------------------------ 削除変更禁止 # # 削除変更禁止 ------------------------------------------------------------------ # $tpl_html_ref->{$hash_key} =~ s/__%%CGI::(.+?)%%__/$CGI{$1}/go; # ------------------------------------------------------------------ 削除変更禁止 # # ------------------------------------------------ プログラム依存コード：ここまで # # 動作環境非依存のセーフコード --------------------------------------------------------------------------------------------------------------------------- # # ページ処理データ置換え文字列の処理 for($i = 0; $i < $usr_cfg_ref->{'id-Nums'}; $i++) { # 次ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::NEXT_PAGE%%== ）の処理 $tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(NEXT_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$next)/goe; # 前ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::PREV_PAGE%%== ）の処理 $tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(PREV_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$prev)/goe; } # 単純データ置換え文字列（ __%%keyword::propaty%%__ ）の処理 for($i = 0; $i < $usr_cfg_ref->{'id-Nums'}; $i++) { # 単純データ置換え文字列（ __%%$usr_cfg_ref->{'id-'.$i}::propaty%%__ ）の処理 $tpl_html_ref->{$hash_key} =~ s/__%%($usr_cfg_ref->{'id-'.$i})::(.+?)%%__/$usr_cfg_ref->{$1.'-'.$2}/go; } # ----------------------------------------------------------------------------------------------------------------------------------------------- ここまで # # 環境によって動きが違うので，上記のコードにした (^^; ---------------------------------------------------------------------------------------------------- # # # # 単純データ置換え文字列（ __%%keyword::propaty%%__ ）の処理 # for($i = 0; $i < $usr_cfg_ref->{'id-Nums'}; $i++) { # # 次ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::NEXT_PAGE%%== ）の処理 # $tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(NEXT_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$next)/goe; # # 前ページのデータ判別型特別置換文字列（ ==%%$usr_cfg_ref->{'id-'.$i}::PREV_PAGE%%== ）の処理 # $tpl_html_ref->{$hash_key} =~ s/==%%($usr_cfg_ref->{'id-'.$i})::(PREV_PAGE)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, \$prev)/goe; # # 単純データ置換え文字列（ __%%$usr_cfg_ref->{'id-'.$i}::propaty%%__ ）の処理 # $tpl_html_ref->{$hash_key} =~ s/__%%($usr_cfg_ref->{'id-'.$i})::(.+?)%%__/$usr_cfg_ref->{$1.'-'.$2}/go; # } # # ----------------------------------------------------------------------------------------------------------------------------------------------- ここまで # # データ判別型特別置換文字列（ ==%%G_IN::PROPERTY%%== ）の処理 $tpl_html_ref->{$hash_key} =~ s/==%%(G_IN)::(.+?)%%==/&special_replace($1, $2, $tpl_html_ref->{$2}, $g_in{$2})/ge; # 単純データ置換え文字列（ __%%g_in::propaty%%__ ）の処理 $tpl_html_ref->{$hash_key} =~ s/__%%G_IN::(.+?)%%__/$g_in{$1}/go; # クッキー処理 $tpl_html_ref->{$hash_key} =~ s/__%%CLIENT_COOKIE::(.+?)%%__/&cookie_proc($cookie_ref, $1)/geo; } # プログラム依存コード ------------------------------------------------------------------------------------------------------ # # 削除変更禁止 -------------------------------------------------------------------------------------------------------------- # if(!($chk1)) { # 駄目 $error .= " [ __%%CGI::INFOMATION%%__ ]"; } # -------------------------------------------------------------------------------------------------------------- 削除変更禁止 # # 削除変更禁止 -------------------------------------------------------------------------------------------------------------- # if(!($chk2)) { # 駄目 $error .= " [ __%%CGI::INFOMATION_URL%%__ ]"; } # -------------------------------------------------------------------------------------------------------------- 削除変更禁止 # # 削除変更禁止 -------------------------------------------------------------------------------------------------------------- # if(length($error)) { # 駄目 &error("置換え文字列 $error が足りません。$chk1, $chk2"); } # -------------------------------------------------------------------------------------------------------------- 削除変更禁止 # # 削除変更禁止 -------------------------------------------------------------------------------------------------------------- # if(!($chk1 == $chk2)) { # 駄目 &error("置換え文字列 [ __%%CGI::INFOMATION%%__ ] [ __%%CGI::INFOMATION_URL%%__ ] の数が合いません。ERR = $chk1, $chk2", 1); } # -------------------------------------------------------------------------------------------------------------- 削除変更禁止 # # -------------------------------------------------------------------------------------------- プログラム依存コード：ここまで # } # クッキー処理 sub cookie_proc { my($cookie_ref, $propaty) = @_; my($p_name, $p_value); # プロパティをプロパティ名とプロパティ値に分解 ($p_name, $p_value) = split(/=/, $propaty); # 暗号化前の入力フォームの中に対応するプロパティはあるか？ if(exists $g_in{'src-'.$p_name}) { # ある：フォームからプロパティをセット $cookie_ref->{$p_name} = $g_in{'src-'.$p_name}; # 入力されたフォームの中に対応するプロパティはあるか？ } elsif(exists $g_in{$p_name}) { # ある：フォームからプロパティをセット $cookie_ref->{$p_name} = $g_in{$p_name}; } else { # ない：プロパティに対するクライアントのクッキーはあるか？ if(exists $cookie_ref->{$p_name}) { # ある： } else { # ない：デフォルトの設定値は，あるのか？ if(length($p_value)) { # ある：デフォルト値をセット $cookie_ref->{$p_name} = $p_value; } else { # ない：空白をセット $cookie_ref->{$p_name} = ""; } } } # デフォルト値があれば値を保存（入力フォームとの比較の為） if($p_value) { $cookie_ref->{'default-'.$p_name} = $p_value; } # 値を返す return $cookie_ref->{$p_name}; } # クッキーを取得 sub get_cookie { my($cookie_author, $cookie_ref) = @_; my($c_author, $c_str); my($c_it_name, $c_it_value); # クッキーを取得して分解 for(split(/;/, $ENV{'HTTP_COOKIE'})) { ($c_author, $c_str) = split(/=/, $_); $c_author =~ s/\s//g; if($c_author eq $cookie_author) { last; } } # クッキー中身を分解して値をセット for(split(/,/, $c_str)) { ($c_it_name, $c_it_value) = split(/<>/, $_); $cookie_ref->{$c_it_name} = $c_it_value; } } # クッキーを発行 sub set_cookie { my($coockie_author, $cookie_ref) = @_; my($cookie_str, $key, $secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg, $ydayg, $isdstg, @mong, @weekg, $date_gmt); # クッキーは国際時間をキーとし、保存日数は60日間 ($secg, $ming, $hourg, $mdayg, $mong, $yearg, $wdayg, $ydayg, $isdstg) = gmtime(time + 60 * 24 * 60 * 60); # 曜日と週を配列で定義 @mong = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); @weekg = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'); # 60日後の国際時間を指定フォーマット化 $date_gmt = sprintf("%s, %02d\-%s\-%04d %02d\:%02d\:%02d GMT", $weekg[$wdayg], $mdayg, $mong[$mong], $yearg+1900, $hourg, $ming, $secg); # 保存するクッキー情報を生成 foreach $key (sort keys %$cookie_ref) { # デフォルト値をスキップ if($key =~ /default-(.+?)/) { next; } # クッキー文字列へ追加 $cookie_str .= "$key"."<>"."$cookie_ref->{$key}".","; } # 不要な最後の[,]を削除 chop($cookie_str); # クッキーの標準フォーマットに整えます。 print "Set-Cookie: $coockie_author=$cookie_str; expires=$date_gmt\n"; } # 設定内容のチェック sub usr_config_check { my($config_ref) = @_; # 最大記事登録数のチェック if(!($config_ref->{$config_ref->{'id-0'}."-item_max"})) { # デフォルト設定：30件 $config_ref->{$config_ref->{'id-0'}."-item_max"} = 30; } elsif($config_ref->{$config_ref->{'id-0'}."-item_max"} > 100) { # 最大件数：100件 $config_ref->{$config_ref->{'id-0'}."-item_max"} = 100; } # ページタイトルのチェック if(!($config_ref->{$config_ref->{'id-0'}."-TITLE"})) { # デフォルト設定：$CGI{'TITLE'} $config_ref->{$config_ref->{'id-0'}."-TITLE"} = $CGI{'TITLE'}; } # 戻る為のリンク先のチェック if(!($config_ref->{$config_ref->{'id-0'}."-RETURN_URL"})) { # デフォルト設定：HTTP_REFERER $config_ref->{$config_ref->{'id-0'}."-RETURN_URL"} = $ENV{'HTTP_REFERER'}; } # 戻る為のリンク先のタイトル／名前のチェック if(!($config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"})) { # 戻る為のリンク先は設定されているのか？ if($config_ref->{$config_ref->{'id-0'}."-RETURN_URL"}) { # デフォルト：戻る $config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"} = "戻る"; } else { # デフォルト：無し $config_ref->{$config_ref->{'id-0'}."-RETURN_URL_TITLE"} = ""; } } # 記事番号のデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"})) { # デフォルト設定：COMMENT_NUM $config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"} = "COMMENT_NUM"; } # プログラム依存処理コード ------------------------------------------------------- # # 日時のデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-date_item_name"})) { # デフォルト設定：DATE $config_ref->{$config_ref->{'id-0'}."-date_item_name"} = "DATE"; } # 名前のデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-name_item_name"})) { # デフォルト設定：NAME $config_ref->{$config_ref->{'id-0'}."-name_item_name"} = "NAME"; } # タイトルのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-title_item_name"})) { # デフォルト設定：TITLE $config_ref->{$config_ref->{'id-0'}."-title_item_name"} = "TITLE"; } # コメントのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-comment_item_name"})) { # デフォルト設定：COMMENT $config_ref->{$config_ref->{'id-0'}."-comment_item_name"} = "COMMENT"; } # ホストのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-host_item_name"})) { # デフォルト設定：HOST $config_ref->{$config_ref->{'id-0'}."-host_item_name"} = "HOST"; } # プログラム依存処理コード ---------------------------------------------- ここまで # } # データ処理関数 sub add_data_process { my($data_ref, $config_ref) = @_; my($i, $my_cm_num); # 最後の記事番号を取得 for($i = 0; $i < $data_ref->{'id-Nums'}; $i++) { if( $my_cm_num < $data_ref->{'id-'.$i} ) { $my_cm_num = $data_ref->{'id-'.$i}; } } # 最後の記事番号に1を足して新規記事番号にする $my_cm_num++; # データ操作用IDを取得 $my_id_num = "id-".$data_ref->{'id-Nums'}++; # 新規記事番号をIDに登録 $data_ref->{$my_id_num} = $my_cm_num; # 新規記事番号を記事番号へ $g_in{$config_ref->{$config_ref->{'id-0'}."-comment_num_item_name"}} = $my_cm_num; # 入力データを保存先変数へ for($i = 0; $i < $data_ref->{'csv-itName-nums'}; $i++) { $data_ref->{$my_cm_num."-".$data_ref->{'csv-itName-'.$i}} = $g_in{$data_ref->{'csv-itName-'.$i}}; } } # 記事データを削除して記事データIDを再構成します。 sub delete_data_process { my($usr_log_ref, $del_index_ref) = @_; my($id, $true_or_false, @tmp_id_index, %tmp_cm_index, $i); # テンポラリ記事IDを取得 for($i = 0; $i < $usr_log_ref->{'id-Nums'}; $i++) { # 記事IDをテンポラリ記事IDリストへ push(@tmp_id_index, $i); # テンポラリ記事IDをキーとして記事番号をテンポラリ記事番号ハッシュへ $tmp_cm_index{$i} = $usr_log_ref->{'id-'.$i}; } # IDカウンタを初期化 $i = 0; # テンポラリIDをソートしてIDを取得 for(sort{$a <=> $b} @tmp_id_index) { # 値を有効にセット $true_or_false = 1; # IDをセット $id = $_; # 削除リストチェックを取得 for(@$del_index_ref) { # 削除リストに該当するか if( $usr_log_ref->{'id-'.$id} == $_ ) { # 該当する：記事IDは無効 $true_or_false = 0; # ループを抜ける last; } } # 有効な記事IDか？ if($true_or_false) { # 有効：有効ID番号をキーとしてテンポラリ記事番号の値を記事データ・ハッシュへ $usr_log_ref->{'id-'.$i} = $tmp_cm_index{$id}; # IDカウンタをインクリメント $i++ } } # 削除後の記事数をセット $usr_log_ref->{'id-Nums'} = $i; } # ユーティリティ関数群 ---------------------------------------------------------------------------------------------------------------- # # データ暗号化 sub encrypt_data { my($src_data_ref) = @_; my(@SALT, $salt, $enc_data); # 乱数初期化処理 srand; # 乱数発生の為の種リストを作成 @SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/'); # 種リストで乱数を発生させて暗号化用の種を生成 $salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))]; # 暗号化したパスワードを生成 $enc_data = crypt($$src_data_ref, $salt) || crypt ($$src_data_ref, '$1$' . $salt); # 暗号化した文字を元変数へ代入 $$src_data_ref = $enc_data; } # 暗号データ照合処理（ 一致 = 1, 不一致 = 0 ） sub decrypt_data { my($src_data, $enc_data) = @_; my($salt, $key); # 種を取得 $salt = $enc_data =~ /^\$1\$(.*)\$/ && $1 || substr($enc_data, 0, 2); # パスワードを照合 if (crypt($src_data, $salt) eq "$enc_data" || crypt($src_data, '$1$' . $salt) eq "$enc_data") { # 一致 return 1; } else { # 不一致 return 0; } } # HTMLヘッダの出力関数 sub out_html_header { print("Content-type: text/html" , "\n"); print("Pragma: no-cache" , "\n") unless($g_in{'MODE'} eq 'INPUT'); print("Cache-Control: no-cache" , "\n") unless($g_in{'MODE'} eq 'INPUT'); print("\n"); } # 時間の取得 sub get_time { my($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst, $week, $date); $ENV{'TZ'} = "JST-9"; ($sec, $min, $hour, $mday, $mon, $year, $wday, $isdst) = localtime(time); $year += 1900; $mon++; if($mon < 10) { $mon = "0$mon"; } if($mday < 10) { $mday = "0$mday"; } if($hour < 10) { $hour = "0$hour"; } if($min < 10) { $min = "0$min"; } if($sec < 10) { $sec = "0$sec"; } $week = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat') [$wday]; # 日時のフォーマット $date = "$year\/$mon\/$mday($week) $hour\:$min\:$sec"; return $date; } # ロックファイル開始 # $lock_type : lockWithOpen = 0, lockWithSym = 1 sub lock_start { my($lock_file, $lock_type, $retry) = @_; my($error) = "lock_start(); lockWithSym エラー"; # リトライの回数指定はあるか？ if(!($retry)) { # 省略時は，3回 $retry = 3; # リトライサイクルは，高速モードか？ if($g_lock_fast_cycle) { # リトライ回数を4倍する $retry *= 4; } } # 1分以上古いロックは削除する if(-e $lock_file) { # ファイルの作成された時間を取得 my($mtime) = (stat($lock_file))[9]; # 一分以上古いファイルなのか？ if($mtime < time - 60) { # ロックを解除 &lock_end($lock_file); } } # ファイル無になるまでリトライ回数分繰り返し分実行する while(-e $lock_file) { # ある：リトライサイクルは，高速モードか？ # リトライ回数範囲内か？ if(--$retry <= 0) { # リトライ回数を超えた：ファイル作成失敗 return $error; } # リトライサイクルは，高速モードか？ if($g_lock_fast_cycle) { # より早いサイクルでリトライを実行させます select(undef, undef, undef, 0.25); } else { # セーフモード sleep(1); } } # ロックファイルの種類は？ if($lock_type == 1) { # リンク作成 symlink(".", $lock_file) or die return $error; } else { # ロックファイルを作成 open(LOCK, ">$lock_file") or die return $error; close(LOCK); } # 処理結果を返す return; } # ロックファイル終了 sub lock_end { my($lock_file) = @_; # ロックファイルはあるか？ if(-e $lock_file) { # ある：ロックファイルを削除 unlink($lock_file); } } # エラー処理関数 # $error_type：auto_text = 0; plain_text = 1; img = 10 # $error_lock：解除 = 0; 放置 = 1; # ※auto_text は，HTMLテンプレートがある時は HTML ない時は plain でエラーを表示します。 sub error { my($errorStr, $error_type, $error_lock) = @_; my($tpl_html_error); # ロック解除あり？ if(!($error_lock)) { # ロック解除： &lock_end($g_lock_file); } # HTMLを設定 $tpl_html_error = $g_usr{'html_error'}; # エラーの種類は？ if($error_type < 10) { # text：タイプは？auto || plain if($error_type == 0) { # auto：エラー用テンプレートHTMLは存在するか？ if(!(-e $tpl_html_error)) { # 存在しない（plain text）：HTMLヘッダを出力 &out_html_header(); # エラーメッセージを出力 print "Error : $errorStr\n"; } else { # 存在する（HTML） my(%tpl_html, %usr_cfg, $error); # エラー文字をセット $g_in{'ERROR'} = $errorStr; # 設定ファイルの読込 if($error = &tk_util2::readDataFile($g_usr{'config'}, $tk_util2::k_config_a, \%usr_cfg)) { # 読込エラー：HTMLヘッダを出力 &out_html_header(); # エラーメッセージを出力 print "Error : $errorStr
Error : $error\n"; } else { # 設定内容のチェック &usr_config_check(\%usr_cfg); # HTML処理 &general_purpose_log_view_process(\%usr_cfg, $tpl_html_error); } } } else { # plain text：HTMLヘッダを出力 &out_html_header(); # エラーメッセージを出力 print "Error : $errorStr\n"; } # エラー時のデッバグ用にフォーム変数の内容を出力 &testHashOut("g_in", \%g_in); } else { # イメージを作成 my(@err_img) = ( '89', '50', '4E', '47', '0D', '0A', '1A', '0A', '00', '00', '00', '0D', '49', '48', '44', '52', '00', '00', '00', '59', '00', '00', '00', '0F', '08', '02', '00', '00', '00', '00', 'BE', 'F4', '12', '00', '00', '00', '01', '73', '52', '47', '42', '00', 'AE', 'CE', '1C', 'E9', '00', '00', '00', '04', '67', '41', '4D', '41', '00', '00', 'B1', '8F', '0B', 'FC', '61', '05', '00', '00', '00', '20', '63', '48', '52', '4D', '00', '00', '7A', '26', '00', '00', '80', '84', '00', '00', 'FA', '00', '00', '00', '80', 'E8', '00', '00', '75', '30', '00', '00', 'EA', '60', '00', '00', '3A', '98', '00', '00', '17', '70', '9C', 'BA', '51', '3C', '00', '00', '00', '09', '70', '48', '59', '73', '00', '00', '0E', 'C4', '00', '00', '0E', 'C4', '01', '95', '2B', '0E', '1B', '00', '00', '00', 'DC', '49', '44', '41', '54', '58', '47', 'ED', '96', 'DB', '0A', 'C4', '30', '08', '44', 'FB', 'FF', '3F', 'BD', '5D', '08', '15', '3B', '63', '74', '48', 'BA', 'B0', '50', 'F3', '54', '4C', 'E2', 'E5', '78', '49', '8F', 'A3', '57', '13', '68', '02', '1A', '81', '8F', '5B', 'E3', 'C6', '57', '60', '57', 'C7', '37', '4B', '58', 'B7', 'D7', '63', 'E7', '4D', '98', '68', '66', '07', '40', '39', '6B', '0E', '7D', '06', '5B', 'C3', 'ED', 'B1', 'CC', '3A', '9F', 'B9', 'D9', '52', '22', '07', '8D', '09', '64', 'AF', '6D', '16', 'BF', '97', 'F3', 'F9', '90', '32', 'D3', '29', 'B3', 'A5', 'C4', '85', 'B6', '94', '3B', '0F', 'B2', 'B0', '42', 'E3', '8A', '9B', '21', '56', 'F8', '8A', '51', '00', 'C1', '45', '16', 'D6', '29', '79', '26', '4B', 'BF', 'FF', '9D', '85', 'D2', 'D5', 'BF', '63', '51', 'F4', 'B0', '6B', 'FB', 'A4', 'F3', 'C3', '09', 'C2', '7D', 'A4', 'CE', '0B', '6F', '29', 'EC', '46', 'A5', 'AA', 'CB', 'BA', '00', 'A6', '9B', 'F3', '82', '7D', '2E', 'A3', '80', 'A7', '60', '65', '76', 'FA', '51', 'BC', '39', '3B', '3D', 'D3', '4D', '16', '61', 'B5', '72', 'CE', '66', '92', 'F5', '79', '61', 'AF', 'D4', '8B', '58', '84', '2F', '73', '31', '81', 'AF', '6D', 'C8', '73', '38', '89', 'A0', '2E', 'B8', 'D5', '95', 'FF', '8B', 'F2', '4D', 'DD', '89', '22', '49', '76', '6F', '35', '81', '17', '12', '38', '01', 'CE', '1C', 'DF', '3D', 'BE', '71', '09', '19', '00', '00', '00', '00', '49', '45', '4E', '44', 'AE', '42', '60', '82' ); # イメージヘッダを出力 print "Content-type: image/png\n\n"; foreach (@err_img) { print pack('C*',hex($_)); } } exit(1); } # 任意のハッシュの一覧を出力（テスト及びデバッグ用） sub testHashOut { my($comment, $hash) = @_; my($key); print("\n\n\n\n"); } #EOF 1;