#!/usr/bin/perl -I../share $| = 1; # # RCS Infomation. # 削除変更禁止 ----------------------------------------------------------------------------------------- # $CGI{'RCS_ID'} = "$Id: main.pl 3.8 2003/01/03 06:48:19 Administrator Exp Administrator $damy"; $CGI{'RCS_SOURCE'} = "$Source: D:/Users/Administrator/projects/works/salut/C-002_tkbbs1-S/visit\\RCS/main.pl $damy"; # ------------------------------------------------------------------------------------------------------ # # # 以下，情報の変更・削除を禁じます --------------------------------------------------------------------- # # TKBBS1：レス式掲示板 # Copyright(C) NTTPC Communications, Inc. 2001 # Programmed by Tomonori Kamitaki # # [注意事項] # スクリプト中の削除変更禁止やそれに関するコメントがあるコードは， # 著作権保護の為に一切の変更を認めません。 # # [利用規程および規約] # スクリプト配布元であるSalut!（サリュ）のホームページをご覧下さい。 # Salut!（サリュ）ホームページ => http://www.salut.ne.jp/ # # --------------------------------------------------------------------------------------------- ここまで # # 以下，情報の変更・削除を禁じます --------------------------------------------------------------------- # $CGI{'TITLE'} = "TKBBS1"; $CGI{'COPYRIGHT'} = "Copyright(C) NTTPC Communications, Inc. 2001"; $CGI{'COPYRIGHT_URL'} = "http://www.nttpc.co.jp/"; $CGI{'VERSION'} = "Ver. 2.00"; $CGI{'REVISION'} = '$Revision: 3.8 $'; $CGI{'REVISION'} =~ s/^\D*(\d+\.\d+)\D*$/$1/; $CGI{'PROG_BY'} = "Tomonori Kamitaki"; $CGI{'PROG_MAIL'} = ""; $CGI{'INFOMATION'} = $CGI{'TITLE'}." by Salut! Web Master's Heaven"; $CGI{'INFOMATION_URL'} = "http://www.salut.ne.jp/"; $CGI{'SUPPORT_MAIL'} = ""; $CGI{'COOKIE_AUTHOR'} = $CGI{'TITLE'}; # --------------------------------------------------------------------------------------------- ここまで # # 変数の設定 1（環境に応じて設定します）---------------------------------------------------------------- # # 管理用パスワード（英数字8文字以内：必ず変更して下さい） $g_admin_pass = "0123"; # 文字エンコード指定：（ jis | sjis | euc ）から選択。（通常は，変更不要） # 文字コード変換へは，jcode.plを使用します。 $g_char_encoding = "sjis"; # ※省略時は，変換を省きます。 # ロックファイル保存用パス $g_lock_file = "../tmp/tkbbs1.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（通常は変更不要：変更した場合の動作保証はありません）------------------------------------ # # tkbbs1 の設定ファイル $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_default'} = "../share/tpl/default_tpl.html"; # 記事表示 $g_usr{'html_default_noform'} = "../share/tpl/default_noform_tpl.html"; # 記事表示：入力フォーム無 $g_usr{'html_res'} = "../share/tpl/res_tpl.html"; # レス記事入力 $g_usr{'html_manual'} = "../share/tpl/manual_tpl.html"; # 使い方 $g_usr{'html_search_form'} = "../share/tpl/search_form_tpl.html"; # ワード検索：入力 $g_usr{'html_search_result'} = "../share/tpl/search_result_tpl.html"; # ワード検索：結果 $g_usr{'html_usr_del'} = "../share/tpl/usr_del_tpl.html"; # ユーザー：削除 $g_usr{'html_infomation'} = "../share/tpl/info_tpl.html"; # インフォメーション $g_usr{'html_error'} = "../share/tpl/error_tpl.html"; # エラーページ # ----------------------------------------------------------------------------------------- 変数の設定 2 # #ライブラリをロード require 'tk_util2.pl'; #グローバル変数 %g_in; # メイン処理 &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); # ファイルロックの開始 if($error = &lock_start($g_lock_file, $g_lock_type)) { &error($error, 0, 1); } # 処理の指定はあるかな？ if($g_in{'mode'}) { # 処理関数のリファレンス・テーブル作成 %proc_mode = ( "default" , \&mode_default, "input" , \&mode_input, "res" , \&mode_res, "manual" , \&mode_manual, "search" , \&mode_search, "delete" , \&mode_delete, "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) = @_; my($size_availability); # HTMLテンプレート設定 my($tpl_html_file) = $g_usr{'html_default'}; # ディスク空き容量のチェック if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_enable'}) { # 行う：空き容量を取得 if($size_availability = &get_disk_availability()) { # 空き容量は十分か？ if($size_availability < $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_check_size'}) { # 容量不足 $tpl_html_file = $g_usr{'html_default_noform'}; } } else { # ゼロ || エラー？ if($size_availability == 0) { # ゼロ：容量不足 $tpl_html_file = $g_usr{'html_default_noform'}; } else { # エラー &error("空き容量取得に失敗しました。"); } } } # 記事一覧を出力 &general_purpose_log_view_process($usr_cfg_ref, $tpl_html_file); } # インフォメーション・ページ生成 sub mode_info { my($usr_cfg_ref) = @_; &error("インフォメーション・モードをリクエストされました。

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

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

