#!/usr/local/bin/perl ## ------------------------------------------------------------------- ## COSMO NAVI v1.3 (1999/11/03) ## (C) 1997-1999 by KENT WEB ## E-MAIL: webmaster@kent-web.com ## WWW: http://www.kent-web.com/ $ver = 'COSMO NAVI v1.3'; # バージョン情報（修正不要） ## ---[注意事項]------------------------------------------------------ ## 1. このスクリプトはフリーソフトです。このスクリプトを使用した ## いかなる損害に対して作者は一切の責任を負いません。 ## 2. 設置に関する質問はサポート掲示板にお願いいたします。メールによる ## 質問はご遠慮ください。 ## 3. 同梱の「アイコン (new.gif/recom.gif) 」は、「牛飼いとアイコンの ## 部屋 (http://www.ushikai.com/)」によるものです。 ## ------------------------------------------------------------------- require './jcode.pl'; #============# # 基本設定 # #============# # タイトル名 $title = "MegDaruma Link NAVIGATOR"; # タイトル文字の色 $t_color = "#FFFFFF"; # タイトルの文字フォントタイプ $t_face = "ＭＳ Ｐゴシック"; # 管理用パスワード（英数字で） $pass = 'casey'; # スクリプト名 $script = "link.cgi"; # ログファイル $logfile = "./navi.log"; # 戻り先 (絶対パスなら http://から) $home = "../index.html"; # methodの形式 (POST or GET) $method = 'POST'; # 紹介コメントの制限文字数（全角文字） $msg_limit = 80; # NEWアイコンの表示日数 $newtime = 20; # 新着情報の最新表示件数 $w_new = 10; # 登録内容の１ページ当りの表示数 $p_view = 20; # ロックファイル (0=no 1=symlink関数 2=open関数) $lockkey = 0; # ロックファイル名（フルパスだと / から記述する） $lockfile = "navi.lock"; # ロックファイルディレクトリ # --> このディレクトリのパーミッションは 777 に設定 $lockdir = "."; # ホスト名取得モード # --> 0 : $ENV{'REMOTE_HOST'} で取得できる場合 # --> 1 : gethostbyaddr で取得できる場合 $get_remotehost = 0; # バックアップログ $bkup = "./bkup.dat"; # 以下は分類（ジャンル）の指定です。 # --> 変数のカギ括弧内は 0 から連番で続ける $parts[0] = "形成外科"; $parts[1] = "ヒーリング"; $parts[2] = "ホリスティック医学"; $parts[3] = "食材・レシピ"; $parts[4] = "シャーマニズム"; $parts[5] = "オーガニックライフ"; $parts[6] = "哲学・思想"; $parts[7] = "オルトカルチャー"; $parts[8] = "シュタイナー"; $parts[9] = "地域通貨関連"; $parts[10] = "サステイナブルテクノロジー"; $parts[11] = "地域情報"; $parts[12] = "その他"; # --- 環境設定 $bground = ""; # 壁紙（http://から記述） $bgcolor = "#FFFFFF"; # 背景色 $text = "#000000"; # 文字色 $link = "#0000FF"; # リンク色（未訪問） $vlink = "#800080"; # リンク色（既訪問） $alink = "#DD0000"; # リンク色（訪問中） # 横線の色 $obi_color = "#0000CC"; # 見出しヘッダの色（■の色） $pointer = "#0000CC"; # タイトルにGIF画像を使う場合 (GIFファイル名) $t_gif = "../images/link.gif"; $t_wid = '93'; # 画像の横サイズ（ピクセル） $t_hgt = '25'; # 　〃　縦サイズ（ピクセル） # NEWアイコン $newgif = "./img/new.gif"; $new_w = '16'; # 　〃　横サイズ $new_h = '7'; # 　〃　縦サイズ # お薦めアイコン $recom = './img/recom.gif'; $rec_w = '16'; # 　〃　横サイズ $rec_h = '16'; # 　〃　縦サイズ # メール通知 (0=no 1=登録者のみ 2=登録者と管理者へ通知) # --> sendmail必須 $mailing = 0; # sendmailのパス $sendmail = '/usr/lib/sendmail'; # 管理者メールアドレス（メール通知する時） $admin_mail = 'meg@daruma.co.jp'; # 管理者名（メール通知する時） $admin_name = "Meg"; # 管理者のURL（メール通知する時） $admin_url = 'http://www.daruma.co.jp/meg/'; # 同一URLの二重登録を許可する (0=no 1=yes) $w_url = 0; # 登録アクセス拒否 # --> 新規登録処理をホスト名から拒否します @deny = ( 'ppp*.xxx.co.jp', 'cache*.*.interlog.com', 'anonymizer', '', '', '', '', '' ); #============# # 設定完了 # #============# # ロックファイルを定義 $lockfile = "$lockdir\/$lockfile"; ## メイン処理 ## &decode; if ($mode eq 'howto') { &howto; } if ($mode eq 'new_sort') { &new_sort; } if ($mode eq 'ranking') { &ranking; } if ($mode eq 'new_url') { &new_url; } if ($mode eq 'regist') { ®ist; } if ($mode eq 'mente') { &mente; } if ($mode eq 'do_mente') { &do_mente; } if ($mode eq 'admin') { &admin; } if ($mode eq 'admin_edit') { &admin_edit; } if ($mode eq 'search') { &search; } if ($mode eq 'part') { &part_view; } if ($mode eq '' && $links ne '') { &link_jump; } &html_view; exit; ## --- 初期画面 sub html_view { # バックアップ処理 if (!$mode) { &backup; } # ログを読み込み open(IN,"$logfile") || &error("Can't open $logfile","no"); while ($_ = ) { ($no,$pt,$sub,$hp,$name,$email,$pw,$msg,$date,$t) = split(/<>/, $_); foreach (0 .. $#parts) { if ($pt eq "$_") { $bunrui[$_]++; last; } } } close(IN); &header; print "
\n"; if ($t_gif) { print "\n"; } else { print "$title\n"; } print <<"EOM"; ホームに戻る   注意事項   新規登録   新着情報   人気ランキング   管理用

