#!/usr/bin/perl
#---------------------------------------------------------------------
# mbbs_logchk.cgi
#
# by mieki256
# 0.01 2004/06/30 mapbbs.cgi をコピペしながら作成開始
# lock処理とかしてないので色々危ないです。
#=====================================================================
use strict;
use File::Copy;
require "./jcode.pl";
# -------------------- 設定
my $password = 'password'; # password
my $datdir = "./log"; # 管理したいファイルがあるディレクトリ
my $backurl = "./index.html"; # 戻り先のURL
my $backtitle = "TOPページ"; # 戻り先のページ名
my $cgiurl = "./mbbs_logchk.cgi"; # このスクリプト名
my $ver = "Map BBS Log File Manager 0.01"; # このスクリプトの名前
# ファイル種類
# ここに記述されたファイル名文字列を含んだファイルだけが処理対象になる
# 'ファイル名:種類名' で記述。
my @kindlist = (
'mbbs_area.log:地域設定ファイル',
'mbbs_class.log:分類設定ファイル',
'mbbs_log01.cgi:ログファイル',
);
# Html Title
my $title = "$ver";
# html body
my $body = qq(bgcolor="#F5F5DC" text="black" link="blue" vlink="#800080" alink="red");
# 実際の処理を行わない(動作サンプル用)
# 0=処理をしない / 1=処理をする
my $ExecFg = 1;
# 属性変更の値
my $attr = '0666';
# 動作サンプル用
my $cgiurl_sample = "./mbbs_logchk_sample.cgi";
my $body_sample = qq(bgcolor="#B0C4DE" text="black" link="blue" vlink="#800080" alink="red");
my $password_sample = 'sample';
# -------------------- 設定ここまで
if ( !$ExecFg ) {
$cgiurl = $cgiurl_sample;
$body = $body_sample;
$password = $password_sample;
}
# main
my %FORM;
my @select_filelist = ();
my $adminfg = 0;
&HtmlOut_Header($title,$body);
my $mode = ReqCheck();
SELECT:
{
$mode eq "" && do { &PassInput; last SELECT;};
$mode eq "delete" && do { &FileDelete; last SELECT;};
$mode eq "chmod" && do { &FileChmod; last SELECT;};
$mode eq "comeback" && do { &FileComeback; last SELECT;};
$mode eq "backup" && do { &FileBackup; last SELECT;};
$mode eq "filelist" && do { &FileListDisp; last SELECT;};
$mode eq "passillegal" && do { &IllegalPass; last SELECT;};
$mode eq "unknownmode" && do { &IllegalMode; last SELECT;};
&IllegalMode;
}
&HtmlOut_backLink($backurl,$backtitle);
&HtmlOut_Footer;
exit;
# ----------------------------------------
# password 入力を求める メイン処理
sub PassInput {
&HtmlOut_ModeTitle("$ver");
&HtmlOut_PassInput;
print qq(
( 動作サンプル用 pass = '$password' )
) if !$ExecFg;
}
# ----------------------------------------
# password が違う
sub IllegalPass {
&Error("パスワードが違うか、入力されていません。");
}
# ----------------------------------------
# モードが異常
sub IllegalMode {
&Error("不正なモードが選択されました。");
}
# ----------------------------------------
# ファイル一覧表示
sub FileListDisp {
&HtmlOut_ModeTitle("ファイル一覧表示");
my @list = GetFileList();
&HtmlOut_FileList(1," 現在使用中 ",@list);
}
# ----------------------------------------
# ファイルバックアップ
sub FileBackup {
&HtmlOut_ModeTitle("現在のログをリネームしてバックアップ");
&ErrorWithFilelistBack("パスワードが違うか、入力されていません。") if !$adminfg;
my @list = GetFileList();
my @sel;
foreach my $fn (@list) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$fn);
push(@sel,join('<>',$datdir,$file)) if $alien;
}
my $cnt = 0;
my $success = 0;
&HtmlOut_ListHeader;
foreach my $fn (@sel) {
my($datdir,$file) = split(/<>/,$fn);
my($errfg,$oldfile,$newfile) = RenameCopy($datdir,$file);
&HtmlOut_ListItemUseBkup($errfg,$oldfile,$newfile);
$success++ if !$errfg;
$cnt++;
}
&HtmlOut_ListFooter($cnt,$success,"リネームバックアップ");
&HtmlOut_GotoFilelistButton;
}
# ----------------------------------------
# ファイルを書き戻し
sub FileComeback {
&HtmlOut_ModeTitle("ファイル書き戻し処理");
&ErrorWithFilelistBack("パスワードが違うか、入力されていません。") if !$adminfg;
&ErrorWithFilelistBack("ファイルが指定されていません。") if !(defined(@select_filelist));
&ErrorWithFilelistBack("ファイルが複数指定されてます。
1つのファイルしか指定できません。") if $#select_filelist != 0;
my $usefile = $select_filelist[0];
my $errfg = 0;
foreach my $k (@kindlist) {
my($name,$value) = split(/:/,$k);
if ( $usefile eq $name ) {
$errfg = 1;
last;
}
}
&ErrorWithFilelistBack("現在のログファイル自身を指定しています。") if $errfg;
my @list = GetFileList();
my $targetfile = "";
my $targetdir = "";
foreach my $f (@list) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$f);
if ( $alien && $usefile =~ /$file/ ) {
$targetfile = $file;
$targetdir = $datdir;
}
}
&ErrorWithFilelistBack("対象ログファイルが見つかりません。") if $targetfile eq "";
&HtmlOut_ListHeader;
# まず、現在のログをリネームバックアップ
my($err,$oldfile,$newfile) = RenameCopy($targetdir,$targetfile);
&HtmlOut_ListItemUseBkup($err,$oldfile,$newfile);
&HtmlOut_ListFooter(1,(($err)? 0:1),"リネームバックアップ");
&ErrorWithFilelistBack("対象ログファイルのりネームバックアップに失敗しました。
ログファイルの書き戻しを中止します。") if $err;
# copy して書き換え
my $tgt = "$targetdir/$targetfile";
my $src = "$targetdir/$usefile";
$errfg = 1;
if ( -e $tgt && -e $src ) {
if ( $ExecFg ) {
my $ret = copy $src, $tgt;
if ( $ret == 1 ) {
$errfg = 0;
}
}
}
&HtmlOut_ComebackResult($errfg,$src,$tgt);
&HtmlOut_GotoFilelistButton;
}
# ----------------------------------------
# ファイル削除 メイン処理
sub FileDelete {
&HtmlOut_ModeTitle("ファイル削除処理");
&ErrorWithFilelistBack("パスワードが違うか、入力されていません。") if !$adminfg;
&ErrorWithFilelistBack("ファイルが指定されていません。") if !(defined(@select_filelist));
my($err,@sel) = GetDelFileList(@select_filelist);
&HtmlOut_SelListHeader;
&HtmlOut_FileList(0," NG ",@sel);
&ErrorWithFilelistBack("現在使用中のファイルは削除できません。") if $err >=2;
&ErrorWithFilelistBack("削除できないファイル(所有権が無いファイル)があります。") if $err >= 1;
my $cnt = 0;
my $success = 0;
&HtmlOut_ListHeader;
foreach my $fn (@sel) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$fn);
my $errfg = 0;
my $fname = "$datdir/$file";
if ( $ExecFg ) {
unlink($fname) || ($errfg = 1);
} else {
$errfg = 1;
}
&HtmlOut_ListItem($errfg,$file);
$success++ if !$errfg;
$cnt++;
}
&HtmlOut_ListFooter($cnt,$success,"削除");
&HtmlOut_GotoFilelistButton;
}
# ----------------------------------------
# ファイル属性変更 メイン処理
sub FileChmod {
&HtmlOut_ModeTitle("ファイル属性変更処理");
&ErrorWithFilelistBack("パスワードが違うか、入力されていません。") if !$adminfg;
&ErrorWithFilelistBack("ファイルが指定されていません。") if !(defined(@select_filelist));
my($err,@sel) = GetChgFileList(@select_filelist);
&HtmlOut_SelListHeader;
&HtmlOut_FileList(0,"所有権がありません",@sel);
&ErrorWithFilelistBack("属性変更できないファイル(所有権が無いファイル)があります。") if $err;
my $cnt = 0;
my $success = 0;
&HtmlOut_ListHeader;
foreach my $fn (@sel) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$fn);
my $errfg = 0;
my $fname = "$datdir/$file";
if ( $ExecFg ) {
chmod( oct($attr), $fname ) || ($errfg = 1);
} else {
$errfg = 1;
}
&HtmlOut_ListItem($errfg,$file);
$success++ if !$errfg;
$cnt++;
}
HtmlOut_ListFooter($cnt,$success,"属性変更");
my($errf,@self) = GetChgFileList(@select_filelist);
&HtmlOut_ListResultHeader;
&HtmlOut_FileList(0,"所有権がありません",@self);
&HtmlOut_GotoFilelistButton;
}
# ----------------------------------------
# 指定されたファイルをリネームバックアップ
sub RenameCopy {
my($dir,$filename) = @_;
my $file = "$dir/$filename";
my $bakfile = $file . "_" . GetTimeStr();
my $errfg = 1;
if ( -e $file ) {
if ( $ExecFg ) {
my $ret = copy $file, $bakfile;
if ( $ret == 1 ) {
$errfg = 0;
chmod ( 0666, $bakfile );
}
}
}
return ($errfg,$file,$bakfile);
}
# ----------------------------------------
# 日付・時間を取得して文字列として返す
sub GetTimeStr {
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year += 1900;
$mon += 1;
my $str = "";
$str = sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $mday, $hour, $min, $sec);
return $str;
}
# ----------------------------------------
# 削除可能なファイルのリストを取得
# Ret: $err 0=Error無 / 1=Error有
# @sel ファイルリスト
sub GetDelFileList {
my(@select_filelist) = @_;
my @sel = ();
my @list = GetFileList();
my $err = 0;
foreach my $fn (@list) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$fn);
foreach my $sfn (@select_filelist) {
if ( $file eq $sfn ) {
# busy file check
if ( $alien ) {
$err |= 2;
} else {
# write check
if ( $writeok == 0 ) {
# delete NG
$alien = 1;
$err |= 1;
} else {
# delete OK
$alien = 0;
}
}
my $fileinfo = join('<>',$datdir,$file,$alien,$fkind,$permission,$writeok,$owner);
push(@sel,$fileinfo);
last;
}
}
}
return ($err,@sel);
}
# ----------------------------------------
# 属性変更可能なファイルのリストを取得
# Ret: $err 0=Error無 / 1=Error有
# @sel ファイルリスト
sub GetChgFileList {
my(@select_filelist) = @_;
my @sel = ();
my @list = GetFileList();
my $err = 0;
foreach my $fn (@list) {
my($datdir,$file,$alien,$fkind,$permission,$writeok,$owner) = split(/<>/,$fn);
foreach my $sfn (@select_filelist) {
if ( $file eq $sfn ) {
if ( $owner == 0 ) {
# not owner
$alien = 1;
$err = 1;
} else {
# owner
$alien = 0;
}
my $fileinfo = join('<>',$datdir,$file,$alien,$fkind,$permission,$writeok,$owner);
push(@sel,$fileinfo);
last;
}
}
}
return ($err,@sel);
}
# ----------------------------------------
# ディレクトリ中のファイルリストを取得
# ret: @filelist ファイルリスト情報
#
# 配列の各要素の中身は、
# $datdir ディレクトリ名
# $file ファイル名
# $alien 特殊なファイルか(0/1)
# $fkind 種類名
# $permission 属性(0xxx)
# $writeok 書込可か(0/1)
# $owner 所有してるか(0/1)
# これを '<>' で繋げてある。
sub GetFileList {
my %kind;
opendir(INDIR,"$datdir") || &Error("$datdir を開けませんでした。");
my @list = readdir(INDIR);
closedir(INDIR);
foreach my $s (@kindlist) {
my($key,$value) = split(/:/,$s);
$kind{$key} = $value if $key ne "";
}
my @filelist;
foreach my $file (sort {$a cmp $b } @list) {
my $fileinfo = "";
my $fkind = "?";
my $alien = 0;
my $permission = "";
my $writeok = 0;
my $owner = 0;
next if $file =~ /^\.{1,2}/;
foreach my $key (keys %kind) {
if ( $file =~ /$key/ ) {
$fkind = $kind{$key};
if ( $file eq $key ) {
$alien = 1;
}
last;
}
}
next if $fkind eq "?";
my $fn = "$datdir/$file";
$permission = GetPerStr($fn);
$writeok = 1 if -w $fn;
$owner = 1 if -o $fn;
$fileinfo = join('<>',$datdir,$file,$alien,$fkind,$permission,$writeok,$owner);
push(@filelist,$fileinfo);
}
return @filelist;
}
# ----------------------------------------
# file の Permission を取得
sub GetPerStr {
my($fn) = @_[0];
my ($fm,$mdo,$mdg,$mdu,$result);
$fm = (stat($fn))[2];
$mdu = $fm & 7;
$fm >>= 3;
$mdg = $fm & 7;
$fm >>= 3;
$mdo = $fm & 7;
$result = sprintf("%u%u%u",$mdo,$mdg,$mdu);
return $result;
}
# ----------------------------------------
# cgiに渡された入力値を解析
sub ReqCheck {
my $data = "";
my $method;
my $mode = "";
my $flistfg = 0;
$method = $ENV{'REQUEST_METHOD'};
if ( $method eq "GET" ) {
$data = $ENV{'QUERY_STRING'};
} elsif ( $method eq "POST" ) {
my $length = $ENV{'CONTENT_LENGTH'};
read(STDIN, $data, $length);
}
if ( $data ne "" ) {
@select_filelist = ();
my @pairs = split(/&/,$data);
foreach my $pair (@pairs) {
my($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
&jcode::convert(\$value,'euc');
$FORM{$name} = $value;
if ( $name eq "file" ) {
push(@select_filelist,$value);
} elsif ( $name eq "pass" ) {
if ( $value eq $password ) {
$adminfg = 1;
}
} elsif ( $name eq "gotofilelist" ) {
if ( $value eq "fromxxxx" ) {
$flistfg = 1;
}
} else {
if ( $mode ne "" ) {
$mode = "unknownmode";
} else {
$mode = $name;
}
}
}
}
if ( $mode eq "filelist" ) {
if ( !$flistfg ) {
$mode = "unknownmode";
}
} elsif ( $mode eq "passinput" ) {
if ( $adminfg == 1 ) {
$mode = "filelist";
} else {
$mode = "passillegal";
}
}
return $mode;
}
# ----------------------------------------
# エラーメッセージ出力(Exitする)
sub Error {
my($errmsg) = @_;
&MsgOut("エラー発生 : ",$errmsg,0,"#ff6666","#ff6666");
&HtmlOut_backLink($cgiurl,"パスワード入力画面");
&HtmlOut_Footer;
exit;
}
# ----------------------------------------
# エラーメッセージ出力(Exitする・ファイル一覧表示への戻りリンクつき)
sub ErrorWithFilelistBack {
my($errmsg) = @_;
&MsgOut("エラー発生 : ",$errmsg,0,"#ff6666","#ff6666");
&HtmlOut_GotoFilelistButton;
&HtmlOut_backLink($backurl,$backtitle);
&HtmlOut_Footer;
exit;
}
# ----------------------------------------
# エラーメッセージ出力(Exitしない)
sub ErrorNotExit {
my($errmsg) = @_;
&MsgOut("エラー発生 : ",$errmsg,0,"#ff6666","#ff6666");
}
# ----------------------------------------
# メッセージ出力
sub MsgOut{
my($msg_title,$out_msg,$border,$title_color,$msg_color,$msg_pos) = @_;
$border = "0" if $border eq "";
$title_color = "#6666cc" if $title_color eq "";
$msg_color = "#6666ff" if $msg_color eq "";
$msg_pos = 'center' if $msg_pos eq "";
print <
EOM
}
# ----------------------------------------
# HTML Header 出力
sub HtmlOut_Header {
my($title,$body) = @_;
print <
EOM
&CssOut;
print <$title
EOF
}
# ----------------------------------------
# CSS 出力
sub CssOut {
print <
EOM
}
# ----------------------------------------
# HTML Footer 出力
sub HtmlOut_Footer {
print qq(
\n$ver
);
# print "
mode : $mode
\n
\n";
# print "Form:
\n";
# while ( my($key, $value) = each(%FORM) ) {
# print "$key => $value
\n";
# }
# print "
\nFilelist:
\n";
# foreach (@select_filelist) {
# print "$_
\n";
# }
print "\n\n\n";
}
# ----------------------------------------
# [ Back ] link 出力
sub HtmlOut_backLink {
my($url,$title) = @_;
print <
EOM
}
# ----------------------------------------
# ファイルリスト一覧表示へのボタン 出力
sub HtmlOut_GotoFilelistButton {
print <
EOM
}
# ----------------------------------------
# パスワード入力欄 出力
sub HtmlOut_PassInput {
print <
パスワードを入力してください。
EOM
}
# ----------------------------------------
# ファイル一覧出力(HTML出力)
# in: $inputfg 0=一覧のみ表示 / 1=選択欄有
# $extstr 追加テキスト情報
# @list ファイルリスト
sub HtmlOut_FileList {
my($inputfg,$extstr,@list) = @_;
print qq(\n);
print qq(
\n) if $inputfg;
print qq(
\n
\n);
}
# ----------------------------------------
# 雑多な画面用出力サブルーチン
# 処理タイトル表示
sub HtmlOut_ModeTitle {
my($msg) = @_[0];
print qq($msg
\n);
}
# 選択ファイルリスト・ヘッダ
sub HtmlOut_SelListHeader {
print qq(選択されたファイル
\n);
}
# 処理ファイルリスト・ヘッダ
sub HtmlOut_ListHeader {
print qq(処理されたファイル
\n);
print qq(\n);
print qq(
\n);
}
# 処理ファイルリスト・項目
sub HtmlOut_ListItem {
my($errorfg,$file) = @_;
print qq();
print qq($file | );
print qq( ... ), (($errorfg)? "失敗" : "成功" ), qq( | );
print qq(
);
}
# 処理ファイルリスト・項目・リネームバックアップ用
sub HtmlOut_ListItemUseBkup {
my($errorfg,$oldfile,$newfile) = @_;
print qq();
print qq($oldfile | );
print qq( -> | );
print qq($newfile | );
print qq( ... ), (($errorfg)? "失敗" : "成功" ), qq( | );
print qq(
);
}
# 処理ファイルリスト・フッター
sub HtmlOut_ListFooter {
my($filecount,$success,$msg) = @_;
print qq(
\n
\n);
print qq(
$filecount ファイル中、$success ファイルに対して$msg処理が成功しました。
);
print qq(
(※ 現在、サンプルとして動作中ですので、実際の処理は行いません。)
) if !$ExecFg;
print qq(
\n);
}
# 結果ファイルリスト・ヘッダー
sub HtmlOut_ListResultHeader {
print qq(結果
\n);
}
# 書き戻し結果 出力
sub HtmlOut_ComebackResult {
my($errorfg,$src,$tgt) = @_;
print qq(結果
\n);
print qq(\n);
print qq($src -> $tgt
);
print qq(書き戻しに), (($errorfg)? "失敗" : "成功" ), qq(しました。\n);
print qq(
\n);
}