by ".$CGI{'PROG_BY'}."
"); } # 記事削除ページ生成 sub mode_delete { my($usr_cfg_ref) = @_; # 記事番号の指定はあるか？ if(exists $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}}) { # ある：記事を削除 my($error, %usr_log, %tpl_html, @p_index, %r_index, %client_cookie, @del_index, $cm_num); # 削除対象の記事番号を取得 $cm_num = $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}}; # ログデータの読込 if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); } # パスワードの照合 if(&decrypt_data($g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-pass_item_name"}}, $usr_log{$cm_num.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-pass_item_name"}})) { # 一致 # 記事処理の為のインデックスを生成 &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index); # 親記事か？レス記事か？ if(!($usr_log{$cm_num.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-res_num_item_name'}})) { # 親記事：レス記事があるのか？ if(exists $r_index{$cm_num}) { # レス記事の記事番号を削除リストへ @del_index = sort{$b <=> $a} split(/,/, $r_index{$cm_num}); } } # 記事番号を削除リストへ push(@del_index, $cm_num); # 削除リストの記事を削除 &delete_data(\%usr_log, \@del_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($g_usr{'html_usr_del'}, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # 記事を表示 &show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index, 1); # 保存データのヘッダを読込み if($error = &tk_util2::readDataFile($g_usr{'log_head'}, $tk_util2::k_plain_txt, \@usr_head)) { &error($error); } # ログデータの保存 if($error = &tk_util2::saveDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, \@usr_head, "", "<>")) { &error($error); } } else { # 不一致 &error("パスワードが違います。"); } } else { # ない：記事一覧モード &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_usr_del'}); } } # 検索ページ生成 sub mode_search { my($usr_cfg_ref) = @_; # 全角スペースを半角スペースへ $g_in{'KEYWORD'} =~ s/　/ /go; # 連続する空白文字をスペース $g_in{'KEYWORD'} =~ s/\s+/ /go; # 検索キーワードはあるか？ if(!(length($g_in{'KEYWORD'}))) { # ない：検索フォームを出力 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_search_form'}); } else { # ある：検索を実行 my($error, %cookie, %usr_log, %tpl_html, @ref_item_list, @cm_list, %result_cm_index, @result_cm_list, %match_num_index, @s_key_list, @p_list, $key, $i, @tmp_cm_list); # ログデータの読込 if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); } # ログのインデックスを作成 for($i = 0; $i < $usr_log{'id-Nums'}; $i++) { push(@cm_list, $usr_log{'id-'.$i}); } # 検索対象アイテムを設定 push(@ref_item_list , $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-title_item_name'}); push(@ref_item_list , $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-comment_item_name'}); push(@ref_item_list , $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-name_item_name'}); push(@ref_item_list , $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-email_item_name'}); # キーワードのインデックスを作成 @s_key_list = split(/ /, $g_in{'KEYWORD'}); # キーワードを取得（キーワード数分繰り返す） for(@s_key_list) { # キーワードをセット my($s_key) = quotemeta($_); # 記事番号を取得（記事数分繰り返す） for(@cm_list) { # 記事番号をセット my($cm_num) = $_; # 検索対象アイテムを取得（記事数分繰り返す） for(@ref_item_list) { # 検索対象アイテムの中にキーワードは含まれているか？ if($usr_log{$cm_num.'-'.$_} =~ m/$s_key/) { # 含む：記事番号を保存 $result_cm_index{$s_key} .= $cm_num.","; # ループを抜ける last; } } } } # 記事番号をテンポラリリストへ登録 foreach $key (sort keys %result_cm_index) { # テンポラリリストへ記事番号を追加 push(@tmp_cm_list, split(/,/, $result_cm_index{$key})); } # テンポラリリストから記事番号の重複した要素をまとめる。 grep(!$match_num_index{$_}++, @tmp_cm_list); # AND 検索か？OR 検索か？ if($g_in{'AND_OR_FLAG'} eq "AND") { # AND 検索：テンポラリリストを初期化 undef @tmp_cm_list; # 該当した記事番号を取得（記事数分繰り返す） foreach $key (sort keys %match_num_index) { # 全てのキーワードに一致していたか？ if($#s_key_list < $match_num_index{$key}) { # 一致している：テンポラリリストへ追加 push(@tmp_cm_list, $key); } } # 検索結果を新しい順にソートして記事番号を取得 @result_cm_list = sort{$b <=> $a} @tmp_cm_list; } else { # OR 検索：検索結果リストを多く一致した順にソートして取得 @result_cm_list = sort{$match_num_index{$b} <=> $match_num_index{$a}} keys %match_num_index; } # 一致した割合を計算（記事数分繰り返す） for(@result_cm_list) { # 割合をパーセンテージで計算 $usr_log{$_.'-RATE_IN_AGREEMENT'} = (int $match_num_index{$_} / ($#s_key_list + 1) * 100)."%"; } # 検索で該当した記事数を取得 $g_in{'RESULT_NUM'} = $#result_cm_list + 1; # # 記事処理の為のインデックスを生成 # &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_list, \%r_index); # テンプレートHTMLの読込 if($error = &tk_util2::readDataFile($g_usr{'html_search_result'}, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # クッキーの取得 &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # tpl_htmlをセットアップ &setup_tpl_html(\%tpl_html, $usr_cfg_ref, \%cookie); # クッキーを保存 &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # HTMLヘッダを出力 &out_html_header(); # メイン・ヘッダを出力 print $tpl_html{'MAIN_HEAD'}; # 記事の処理ループ for(@result_cm_list) { # 親記事上側のデータ置換して出力 print &save_data_replace($tpl_html{'COMMENT_MAIN_HEAD'}, \%tpl_html, \%usr_log, \%cookie, $_); # # レス記事があるのか？ # if(exists $r_index{$_}) { # # レス記事インデックスをソート # my(@r_list) = sort{$a <=> $b} split(/,/, $r_index{$_}); # # レス記事の処理ループ # for(@r_list) { # # レス記事のデータ置換して出力 # print &save_data_replace($tpl_html{'COMMENT_SUB'}, \%tpl_html, \%usr_log, \%cookie, $_); # } # } # 親記事下側のデータ置換して出力 print &save_data_replace($tpl_html{'COMMENT_MAIN_FOOT'}, \%tpl_html, \%usr_log, \%cookie, $_); } # メイン・フッタを出力 print $tpl_html{'MAIN_FOOT'}; # HTMLを出力 } } # 使い方ページ生成 sub mode_manual { my($usr_cfg_ref) = @_; # HTML処理 &general_purpose_log_view_process($usr_cfg_ref, $g_usr{'html_manual'}); } # 汎用ログ一覧表示処理ルーチン 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 mode_res { my($usr_cfg_ref) = @_; my($error, %usr_log, %tpl_html, %cookie, @p_index, %r_index, $size_availability); # ログデータの読込 if($error = &tk_util2::readDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, "<>")) { &error($error); } # 記事は存在するのか？ if(exists $usr_log{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}}) { # ある # ディスク空き容量のチェック # ：動作OSチェック if(!($ENV{'OS'} eq "Windows_NT")) { # Not Win NT：チェックを行うのか？ if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_enable'}) { # 行う：空き容量を取得 if($size_availability = &get_disk_availability()) { # 空き容量は十分か？ if($size_availability < $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_check_size'}) { # 容量不足 &error("現在この掲示板はディスク空き容量不足の為に投稿の受付を中止しております。"); } } else { # ゼロ || エラー？ if($size_availability == 0) { # ゼロ：容量不足 &error("現在この掲示板はディスク空き容量不足の為に投稿の受付を中止しております。"); } else { # エラー &error("ディスク空き容量取得に失敗しました。"); } } } } # テンプレートHTMLの読込 if($error = &tk_util2::readDataFile($g_usr{'html_res'}, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # 記事処理の為のインデックスを生成 &get_usr_log_index(\%usr_log, $usr_cfg_ref, \@p_index, \%r_index); # クッキーの取得 &get_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # tpl_htmlをセットアップ &setup_tpl_html(\%tpl_html, $usr_cfg_ref, \%cookie); # クッキーを保存 &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # HTMLヘッダを出力 &out_html_header(); # メイン・ヘッダを出力変数へ print $tpl_html{'MAIN_HEAD'}; # 親記事上側のデータ置換して出力 print &save_data_replace($tpl_html{'COMMENT_MAIN_HEAD'}, \%tpl_html, \%usr_log, \%cookie, $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}); # レス記事があるのか？ if(exists $r_index{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}}) { # レス記事インデックスをソート my(@r_index) = sort{$a <=> $b} split(/,/, $r_index{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}}); # レス記事の処理ループ for(@r_index) { # レス記事のデータ置換して出力 print &save_data_replace($tpl_html{'COMMENT_SUB'}, \%tpl_html, \%usr_log, \%cookie, $_); } } # 親記事下側のデータ置換して出力 print &save_data_replace($tpl_html{'COMMENT_MAIN_FOOT'}, \%tpl_html, \%usr_log, \%cookie, $g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}); # メイン・フッタを出力 print $tpl_html{'MAIN_FOOT'}; } else { # ない &error("親記事が削除されたので記事は投稿できません。"); } } # 新しい記事の書込処理 sub mode_input { my($usr_cfg_ref) = @_; my($error, %usr_log, %usr_cfg, %tpl_html, @p_index, %r_index, $input_str_size); # 入力フォームのチェック &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(!($g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}) || (exists $usr_log{$g_in{$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-res_num_item_name"}}."-".$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}."-comment_num_item_name"}})) { # 親記事である || 親記事はある # 記事を追加 $input_str_size = &add_data(\%usr_log, $usr_cfg_ref); # ディスク空き容量のチェック（書込み前） # ：動作OSチェック if(!($ENV{'OS'} eq "Windows_NT")) { # Not Win NT：チェックを行うのか？ if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_enable'}) { # 行う：空き容量を取得 if($size_availability = &get_disk_availability()) { # 空き容量は十分か？ if($size_availability < $input_str_size) { # 容量不足 &error("ディスク空き容量が不足しているか，投稿した内容が長文である為に投稿された内容は書込み出来ませんでした。"); } } else { # ゼロ || エラー？ if($size_availability == 0) { # ゼロ：容量不足 &error("ディスク空き容量が不足しています。申し訳ありませんが，投稿された内容は書込みできません。"); } else { # エラー &error("ディスク空き容量取得に失敗しました。"); } } } } # 記事処理の為のインデックスを生成 &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); } # 保存データのヘッダを読込み if($error = &tk_util2::readDataFile($g_usr{'log_head'}, $tk_util2::k_plain_txt, \@usr_head)) { &error($error); } # HTMLテンプレート設定 my($tpl_html_file) = $g_usr{'html_default'}; # ディスク空き容量のチェック（書込み後） # ：動作OSチェック if(!($ENV{'OS'} eq "Windows_NT")) { # Not Win NT：チェックを行うのか？ if($usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_enable'}) { # 行う：空き容量を取得 if($size_availability = &get_disk_availability()) { # 空き容量は十分か？ if($size_availability < $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-quota_check_size'}) { # 容量不足 $tpl_html_file = $g_usr{'html_default_noform'}; } } else { # ゼロ || エラー？ if($size_availability == 0) { # ゼロ：容量不足 $tpl_html_file = $g_usr{'html_default_noform'}; } else { # エラー &error("ディスク空き容量取得に失敗しました。"); } } } } # テンプレートHTMLの読込 if($error = &tk_util2::readDataFile($tpl_html_file, $tk_util2::k_tpl_html, \%tpl_html)) { &error($error); } # 記事を表示 &show_log_view(\%tpl_html, \%usr_log, $usr_cfg_ref, \@p_index, \%r_index, 1); # ログデータの保存 if($error = &tk_util2::saveDataFile($g_usr{'log_data'}, $tk_util2::k_csv_data, \%usr_log, \@usr_head, "", "<>")) { &error($error); } } else { # 親記事はない &error("親記事が削除されたので記事は投稿出来ませんでした。"); } } # 最大記事登録数の制限チェック 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}; } } } # 一番古い記事は親記事か？レス記事か？ if($usr_log_ref->{$usr_log_ref->{$oldest}.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-res_num_item_name'}}) { # レス記事：削除しない return 0; } else { # 親記事：親記事とそれのレス記事を削除 # レス記事があるのか？ if(exists $r_index_ref->{$oldest}) { # レス記事の記事番号を削除リストへ @del_index = sort{$b <=> $a} split(/,/, $r_index_ref->{$oldest}); # 最新記事番号を取得 $latest = $usr_log_ref->{'id-Nums'} - 1; # レス記事の中に最新記事（今，入力された記事）があるか？ if($usr_log_ref->{$usr_log_ref->{'id-'.$latest}.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-res_num_item_name'}} == $oldest) { # ある：削除処理はしない return 0; } } # 親記事番号を削除リストへ push(@del_index, $oldest); # 削除リストの記事を削除 &delete_data($usr_log_ref, \@del_index); # 変更通知を返す return 1; } } # 記事データを追加します sub add_data { my($data_ref, $config_ref) = @_; my($i, $my_cm_num, $my_id_num, $tmp); # 最後の記事番号を取得 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; # 入力されたパスワードを退避（後処理で必要な場合がある） $g_in{'src-'.$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}} = $g_in{$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}}; # 入力されたパスワードを暗号化 &encrypt_data(\$g_in{$config_ref->{$config_ref->{'id-0'}.'-pass_item_name'}}); # 入力データを保存先変数へ 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}}; # 入力データの文字列サイズをカウント $tmp += length($g_in{$data_ref->{'csv-itName-'.$i}}); } # （入力データ + 付加データ）のサイズを返す return ($tmp += 128); } # 記事データを削除して記事データIDを再構成します。 sub delete_data { 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; } # 入力フォームのチェック（名前，メール，タイトル，コメント，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'}."-email_item_name"}})) { # あり：正当性はあるか？（書式的に） if(!($g_in{$config_ref->{$config_ref->{'id-0'}."-email_item_name"}} =~ m/(.+?)\@(.+?)\.(.+?)/)) { # 不正：エラー表示文字を設定 $error .= "メールアドレスが不正です。正しいメールアドレスを入力して下さい。"."
"; } } # タイトルのチェック if(!(length($g_in{$config_ref->{$config_ref->{'id-0'}."-title_item_name"}}))) { # 不正：エラー表示文字を設定 $error .= "タイトルがありません。"."
"; } # コメントのチェック if(!(length($g_in{$config_ref->{$config_ref->{'id-0'}."-comment_item_name"}}))) { # 不正：エラー表示文字を設定 $error .= "コメントがありません。"."
"; } # URLのチェック if(length($g_in{$config_ref->{$config_ref->{'id-0'}."-url_item_name"}})) { # あり：正当性はあるか？（完璧ではない。書式的に[ ○○:// ]の形式であればエラーにならない。） if(!($g_in{$config_ref->{$config_ref->{'id-0'}."-url_item_name"}} =~ m/(.+?)\:\/\//)) { # 不正：エラー表示文字を設定 $error .= "URLの記述が間違っています。プロトコル名（http://等）から始まように記述して下さい。"."
"; } } 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 = "直前ログ"; } # PASS DATE COMMENT_NUM 以外のデータを比較 for($i = 0, $j = 0; $i < $usr_log_ref->{'csv-itName-nums'}; $i++) { # COMMENT_NUM, DATE, PASS は，比較対象から除外 if($usr_log_ref->{'csv-itName-'.$i} eq $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-pass_item_name'}) { $j++; next; } 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("多重投稿です。"); } } # 記事表示 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'}) { # ページ番号の設定 $g_in{'PAGE_NUM'} = ($g_in{'PAGE_NUM'} > 0) ? $g_in{'PAGE_NUM'} : 1; # ページ内での記事の始まりを設定 $cm_start = ($g_in{'PAGE_NUM'} - 1) * $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-item_per_page'}; # ページ内での記事の始まりのオーバーフローチェック if(!($cm_start <= $#$p_index_ref)) { $cm_start = $#$p_index_ref; $g_in{'PAGE_NUM'} = int $#$p_index_ref / $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-item_per_page'} + 1; } # ページ内での記事の終わりを設定 $cm_end = $cm_start + $usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-item_per_page'} - 1; # ページ内での記事の終わりのオーバーフローチェック if(!( $cm_end <= $#$p_index_ref )) { # 実際の数に修正 $cm_end = $#$p_index_ref; } # クッキーの取得 &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, $g_in{'PAGE_NUM'}, $cm_start, $cm_end, $#$p_index_ref); # クッキーを保存 &set_cookie($CGI{'COOKIE_AUTHOR'}, \%cookie); # HTMLヘッダを出力 &out_html_header(); # メイン・ヘッダを出力 print $tpl_html_ref->{'MAIN_HEAD'}; # 記事の処理ループ for(@$p_index_ref[$cm_start .. $cm_end]) { # 親記事上側のデータ置換して出力 print &save_data_replace($tpl_html_ref->{'COMMENT_MAIN_HEAD'}, $tpl_html_ref, $usr_log_ref, \%cookie, $_); # レス記事があるのか？ if(exists $r_index_ref->{$_}) { # レス記事インデックスをソート my(@r_index) = sort{$a <=> $b} split(/,/, $r_index_ref->{$_}); # レス記事の処理ループ for(@r_index) { # レス記事のデータ置換して出力 print &save_data_replace($tpl_html_ref->{'COMMENT_SUB'}, $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++) { # 親記事か？レス記事か？ if(!($usr_log_ref->{$usr_log_ref->{'id-'.$i}.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-res_num_item_name'}})) { # 親記事インデックスに追加 $p_index[$j++] = $usr_log_ref->{'id-'.$i}; } else { # レス記事インデックスに追加 $r_index_ref->{$usr_log_ref->{$usr_log_ref->{'id-'.$i}.'-'.$usr_cfg_ref->{$usr_cfg_ref->{'id-0'}.'-res_num_item_name'}}} .= "$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, $ret, $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; # ページ変数のコピー（動作OS／Perl Version による誤動作防止への対処） $usr_cfg_ref->{$usr_cfg_ref->{'id-'.$i}.'-NEXT_PAGE'} = $next; $usr_cfg_ref->{$usr_cfg_ref->{'id-'.$i}.'-PREV_PAGE'} = $prev; # 単純データ置換え文字列（ __%%$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::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"})) { # デフォルト設定：50件 $config_ref->{$config_ref->{'id-0'}."-item_max"} = 50; } 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'}."-item_per_page"})) { # デフォルト設定：10件 $config_ref->{$config_ref->{'id-0'}."-item_per_page"} = 10; } elsif($config_ref->{$config_ref->{'id-0'}."-item_per_page"} > 20) { # 最大件数：20件 $config_ref->{$config_ref->{'id-0'}."-item_per_page"} = 20; } # ページタイトルのチェック if(!($config_ref->{$config_ref->{'id-0'}."-TITLE"})) { # デフォルト設定：TKBBS1 $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'}."-res_num_item_name"})) { # デフォルト設定：RES_NUM $config_ref->{$config_ref->{'id-0'}."-res_num_item_name"} = "RES_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'}."-email_item_name"})) { # デフォルト設定：EMAIL $config_ref->{$config_ref->{'id-0'}."-email_item_name"} = "EMAIL"; } # タイトルのデータ・アイテム名のチェック 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"; } # URLのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-url_item_name"})) { # デフォルト設定：URL $config_ref->{$config_ref->{'id-0'}."-url_item_name"} = "URL"; } # ホストのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-host_item_name"})) { # デフォルト設定：HOST $config_ref->{$config_ref->{'id-0'}."-host_item_name"} = "HOST"; } # パスワードのデータ・アイテム名のチェック if(!($config_ref->{$config_ref->{'id-0'}."-pass_item_name"})) { # デフォルト設定：PASS $config_ref->{$config_ref->{'id-0'}."-pass_item_name"} = "PASS"; } } # データ暗号化 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"); print("\n\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; } # ディスク空容量の取得 sub get_disk_availability { use Cwd; use Quota; #カレントのマウントポイントを取得 my($wd) = Cwd::getcwd(); my(@s_wd) = split(/\//,$wd); my($mp) = "\/"."$s_wd[1]"; #quotaの値を取得 my($device) = Quota::getdev($mp); my(@wuid) = getpwuid($>); my(@prog_out_u) = Quota::query($device,$wuid[2],0); my(@prog_out_g) = Quota::query($device,$wuid[3],1); # 制限無しか？ if($prog_out_u[2] == '0') { # 各サイズを取得 my($blocks_g) = $prog_out_g[0]; my($quota_g) = $prog_out_g[2]; # 制限無し：webに容量配分された値を元に空き容量を計算して返す return (${quota_g} - ${blocks_g}); }else{ # 各サイズを取得 my($blocks_u) = $prog_out_u[0]; my($quota_u) = $prog_out_u[2]; # 制限あり：adminのweb使用可能容量を元に空き容量を計算して返す return (${quota_u} - ${blocks_u}); } } # ロックファイル開始 # $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; gif = 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); # エラー文字をセット $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 { # gif：ERROR GIF IMAGE を作成 my(@err_gif) = ( '47', '49', '46', '38', '39', '61', '2d', '00', '0f', '00', '80', '00', '00', '00', '00', '00', 'ff', 'ff', 'ff', '2c', '00', '00', '00', '00', '2d', '00', '0f', '00', '00', '02', '49', '8c', '8f', 'a9', 'cb', 'ed', '0f', 'a3', '9c', '34', '81', '7b', '03', 'ce', '7a', '23', '7c', '6c', '00', 'c4', '19', '5c', '76', '8e', 'dd', 'ca', '96', '8c', '9b', 'b6', '63', '89', 'aa', 'ee', '22', 'ca', '3a', '3d', 'db', '6a', '03', 'f3', '74', '40', 'ac', '55', 'ee', '11', 'dc', 'f9', '42', 'bd', '22', 'f0', 'a7', '34', '2d', '63', '4e', '9c', '87', 'c7', '93', 'fe', 'b2', '95', 'ae', 'f7', '0b', '0e', '8b', 'c7', 'de', '02', '00', '3b' ); # gif イメージヘッダを出力 print "Content-type: image/gif\n\n"; foreach (@err_gif) { my($data) = pack('C*',hex($_)); print $data; } } exit(1); } # 任意のハッシュの一覧を出力（テスト用） sub testHashOut { my($comment, $hash) = @_; my($key); print("\n\n\n\n"); } #EOF 1;