AND OR

EOM print "\n"; $flag=0; foreach (0 .. $#parts) { if ($bunrui[$_] eq '') { $bunrui[$_] = 0; } if ($flag == 0) { print "\n"; $flag=1; } else { print "\n"; $flag=0; } } if ($flag == 1) { print "\n"; } print "
■ $parts[$_]($bunrui[$_])■ $parts[$_]($bunrui[$_])
\n"; print "

\n"; print "
\n"; &footer; } ## --- 新規登録画面 sub new_url { # ホスト名をチェック &get_host; local($flag)=0; foreach (@deny) { if ($_ eq "") { next; } $_ =~ s/\*/\.\*/g; if ($host =~ /$_/) { $flag=1; last; } } if ($flag) { &error("現在新規登録はできません"); } &header; print <<"EOM"; [メニューに戻る]
新規登録

  1. 新規登録を行います。
  2. 下記フォームに内容を記述し、登録ボタンを押してください。
  3. パスワードは今後のメンテナンスに必要なので必ず記入してください。

管理者名
Ｅメール
ＵＲＬ
パスワード （英数字で8文字以内）
分　類 EOM if ($part) { print "\n"; } foreach (0 .. $#parts) { if ($part eq "$_") { print "
ホームページのタイトル
ホームページの紹介（全角$msg_limit文字以内で）
EOM &footer; exit; } ## --- 登録処理 sub regist { # フォームチェック if ($name eq '') { &error("なまえの入力がありません。","no"); } if ($email eq '' || $email !~ /(.*)\@(.*)\.(.*)/) { &error("Eメールの入力内容が不正です。","no"); } if ($url eq '') { &error("URLの入力がありません。","no"); } if ($pwd eq '') { &error("パスワードの入力がありません。","no"); } if ($pwd =~ /\W/) { &error("パスワードに全角文字が含まれています。半角の英数字で入力してください。","no"); } if ($part eq '') { &error("分類の指定がありません。","no"); } if ($sub eq '') { &error("タイトル名の入力がありません。","no"); } if ($msg eq '') { &error("紹介コメントの入力がありません。","no"); } if (length($msg) > $msg_limit*2) { &error("紹介コメントが$msg_limit文字以上を超えています。","no"); } # 日時の取得 &get_time; # ホスト名を取得 &get_host; # ロック開始 if ($lockkey == 1) { &lock1; } elsif ($lockkey == 2) { &lock2; } open(IN,"$logfile") || &error("Can't open $logfile","lock"); $i=0; $cflag=0; while ($_ = ) { $i++; # URLが既登録でないかをチェック local($no,$part,$sub,$hp,$name,$email,$pw,$msg,$date,$t) = split(/<>/, $_); # 先頭行の記事Noを取得 if ($i == 1) { $topno = $no; } # URLが合致すればループを解除 if ($w_url eq '0' && $url eq "$hp") { $cflag=1; last; } } close(IN); if ($cflag) { &error("登録しようとするURLは既に登録済です。","lock"); } # 登録Noをカウントアップ $topno++; # パスワードを暗号化 &passwd_encode; # テンポラリーファイルを定義 $temp = "$$"; if ($temp eq '') { srand; $temp = 1000000000000000 * rand; } $tmpfile = "$lockdir\/$temp\.tmp"; # ファイルに追加 open(IN,"$logfile") || &error("Can't open $logfile","lock"); open(OUT,">$tmpfile") || &error("Can't write Temp File","lock"); print OUT "$topno<>$part<>$sub<>$url<>$name<>$email<>$encode_pwd<>$msg<>$date<>$times<>0<>0<>$host<>\n"; while ($_ = ) { print OUT $_; } close(OUT); close(IN); rename($tmpfile,$logfile) || &error("Rename Error","lock"); chmod (0666,$logfile); if (-e $tmpfile) { unlink($tmpfile); } # ロック解除 unlink($lockfile) if (-e $lockfile); # お礼メール通知 if ($mailing) { &mail_to; } # 登録完了画面 &header; print "

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

ありがとうございます。以下の内容で登録が完了しました。

\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
管理者名：$name
Ｅメール：$email
ＵＲＬ：$url
PASSWORD：$pwd
分　類：$parts[$part]
タイトル：$sub
紹介文：$msg
\n"; print "
\n"; print "\n"; print "
\n"; print "
\n"; &footer; exit; } ## --- メンテ画面 sub mente { open(IN,"$logfile") || &error("Can't open $logfile","no"); while ($_ = ) { ($no,$part,$sub,$hp,$name,$email,$pw,$msg,$date,$t) = split(/<>/, $_); if ($FORM{'no'} eq "$no") { last; } } close(IN); &header; print <<"EOM"; [メニューに戻る]
登録情報の修正・削除

  1. 下記ホームページのメンテナンスを行います。
  2. 処理内容を選択し、登録時に指定した「パスワード」を入力してください。

タイトル：$sub
ＵＲＬ：http://$hp

修正 削除

パスワード

EOM &footer; exit; } ## --- メンテ実行 sub do_mente { # フォームチェック if ($pwd eq '') { &error("パスワードが入力されていません。","no"); } # ロック開始 if ($lockkey == 1 && $FORM{'action'} ne 'mente') { &lock1; } elsif ($lockkey == 2 && $FORM{'action'} ne 'mente') { &lock2; } open(IN,"$logfile") || &error("Can't open $logfile","lock"); # 修正処理実行 if ($FORM{'action'} eq "go") { # フォームチェック if ($name eq '') { &error("なまえの入力がありません。","lock"); } if ($email eq '' || $email !~ /(.*)\@(.*)\.(.*)/) { &error("Eメールの入力内容が不正です。","lock"); } if ($url eq '') { &error("URLの入力がありません。","lock"); } if ($pwd eq '') { &error("パスワードの入力がありません。","lock"); } if ($pwd =~ /\W/) { &error("パスワードに全角文字が含まれています。半角の英数字で入力してください。","lock"); } if ($part eq '') { &error("分類の指定がありません。","lock"); } if ($sub eq '') { &error("タイトル名の入力がありません。","lock"); } if ($msg eq '') { &error("紹介コメントの入力がありません。","lock"); } if (length($msg) > $msg_limit*2) { &error("紹介コメントが$msg_limit文字以上を超えています。","lock"); } # テンポラリーファイルを定義 $temp = "$$"; if ($temp eq '') { srand; $temp = 1000000000000000 * rand; } $tmpfile = "$lockdir\/$temp\.tmp"; open(OUT,">$tmpfile") || &error("Can't write tempfile","lock"); while ($_ = ) { ($no,$pt,$sb,$hp,$na,$em,$pw,$ms,$dt,$ts,$rec,$cnt,$ho) = split(/<>/, $_); if ($FORM{'no'} eq "$no") { # パスワード照合 local($encode_pwd) = $pw; &passwd_decode; if ($check eq 'no') { last; &error("パスワードが違います。","lock"); } print OUT "$no<>$part<>$sub<>$url<>$name<>$email<>$pw<>$msg<>$dt<>$ts<>$rec<>$cnt<>$ho<>\n"; } else { print OUT $_; } } close(OUT); close(IN); rename($tmpfile,$logfile) || &error("Rename Error","lock"); chmod (0666,$logfile); if (-e $tmpfile) { unlink($tmpfile); } # ロック解除 unlink($lockfile) if (-e $lockfile); # 完了メッセージ &header; print "

修正処理は完了しました。

\n"; print "

[メニューにもどる]\n"; print "

\n"; &footer; exit; # 削除処理実行 } elsif ($FORM{'action'} eq "delete") { # テンポラリーファイルを定義 $temp = "$$"; if ($temp eq '') { srand; $temp = 1000000000000000 * rand; } $tmpfile = "$lockdir\/$temp\.tmp"; open(OUT,">$tmpfile") || &error("Can't write Temp File","lock"); while ($_ = ) { ($no,$pt,$sb,$hp,$na,$em,$pw,$ms,$dt,$ts,$rec,$cnt,$ho) = split(/<>/, $_); if ($FORM{'no'} eq "$no") { # パスワード照合 local($encode_pwd) = $pw; &passwd_decode; if ($check eq 'no') { &error("パスワードが違います。","lock"); last; } } else { print OUT $_; } } close(OUT); close(IN); rename($tmpfile,$logfile) || &error("Rename Error","lock"); chmod (0666,$logfile); if (-e $tmpfile) { unlink($tmpfile); } # ロック解除 unlink($lockfile) if (-e $lockfile); # 完了メッセージ &header; print "

削除処理は完了しました。

\n"; print "

[メニューにもどる]\n"; print "

\n"; &footer; exit; } while ($_ = ) { ($no,$part,$sub,$hp,$name,$email,$pw,$msg,$date,$ts,$rec,$count) = split(/<>/, $_); $mflag=0; if ($FORM{'no'} eq "$no") { $mflag = 1; # パスワード照合 local($encode_pwd) = $pw; &passwd_decode; if ($check eq 'no') { &error("パスワードが違います。","lock"); } last; } } close(IN); if ($mflag == 0) { &error("指定のURLが見つかりません。"); } # 修正用画面を表示 &header; print <<"EOM"; [メニューに戻る]
登録情報の修正

  1. 以下のフォームにて登録内容の修正を行います。
  2. 変更する部分のみ修正し、「送信する」ボタンを押してください。

管理者名
Ｅメール
ＵＲＬ
分　類
ホームページのタイトル
ホームページの紹介（$msg_limit文字以内）
EOM &footer; exit; } ## --- ランキング表示 sub ranking { $times = time; # ランクファイルを読み込む open(IN,"$logfile") || &error("Can't open $logfile","no"); &header; print "[メニューに戻る]
\n"; print "
\n"; print "人気ランキング
\n"; print "

\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; while ($_ = ) { local($no,$part,$sub,$hp,$name,$email, $pw,$msg,$date,$ts,$rec,$count) = split(/<>/, $_); $no{$no} = $no; $count{$no} = $count; $part{$no} = $part; $sub{$no} = $sub; $msg{$no} = $msg; $ts{$no} = $ts; $rec{$no} = $rec; } $rank1 = 0; $rank2 = 1; $count_tmp = 0; $i=0; $j=0; foreach (sort { ($count{$b} <=> $count{$a}) || ($a cmp $b) } keys(%count)) { $i++; if ($page eq "") { if ($i > $p_view) { last; } } else { if ($i < $page) { next; } else { $j++; if ($j > $p_view) { last; } } } ($count{$_} == $count_tmp) || ($rank1 = $rank2); # 桁区切り if (length($count{$_}) > 3) { $count{$_} = &filler($count{$_}); } $sub{$_} = "$sub{$_}"; $part{$_} = "$parts[$part{$_}]"; if ($page) { $ranking = $rank1 + $page - 1; } else { $ranking = $rank1; } print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; $count_tmp = $count{$_}; $rank2++; } close(IN); print "
順　位タイトルコメント分　類アクセス数
第 $ranking位$sub{$_}"; # アイコンを表示 &icons('rank'); print "$msg{$_}$part{$_}$count{$_}
\n"; print "\n"; # 改頁処理 if ($page eq '') { $page = 1; } $next_line = $page + $p_view; $back_line = $page - $p_view; # 前頁処理 if ($back_line > 0) { print "\n"; } # 次頁処理 if ($next_line <= $i) { print "\n"; } print "
\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "
\n"; &footer; exit; } ## --- 検索処理 sub search { # 入力内容を整理 $cond = $FORM{'cond'}; $word = $FORM{'word'}; $word =~ tr/[A-Z]/[a-z]/; $word =~ s/　/ /g; $word =~ s/\t/ /g; @pairs = split(/ /,$word); # 検索処理 open(IN,"$logfile") || &error("Can't open $logfile","no"); @new=(); while ($_ = ) { $sline = $_; $sline =~ tr/[A-Z]/[a-z]/; local($no,$part,$sub,$hp,$name, $email,$pw,$msg,$date,$ts,$rec) = split(/<>/, $sline); $sflag=0; foreach $pair (@pairs) { if (index($sline,$pair) >= 0) { $sflag = 1; if ($cond eq 'or') { last; } } else { if ($cond eq 'and') { $sflag=0; last; } } } if ($sflag == 1) { push(@new,$_); } } close(IN); # 検索終了 $total = @new; &header; print "[メニューに戻る]
\n"; print "\n"; print "
\n"; print "ワード検索
\n"; # 検索でヒットのない場合のエラーメッセージ if ($total == 0) { print "

\n"; print "キーワード $FORM{'word'} は見つかりませんでした。\n"; print "


\n"; &footer; exit; } print "

検索結果：$total件\n"; print "

\n"; foreach (@new) { local($no,$part,$sub,$hp,$name, $email,$pw,$msg,$dt,$ts,$rec) = split(/<>/,$_); $sub = "$sub\n"; $times = time; # 結果を表示 print "$sub "; # アイコンを表示 &icons; print "分類：$parts[$part]\n"; print "登録日：$dt

$msg

\n"; } print "
\n"; &footer; exit; } ## --- 分類（カテゴリー）を表示 sub part_view { &header; print "[メニューに戻る]\n"; print "[新規登録]
\n"; print "\n"; print "\n"; print "
$parts[$part]
\n"; print "

\n"; if ($FORM{'k'}) { print "登録件数：$FORM{'k'}件
\n"; } print "

  • タイトル部分をクリックするとそのホームページへジャンプします。
    \n"; print "
  • タイトル横の数値はアクセス数、 は新着、 はおすすめマークです。\n"; print "
\n"; print "
\n"; open(IN,"$logfile") || &error("Can't open $logfile","no"); $i=0; $j=0; while ($_ = ) { local($no,$pt,$sub,$hp,$name,$email,$pw,$msg,$dt,$ts,$rec,$axs) = split(/<>/, $_); if ($part ne "$pt") { next; } $i++; if ($page eq "") { if ($i > $p_view) { last; } } else { if ($i < $page) { next; } else { $j++; if ($j > $p_view) { last; } } } $sub = "$sub\n"; $times = time; # 結果を表示 print "$sub [$axs] "; # アイコンを表示 &icons; print " 登録日：$dt [修正・削除]\n"; print "

$msg

\n"; } close(IN); # 改頁処理 if ($page eq '') { $page = 1; } $next_line = $page + $p_view; $back_line = $page - $p_view; print "\n"; # 前頁処理 if ($back_line > 0) { print "\n"; } # 次頁処理 if ($next_line <= $i) { print "\n"; } print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "
\n"; &footer; exit; } ## --- 新着情報 sub new_sort { &header; print "[メニューに戻る]
\n"; print "
\n"; print "新 着 情 報
\n"; print "
\n
\n"; print "

  • 以下に表\示する情報は新規登録の最新 $w_new件です。\n"; print "

    \n"; open(IN,"$logfile") || &error("Can't open $logfile","no"); $i=0; while ($_ = ) { $i++; local($no,$part,$sub,$hp,$name,$email,$pw,$msg,$dt,$ts,$rec) = split(/<>/, $_); $sub = "$sub\n"; $times = time; # 結果を表示 print "$sub "; # おすすめアイコン print " " if ($rec == 1); print "分類：$parts[$part]\n"; print "登録日：$dt

    $msg

    \n"; # 規定件数でループを抜ける if ($i >= $w_new) { last; } } close(IN); print "
    • \n"; &footer; exit; } ## --- リンクジャンプ処理 sub link_jump { # テンポラリーファイルを定義 $temp = "$$"; if ($temp eq '') { srand; $temp = 1000000000000000 * rand; } $tmpfile = "$lockdir\/$temp\.tmp"; # ロック開始 if ($lockkey == 1) { &lock1; } elsif ($lockkey == 2) { &lock2; } open(IN,"$logfile") || &error("Can't open $logfile","lock"); $jflag = 0; @new = (); open(OUT,">$tmpfile") || &error("Can't write Temp File","lock"); while ($_ = ) { ($no,$part,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $_); if ($no eq "$links") { $jflag = 1; $axs++; print OUT "$no<>$part<>$sub<>$hp<>$name<>$email<>$pw<>$msg<>$dt<>$ts<>$rec<>$axs<>$ho<>\n"; $url = $hp; } else { print OUT $_; } } close(OUT); close(IN); if ($jflag == 0) { &error("リンク先のURL情報が見当たりません。","lock"); } # ファイルをリネーム rename($tmpfile,$logfile) || &error("Rename Error","lock"); chmod (0666,$logfile); if (-e $tmpfile) { unlink($tmpfile) } # ロック解除 unlink($lockfile) if (-e $lockfile); # 目的のURLへジャンプする if ($ENV{PERLXS} eq "PerlIS") { # IIS (PerlIS) サーバ対応 print "HTTP/1.0 302 Temporary Redirection\r\n"; print "Content-type: text/html\n"; } print "Location: http://$url\n\n"; exit; } ## --- 注意事項 sub howto { &header; print <<"EOM"; [メニューに戻る]
    注意事項と使用方法について

    1. このナビゲータは任意の「キーワード」から自由にホームページ情報を検索することが可能\です。
    2. 検索するキーワードは半角スペースで区切って、複数のキーワードを使うことができます。AND と OR をうまく使い分けて目的のホームページを検索してください。
    3. このナビゲータにあなたのホームページを登録することができます。タイトル下の「新規登録」をクリックすると登録フォームが現れます。
    4. 新規に登録された情報は $newtime日間 マークが表\示されます。
    5. 登録時に任意のパスワード（英数字で8文字以内）を入力してください。後日そのパスワードを使って、登録内容の修正・削除等のメンテナンス作業を行うことができます。（登録情報の 「修正・削除」をクリックするとメンテ画面が現れます）
    6. 登録されたURLをクリックされた回数はログファイルに蓄積され、ランキング表\示されます。タイトル下の「人気ランキング」をクリックすると現時点のランキングが表\示されます。
    7. 管理者の主観で、登録されたホームページが「おすすめ」だと判断する場合、 マークを表\示します。
    8. 管理者が登録内容について、主観的にふさわしくないと判断した場合、及び登録されたURLのリンク先がなくなっている場合には、予\告なく内容を削除することがあります。

    EOM &footer; exit; } ## --- 管理モード sub admin { if ($FORM{'action'}) { if ($pwd ne "$pass") { &error("パスワードが違います。","no"); } } &header; print "[メニューに戻る]\n"; print "

    \n"; print "管理用画面\n"; print "

    \n"; # 入室画面 if ($FORM{'action'} eq '') { print "処理を選択し、パスワードを入力してください\n"; print "

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

    削除\n"; print "推奨\n"; print "

    "; print "\n"; print "



    \n"; &footer; exit; } open(IN,"$logfile") || &error("Can't open $logfile","no"); @lines = ; close(IN); # ログ容量を算出 $size = -s $logfile; print "

    \n"; print "■ログ容量：$sizeBytes
    \n"; if ($FORM{'do'} eq 'del') { print "■削除用チェックボックスにチェックを入れ、処理ボタンを押してください。
    \n"; } elsif ($FORM{'do'} eq 'rec') { print "■推奨マークを付加する場合にはチェックボックスにチェックを入れてください。
    \n"; } print "
    \n"; print "

    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
    \n"; print "
    \n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; if ($FORM{'do'} eq 'del') { print "\n"; } elsif ($FORM{'do'} eq 'rec') { print "\n"; } print "\n"; if ($part eq "") { $part = 0; } foreach $line (@lines) { ($no,$lpart,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line); if ($part ne "$lpart") { next; } ($dt,$dmy) = split(/\(/, $dt); $name = "$name"; $sub2 = $sub; if (length($sub) > 20) { $sub2 = substr($sub2,0,18); $sub2 = $sub2 . '..'; } $sub = "$sub2"; if (length($msg) > 40) { $msg = substr($msg,0,38); $msg = $msg . '..'; } $msg =~ s/
    / /g; print "\n"; } print "
    削除推奨タイトルコメントアクセス管理者ホスト名登録日
    \n"; print "$sub "; if ($rec) { print ""; } print "$msg$axs$name"; print "$ho$dt

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

    \n"; &footer; exit; } ## --- 管理者一括削除／推奨マーク付加処理 sub admin_edit { if ($pwd ne "$pass") { &error("パスワードが違います。","no"); } # ロック開始 if ($lockkey == 1) { &lock1; } elsif ($lockkey == 2) { &lock2; } open(IN,"$logfile") || &error("Can't open $logfile","lock"); @lines = ; close(IN); ## 削除処理 if ($FORM{'do'} eq 'del') { @new=(); foreach $line (@lines) { $dflag=0; ($no,$part,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line); foreach $del (@delete) { if ($no eq "$del") { $dflag=1; last; } } if ($dflag == 0) { push(@new,$line); } } ## 推奨マーク付加処理 } elsif ($FORM{'do'} eq 'rec') { @new=(); foreach $line (@lines) { ($no,$part,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line); foreach (@recs) { if ($no eq "$_") { if ($rec == 0) { $rec = 1; } else { $rec = 0; } $line = "$no<>$part<>$sub<>$hp<>$name<>$email<>$pw<>$msg<>$dt<>$ts<>$rec<>$axs<>$ho<>\n"; last; } } push(@new,$line); } } # ログを更新 open(OUT,">$logfile") || &error("Can't write $logfile","lock"); print OUT @new; close(OUT); # ロック解除 unlink($lockfile) if (-e $lockfile); # 初期画面に戻る &admin; } ## --- フォームからのデータ処理 sub decode { if ($ENV{'REQUEST_METHOD'} eq "POST") { if ($ENV{'CONTENT_LENGTH'} > 51200) { &error("投稿量が大きすぎます。","no"); } read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # 文字コード変換 &jcode'convert(*value,'sjis'); # タグ処理 $value =~ s/\"/"/g; $value =~ s//>/g; # 削除／推奨マーク処理 if ($name eq 'del') { push(@delete,$value); } elsif ($name eq 'rec') { push(@recs,$value); } $FORM{$name} = $value; } $name = $FORM{'name'}; $msg = $FORM{'msg'}; $msg =~ s/\r\n/
    /g; $msg =~ s/\r|\n/
    /g; $email = $FORM{'email'}; $url = $FORM{'url'}; $url =~ s/^http\:\/\///; $mode = $FORM{'mode'}; $pwd = $FORM{'pwd'}; $sub = $FORM{'sub'}; $part = $FORM{'part'}; $links = $FORM{'links'}; $page = $FORM{'page'}; } ## --- HTMLのヘッダ sub header { print "Content-type: text/html\n\n"; print <<"EOM"; $title EOM if ($bground) { print "\n"; } else { print "\n"; } } ## --- HTMLのフッタ sub footer { # 著作権表示（絶対に削除しないでください） print "

    \n"; print "- Cosmo Navi -\n"; print "

    \n"; print "\n"; } ## --- パスワード暗号処理 sub passwd_encode { $now = time; ($p1, $p2) = unpack("C2", $now); $wk = $now / (60*60*24*7) + $p1 + $p2 - 8; @saltset = ('a'..'z','A'..'Z','0'..'9','.','/'); $nsalt = $saltset[$wk % 64] . $saltset[$now % 64]; $encode_pwd = crypt($pwd, $nsalt); } ## --- パスワード照合処理 sub passwd_decode { if ($encode_pwd =~ /^\$1\$/) { $crptkey = 3; } # FreeBSDサーバ対応 else { $crptkey = 0; } $check = "no"; if (crypt($pwd, substr($encode_pwd,$crptkey,2)) eq "$encode_pwd") { $check = "yes"; } } ## --- ロックファイル（symlink関数） sub lock1 { local($retry) = 5; while (!symlink(".", $lockfile)) { if (--$retry <= 0) { &error("LOCK is BUSY","lock"); } sleep(1); } } ## --- ロックファイル（open関数） sub lock2 { $lflag = 0; foreach (1 .. 5) { unless (-e $lockfile) { open(LOCK,">$lockfile") || &error("Write Error : $lockfile","lock"); close(LOCK); $lflag = 1; last; } else { sleep(1); } } if ($lflag == 0) { &error("LOCK is BUSY","lock"); } } ## --- エラー処理 sub error { if ($_[1] eq "lock" && -e $lockfile) { unlink($lockfile); } if (-e $tmpfile) { unlink($tmpfile); } &header; print "

    ERROR !

    \n"; print "

    $_[0]\n"; print "

    \n"; print "\n"; exit; } ## --- ホスト名取得 sub get_host { $host = $ENV{'REMOTE_HOST'}; $addr = $ENV{'REMOTE_ADDR'}; if ($get_remotehost) { if ($host eq "" || $host eq "$addr") { $host = gethostbyaddr(pack("C4",split(/\./,$addr)),2); } } if ($host eq "") { $host = $addr; } } ## --- メール送信処理 sub mail_to { unless (-e $sendmail) { &error("sendmailのパスが不正です。","no"); } # メールタイトル $mail_sub = "登録完了通知"; # メール本文 $mail_msg = <<"EOM"; $nameさま この度は、$title への登録をありがとうございました。 登録内容は以下のとおりですので、ご確認ください。 ■登録日時：$date ■ホスト名：$host ■管理者名：$name ■Ｅメール：$email ■タイトル：$sub ■ＵＲＬ　：http://$url ■管理パスワード：$pwd ■紹介コメント $msg なお、今後登録内容の修正や削除が発生する場合には、登録頂いたパスワード にて全て行うことができますので、パスワードは大切に保管しておいて下さい。 _/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/ $title管理人 $admin_name E-Mail: $admin_mail Home: $admin_url EOM # JISコードへ変換 &jcode'convert(*mail_sub,'jis'); &jcode'convert(*mail_msg,'jis'); # コメント内の改行とタグを復元 $mail_msg =~ s/
    /\n/ig; $mail_msg =~ s/"/\"/g; $mail_msg =~ s/<//g; # メール処理 if ($mailing == 2) { $mailto = "$email" . ',' . "$admin_mail"; } else { $mailto = $email; } if (open(MAIL,"| $sendmail $mailto")) { print MAIL "To: $email\n"; print MAIL "From: $admin_mail\n"; print MAIL "Bcc: $admin_mail\n" if ($mailing == 2); print MAIL "Subject: $mail_sub\n"; print MAIL "MIME-Version: 1.0\n"; print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n"; print MAIL "Content-Transfer-Encoding: 7bit\n"; print MAIL "X-Mailer: $ver\n\n"; print MAIL "$mail_sub\n"; print MAIL "--------------------------------------------------------\n"; print MAIL "$mail_msg\n"; close(MAIL); } } ## --- アイコンの定義および表示 sub icons { if ($_[0] eq 'rank') { if ($times - $ts{$_} < $newtime*24*60*60) { print " "; } if ($rec{$_} == 1) { print " "; } } else { if ($times - $ts < $newtime*24*60*60) { print " "; } if ($rec == 1) { print " "; } } } ## --- 時間の取得 sub get_time { $ENV{'TZ'} = "JST-9"; # タイムゾーンを日本時間へ $times = time; ($sec,$min,$hour,$mday,$mon,$year,$wday,$dmy,$dmy) = localtime($times); @week = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); # 日時のフォーマット $date = sprintf("%04d\/%02d\/%02d\(%s\)%02d\:%02d", $year+1900,$mon+1,$mday,$week[$wday],$hour,$min); } ## --- バックアップ処理 sub backup { # キーファイルを読み込み分解 open(BK,"$bkup") || &error("Can't open $bkup","no"); $BKUP = ; close(BK); ($today,$key) = split(/\:/, $BKUP); # 時間を取得 &get_time; # 日付が異なればバックアップ処理を行う if ($mday ne "$today") { # テンポラリーファイルを定義 $temp = "$$"; if ($temp eq '') { srand; $temp = 1000000000000000 * rand; } $tmpfile = "$lockdir\/$temp\.tmp"; # バックアップファイル $bakfile = "$key\.bak"; # ロック開始 if ($lockkey == 1) { &lock1; } elsif ($lockkey == 2) { &lock2; } # 一時ファイルに書き出し open(IN,"$logfile") || &error("Can't open $logfile","lock"); open(OUT,">$tmpfile") || &error("Can't write Temp File","lock"); while ($_ = ) { print OUT $_; } close(OUT); close(IN); # 一時ファイルからバックアップファイルにリネーム rename($tmpfile,$bakfile) || &error("Rename Error","lock"); chmod (0666,$bakfile); if (-e $tmpfile) { unlink($tmpfile); } # ローテーションキーを定義 if ($key eq 'A') { $newkey = 'B'; } elsif ($key eq 'B') { $newkey = 'C'; } else { $newkey = 'A'; } # キーファイルを更新 open(BK,">$bkup") || &error("Can't write $bkup","lock"); print BK "$mday\:$newkey"; close(BK); # ロック解除 if (-e $lockfile) { unlink($lockfile); } } else { return; } } ## --- 桁区切り処理 sub filler { local($_) = $_[0]; 1 while s/(.*\d)(\d\d\d)/$1,$2/; return $_; }