#!/usr/local/bin/perl

# サーバのファイル操作を行うCGI。ディレクトリ内の一覧・削除、名前の変更ができる。
# ファイルアップロード機能はない。
# ファイルのアップロードは、別途macupload.acgiかfileget.acgiを使ってください。
# かなり危険なCGIなので、セキュリティには十分注意が必要。
# 
# 水沢・penguin-19・和彦
# ●jcode.plが必要。
# ●このacgiはルートフォルダに置くこと。
# 
# -------------------------------------------------------------
# ver.0.2　2005/11/9
# ・ログファイル名が空でもログ出力するバグを修正。
# ・バージョン表示追加。
# -------------------------------------------------------------
# ver.0.2　2005/11/8
# ・セキュリティをさらに強化。
# 　1.呼び出し元のチェックを追加。
# 　2.各画面に名前とパスを追加し、動作のたびにこれらをチェックするようにした。
# --------------------------------------------------
# ver.0.111　2005/11/5
# 　・★重要な変更があります。ログ出力の内容を変更しました。これがセキュリティホールになる可能性有り。これ以前のバージョンをお使いの方は必ずこれまでのログファイルを削除してください。申し訳ない。
# -------------------------------------------------------------
# ver.0.11　2005/11/5
# 　・新規ディレクトリを作成する際、同名のディレクトリがある場合、ディレクトリが作成できないが、エラーが表示されないバグを修正。
# -------------------------------------------------------------
# ver.0.1　2005/11/4
# 　最初のバージョン
# 　・名前に「 ﾄ」のように半角カナがあるとうまく動作しない。
# 　・一覧表示にはリンクが生成されるが、日本語があるとリンクはうまくいかない（HTTPの仕組み上）。移動や削除は正常にできる。

# =============================================================
# 　　　変数の設定
# =============================================================
$idname = "admin"; # 管理者の名前。必ず変更すること。
$passwd = "0123"; # 管理者パスワード。必ず変更すること。

$cginame = "ftp_modoki.acgi"; # このCGIの名前。必ず類推しにくい名前に変更すること。

# サーバのURL。例：http://mizusawa.no-ip.info:8080　必要ならポート番号も記述。最後に/はいらない。
$saverurl = "http://mizusawa.no-ip.info:8080"; 

# LAN内から見たサーバのアドレス。例：http://192.168.1.1:8080　必要ならポート番号も記述。最後に/はいらない。
$lanurl = "http://192.168.1.1:8080"; 

# ログファイルの名前。空なら出力しない。また、ログはログインのみ記録。必要なければ空にしてください。
$logfile = "ftpmodoki.log";

# =============================================================
# 　　　メインルーチン
# =============================================================
$vernum = "ver.0.21";
require 'jcode.pl'; 
$lang = &getmojicode; # このスクリプトの文字コード

# 変数を得る
&input_get ; # ゲットルーチンの呼び出し
$mode = $in{'mode'};
$id = $in{'id'};
$pass = $in{'pass'};

# modeで処理を振り分け===============================
if ($mode eq ""){ # mode指定がなければ認証画面
	$aaa = "<P><center><h4>名前とパスワードを入力してください</h4>\n";
	$aaa .= "<form action=\"$cginame\" method=\"POST\">\n";
	$aaa .= "<input type=\"hidden\" name=\"mode\" value=\"login\">\n";
	$aaa .= "Login Name <input type=\"text\" name=\"id\" size=\"20\" value=\"$cookie_Id\"><br>\n";
	$aaa .= "Pass Word <input type=\"password\" name=\"pass\" size=\"8\" value=\"$cookie_pass\">　<input type=\"submit\" value=\"ログイン\">\n";
	$aaa .= "<br>$vernum\n";
	$aaa .= "</form>\n";
	&print_page("ログイン画面","$aaa") ; 
}

if($mode eq "login"){ # 認証チェックしてルート表示
	&sec_check ; # セキュリティチェック
	$thisdir = ":";
	$updir = ":";
	$do = "off";
	&form1; # formftp部生成
	$aaa = &get_list("$thisdir") ;
	$loginout = "Login しました。";
	if ($logfile ne ""){&print_log;} # ログ出力
	&print_page("ファイル一覧","$form1$aaa</form>") ; 
}

if($mode eq "move"){ # ディレクトリの移動
	&sec_check ; # セキュリティチェック
	$thisdir = $in{'thisdir'} ; # 今いるディレクトリ
	$todir = $in{'todir'} ; # 移動先/アップ用
	$filedirname = $in{'filedirname'} ; # 移動先/下り用

	# $todirが空なら下へ移動
	# $todirが:ならルートへ移動
	# $todirが:以外ならそこへ移動
	# それぞれの場合によって新しい移動先を生成する。
	if (($todir eq "" ) && ($filedirname ne "")){ # 下へ移動
		$checkdir = "$thisdir$filedirname";
		&jcode'convert( \$checkdir, "sjis" ); # 日本語に備えてsjisに戻す
		if(-d "$checkdir"){# 移動先がディレクトリかチェック
			$updir = "$thisdir";
			$thisdir = "$thisdir$filedirname";
		} else {
			&print_page("エラー","移動先はファイルです。ディレクトリを指定して下さい。<p>　$thisdir$filedirname") ; 
		}
	} else {
		if ($todir eq ":"){ # ルートへ移動
			$thisdir = ":";
			$updir = ":";
		} else {
			if ($todir ne ":"){ # ひとつ上へ移動(上)
				$thisdir = "$todir";
				$updir = &setupdir("$thisdir") ; # updirの生成
			} else {
				# ここへきたらおかしい
				&print_page("エラー","移動先の指定が変です。") ; 
			}
		}
	}

	$do = "off";
	# ディレクトリに移動
	&form1; # formftp部生成
	$aaa = &get_list("$thisdir") ;
	&print_page("ファイル一覧","$form1$aaa</form>") ; 
} 

if($mode eq "delete"){ # ファイル/ディレクトリの削除
	&sec_check ; # セキュリティチェック
	$thisdir = $in{'thisdir'} ; # 今いるディレクトリ
	$filedirname = $in{'filedirname'} ; # 対象file/dir
	$do = $in{'do'} ; # 実行するか
	$updir = &setupdir("$thisdir") ; # updirの生成

	# ファイルかフォルダか判定
	$checkdir = "$thisdir$filedirname";
	&jcode'convert( \$checkdir, "sjis" ); # 日本語に備えてsjisに戻す
	if (-d "$checkdir"){ # ディレクトリなら
		$filedir = "dir";
	} else { # ファイル
		$filedir = "file";
	}

	# $doで動作を振り分け
	if($do eq "off"){# 確認画面の表示
		$do = "off";
		$aaa = "<h3><font color=\"red\">本当に削除しますか？\n";
		$aaa .= "<p>　削除対象　$thisdir$filedirname（$filedir）</font></h3>\n";
		$aaa .= "<form name=\"formdell\" action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"id\" value=\"$id\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"pass\" value=\"$pass\">\n" ;
		$aaa .= "<input name=\"do\" type=\"hidden\" value=\"on\">\n" ;
		$aaa .= "<input name=\"mode\" type=\"hidden\" value=\"delete\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"thisdir\" value=\"$thisdir\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"filedirname\" value=\"$filedirname\">\n" ;
		$aaa .= "<input name=\"name\" type=\"submit\" value=\"削除する\">\n</form>" ;
		if($filedir eq "dir"){ # 削除対象がdirなら中味を表示
			$aaa .= "<p>　このディレクトリの中味は次の通りです。\n<p>\n" ;
			$underdir = &get_list("$checkdir") ;
			$underdir .= "<p><hr>\n" ;
		}
		&form1; # formftp部生成
		$bbb = &get_list("$thisdir") ;
		&print_page("削除の確認","$aaa$underdir$form1$bbb</form>") ; 
	} else {
		if($do eq "on"){# 削除の実行
			&dellhantei("$thisdir$filedirname"); # 削除処理開始

			# 報告画面生成
			$bbb = "<H3>削除しました。<p>　$thisdir$filedirname（$filedir）</h3>\n<hr>\n";
			# 一覧表示
			$do = "off";
			&form1; # formftp部生成
			$aaa = &get_list("$thisdir") ;
			&print_page("削除しました　$thisdir$filedirname（$filedir）","$bbb$form1$aaa</form>") ; 
		} else {
			# ここに来たら変
			&print_page("モードエラー","確認画面か実行か判定できません。") ; 
		}
	}
} 

if($mode eq "makedir"){ # ディレクトリの作成
	&sec_check ; # セキュリティチェック
	$thisdir = $in{'thisdir'} ; # 今いるディレクトリ
	$filedirname = $in{'filedirname'} ; # 対象file/dir
	$do = $in{'do'} ; # 実行するか
	$newdirname = $in{'newdirname'} ; # 新しいディレクトリの名前
	$updir = &setupdir("$thisdir") ; # updirの生成

	# $doで動作を振り分け
	if($do eq "off"){# 入力画面の表示
		$do = "off";
		$aaa = "<h3><font color=\"red\">新規作成するディレクトリの名前を入力してください。</font></h3>\n";
		$aaa .= "<p>　作成位置　$thisdir\n";
		$aaa .= "<form name=\"formdell\" action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"id\" value=\"$id\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"pass\" value=\"$pass\">\n" ;
		$aaa .= "<input name=\"do\" type=\"hidden\" value=\"on\">\n" ;
		$aaa .= "<input name=\"mode\" type=\"hidden\" value=\"makedir\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"thisdir\" value=\"$thisdir\">\n" ;
		$aaa .= "<input type=\"text\" name=\"newdirname\" size=\"30\">\n" ;
		$aaa .= "<input name=\"name\" type=\"submit\" value=\"作成する\">\n" ;
		$aaa .= "</form><p><hr>\n" ;
		&form1; # formftp部生成
		$bbb = &get_list("$thisdir") ;
		&print_page("新規ディレクトリ名の入力","$aaa$form1$bbb</form>") ; 
	} else {
		if($do eq "on"){# ディレクトリの作成
			# 同名のディレクトリがあるかチェック
			if(-e "$thisdir$newdirname"){
				&print_page("エラー","すでに同名のディレクトリ/ファイルが存在します。") ; 
			}
			chdir "$thisdir"; # 作成するところまでおりて
			mkdir "$newdirname";# ディレクトリを作成
			@dirnum = split( /:/, $thisdir ); # :で分解して
			$updirnum = @dirnum ; # 数を数える
			$upkugiri = "";
			for ($i=1;$i <= $updirnum;++$i){
				$upkugiri .=":";
			}
			chdir "$upkugiri"; # ルートに戻る

			# 報告画面生成
			$bbb = "<H3>新規ディレクトリを作成しました。<p>　$thisdir$newdirname</h3>\n<hr>\n";
			# 一覧表示
			$do = "off";
			&form1; # formftp部生成
			$aaa = &get_list("$thisdir") ;
			&print_page("新規ディレクトリを作成しました。$thisdir$newdirname","$bbb$form1$aaa</form>") ; 
		} else {
			# ここに来たら変
			&print_page("モードエラー","確認画面か実行か判定できません。") ; 
		}
	}
} 

if($mode eq "rename"){ # 名前変更
	&sec_check ; # セキュリティチェック
	$thisdir = $in{'thisdir'} ; # 今いるディレクトリ
	$filedirname = $in{'filedirname'} ; # 対象file/dir
	$do = $in{'do'} ; # 実行するか
	$newname = $in{'newname'} ; # 新しい名前
	$updir = &setupdir("$thisdir") ; # updirの生成

	# $doで動作を振り分け
	if($do eq "off"){# 入力画面の表示
		$do = "off";
		$aaa = "<h3><font color=\"red\">新しい名前を入力してください。</font></h3>\n";
		$aaa .= "<p>　名前変更対象　$thisdir$filedirname\n";
		$aaa .= "<form name=\"formdell\" action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"id\" value=\"$id\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"pass\" value=\"$pass\">\n" ;
		$aaa .= "<input name=\"do\" type=\"hidden\" value=\"on\">\n" ;
		$aaa .= "<input name=\"mode\" type=\"hidden\" value=\"rename\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"thisdir\" value=\"$thisdir\">\n" ;
		$aaa .= "<input type=\"hidden\" name=\"filedirname\" value=\"$filedirname\">\n" ;
		$aaa .= "<input type=\"text\" name=\"newname\" size=\"30\">\n" ;
		$aaa .= "<input name=\"name\" type=\"submit\" value=\"名前を変更する\">\n" ;
		$aaa .= "</form><p><hr>\n" ;
		&form1; # formftp部生成
		$bbb = &get_list("$thisdir") ;
		&print_page("新しい名前の入力","$aaa$form1$bbb</form>") ; 
	} else {
		if($do eq "on"){# 名前変更
			$oldname = "$filedirname" ; # 変換前を取っておく
			$newmotoname = "$newname" ; # 変換前を取っておく
			&jcode'convert( \$thisdir, "sjis" ); # 日本語のためにsjisに戻す
			&jcode'convert( \$filedirname, "sjis" ); # 日本語のためにsjisに戻す
				$filedirname =~ s/://g ; # ディレクトリの場合最期の:を取る
			&jcode'convert( \$newname, "sjis" ); # 日本語のためにsjisに戻す

			chdir "$thisdir"; # 作成するところまでおりて
			rename "$filedirname","$newname" || &print_page("エラー","名前を変更できませんでした。　$oldname"); # 名前変更
			@dirnum = split( /:/, $thisdir ); # :で分解して
			$updirnum = @dirnum ; # 数を数える
			$upkugiri = "";
			for ($i=1;$i <= $updirnum;++$i){
				$upkugiri .=":";
			}
			chdir "$upkugiri"; # ルートに戻る

			# 報告画面生成
			$bbb = "<H3>名前を変更しました。<p>　古い名前　$oldname<p>　新しい名前　$newmotoname</h3>\n<hr>\n";
			# 一覧表示
			$do = "off";
			&form1; # formftp部生成
			$aaa = &get_list("$thisdir") ;
			&print_page("名前を変更しました","$bbb$form1$aaa</form>") ; 
		} else {
			# ここに来たら変
			&print_page("モードエラー","確認画面か実行か判定できません。") ; 
		}
	}
} 


# ここまできたらおかしい。
&print_page("モードエラー","モードエラーです。") ; 
exit;


# =============================================================
# 　　　以下、サブルーチン
# =============================================================
# ==========================================
# スクリプトの文字コードを自動判定
# $aaa = &getmojicode;　のように呼び出す。euc/sjisが入る。
sub getmojicode {
	my $hanbetu= "文字コード判別用";
	my $code = &jcode'getcode(\$hanbetu);
	return $code;
}

# ===================================
# ファイルを削除するルーチン。
# &input_get; のように1度呼び出す。
# 削除するファイル名はdellfilename
sub dell_file{
	$dellfilename = $in{'dellfilename'} ;
	
	$dellfilename =~ s/\//:/g; # /を:に変換
	# aaa:bbbではだめで、:aaa:bbbのように頭に:が必要
	$dellfilename = ":".$dellfilename;
	
	# このファイルがあるかチェック
	if ( -e $dellfilename ) {
		unlink ($dellfilename) ; # あったら削除
		&print_page("エラーです","ファイル削除に失敗しました。指定されたファイルがありません。<br>指定されたファイル：$dellfilename<br>\n") ; 
	} else {
		# なければエラー表示
		&print_page("ファイルを削除しました","ファイルを削除しました。<br>指定されたファイル：$dellfilename<br>\n") ; 
	}
}

# ===================================
# formを受けとった後、変数を取り出すルーチン。
# &input_get; のように1度呼び出す。
# このルーチンを通った後は、$in{'変数名'}で取り出せる。
sub input_get { 
	local ($get_txt ,  @get_parts , $line , $key , $val ) ; #  $in{$key}はグローバル変数
	if( $ENV{'REQUEST_METHOD'} eq "POST" ) {
		read ( STDIN, $get_txt, $ENV{'CONTENT_LENGTH'} ); # postだったらバイト数を得る
# 	} else { # 安全のためPOSTのみで動作
# 		$get_txt = $ENV{'QUERY_STRING'}; # getだったらストリングを得る
	}
	$get_txt =~ s/\+/ /g; # 半角スペースを変換
	@get_parts = split( /&/, $get_txt ); # 内容を&を目印にパーツに分ける
	foreach $key_val_line ( @get_parts ) { # パーツごとに名前と値を取り出す
		($key, $val) = split(/=/,$key_val_line,2); # splits on the first =.　以下、cgi-lib.plからもらった
		# Convert %XX from hex numbers to alphanumeric
		$key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # デコード部分。
		$val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; #
		&jcode'convert( \$key, $lang ); # $langに合わせて漢字コードを変換
		&jcode'convert( \$val, $lang ); # $langはeuc/sjis/jisの指定ができる
		$in{$key} = $val; # 変数に格納。$in{'変数名'}で取り出せる
	}
}

# ログ出力==============================
sub print_log{
	my $thisdate = &get_day; # 時刻の取得
	my $host = $ENV{'REMOTE_HOST'}; # ホスト名
	my $addr = $ENV{'REMOTE_ADDR'}; # IPアドレス


	$logdata = "$thisdate\t"; # 日時
	$logdata .= "$host\t"; # ホスト名
	$logdata .= "$addr\t"; # IPアドレス
# 	$logdata .= "$in{'id'}\t"; # ログイン名
# 	$logdata .= "$in{'pass'}\t"; # パスワード
	$logdata .= "$loginout\n"; # 結果
	open (LOG, ">>$logfile")  || &print_msg("エラー","ログファイルを保存できません。");
		print LOG $logdata;
	close (LOG);
}

# 日時を取得　==============================
# $aaa = &get_day;　のように呼び出す
sub get_day { 
	local($lsec, $lmin, $lhour, $lmday, $lmon, $lyear);
	($lsec, $lmin, $lhour, $lmday, $lmon, $lyear) = localtime(time);
	$lyear = $lyear + 1900 ; # 年を整える
	$lmon = $lmon + 1 ; # 月を整える
	if ( length($lmon) == 1 ) { $lmon = "0$lmon" ; } # 1バイトなら頭に0を付ける・月
	if ( length($lmday) == 1 ) { $lmday = "0$lmday" ; } # 1バイトなら頭に0を付ける・日
	if ( length($lhour) == 1 ) { $lhour = "0$lhour" ; } # 1バイトなら頭に0を付ける・時
	if ( length($lmin) == 1 ) { $lmin = "0$lmin" ; } # 1バイトなら頭に0を付ける・分
	if ( length($lsec) == 1 ) { $lsec = "0$lsec" ; } # 1バイトなら頭に0を付ける・秒
	my $this_day = "$lyear/$lmon/$lmday  $lhour:$lmin:$lsec" ; # 2002/08/06　14:05:30形式
#	$this_day = "$lyear$lmon$lmday $lhour:$lminp･$lsec" ; # 20020806 140530形式
	return $this_day;
}

# ================================
# $updirの生成。
# $updir = &setupdir(今いるディレクトリ) ;　で呼び出す。
sub setupdir{
	my $updir = @_[0];
	if($updir eq ":"){ # ひとつ上がルートなら
		$updir = ":";
	} else { # ひとつ上がルート以外なら
		# $updirは　aaa:bbb:ccc:
		my @newupdir = split(/:/,$updir); # :で分解
		pop @newupdir ; # 最期を取り除く
		$updir = "";
		foreach (@newupdir){ # 再組み立て
			$updir .= "$_:";
		} 
	}
	return $updir ;
}

# ==================================================================
# 削除のためにファイルかフォルダかを判定してそれぞれの処理に飛ばす。
# ==================================================================
sub dellhantei {
	my $thisitem = @_[0];
	$printitem = "$thisitem";
	&jcode'convert( \$thisitem, "sjis" ); # 日本語に備えてsjisに戻す
	$thisitem =~ s/::/:/g ; # ::を:に
	if (-d $thisitem){ # ディレクトリの場合
		&fordellDir($thisitem) ; # ディレクトリ処理ルーチンに飛ばす
		# ディレクトリの中が空になったらディレクトリを削除
		rmdir $thisitem || &print_page("エラー","ディレクトリの削除に失敗しました。$printitem") ;  
	} else {
		if (-f $thisitem){ # ファイルの場合
			unlink $thisitem || &print_page("エラー","ファイルの削除に失敗しました。$printitem") ;  
		} else {
			# ここに来たら変。エラー処理を書く
			&print_page("判定エラー","ファイルかディレクトリか判定できません。$printitem") ; 
		}
	}
}
# ==================================================================
# ディレクトリ削除処理
# ==================================================================
sub fordellDir {
	my $dirname = @_[0];
	my (@filelist, $thislist);
	# print "\nフォルダだ $dirname\n"; # 
	# このフォルダの下のリストを取得する。
	opendir (DIR , $dirname) || &print_page("エラー","リストを得られませんでした。$dirname") ; 
		@filelist = readdir(DIR);
	closedir(DIR) ;
	# そのリストを&dellhantei(リスト);に投げ戻す。再起処理ですね。
	foreach $thislist (@filelist) {
		my $foldirlist = "$dirname:$thislist";
		$foldirlist =~ s/::/:/g ; # ::を:に
		&dellhantei("$foldirlist");
	}
}

# =====================================
# ディレクトリ内のリストを得る。
# $filelist = &get_list(ディレクトリ名) ; のように呼び出す
sub get_list {
	my($dir) = $_[0];
	my $list ="";
	my $jisdir ="$dir";
	&jcode'convert(\$jisdir, "sjis" ); # eucだと日本語ファイル名で障害がでる
	opendir (DIR , "$jisdir") || &print_page("エラー","ディレクトリを開けません。$jisdir") ; 
		my @filelist = readdir(DIR);
		foreach my $filename (@filelist) {
			&jcode'h2z_sjis(\$filename) ; # 半角カナを変換
			my $jisfilename = $filename ; # 変換前をとっておく
			&jcode'convert(\$filename, $lang );
			my $linkto = "$dir$filename" ; # $langのリンク
			$linkto =~ s/\:/\//g ; # :を/に
			$linkto =~ s/^\//\.\//g ; # 先頭の/を./に
			if ( -d "$jisdir$jisfilename" ) { # ディレクトリだったら/をつける
#				$list .="<INPUT TYPE=\"radio\" NAME=\"filedirname\" VALUE=\"$filename:\"><b><a href=\"$linkto/\">$filename/</a></b><br>\n" ;
				$list .="<INPUT TYPE=\"radio\" NAME=\"filedirname\" VALUE=\"$filename:\">$filename/<br>\n" ;
			} else { # ファイルなら
				if(-B "$jisdir$jisfilename"){ # バイナリファイルなら
					$list .="<INPUT TYPE=\"radio\" NAME=\"filedirname\" VALUE=\"$filename\"><a href=\"$linkto\">$filename</a> -B<br>\n" ;
				} else{
					$list .="<INPUT TYPE=\"radio\" NAME=\"filedirname\" VALUE=\"$filename\"><a href=\"$linkto\">$filename</a><br>\n" ;
				}
			}
		}
	closedir(DIR) ;
	return $list;
}

# =================================
# セキュリティ関係のチェック
# &sec_check ; で呼び出す。
sub sec_check{
	# 呼び出した元のチェック==============================
	$callfrom = $ENV{'HTTP_REFERER'}; # このcgiを呼び出した元
	$callurl = $ENV{'SCRIPT_NAME'}; # このcgiのパス
	my $serverflg = "";
	if($callfrom eq "$saverurl$callurl" ){ # 外からの呼び出しか
		$serverflg = "1";
	} else {
		if($callfrom eq "$lanurl$callurl" ){ # LAN内からの呼び出しか
			$serverflg = "1";
		} else {
			if($callfrom eq "http://127.0.0.1$callurl"){ # 自分自身からの呼び出しか
				$serverflg = "1";
			}
		}
	}
	if($serverflg eq ""){ # フラグが立っていなかったら
		&print_page("エラー","不正なアクセスです。") ;
	}


	# POSTメソッド限定==============================
	if ($ENV{'REQUEST_METHOD'} ne "POST") {
		&print_page("エラー","不正なアクセスです。") ;
	}
	
	# 管理者名のチェック==============================
	if($id ne $idname){
		&print_page("エラー","管理者名が違います。") ;
	}

	# パスワードのチェック==============================
	if($pass ne $passwd){
		&print_page("エラー","パスワードが違います。") ;
	}
}

# =================================================
# 　画面表示関係
# =================================================

# 画面表示==============================
# &print_page("タイトル","内容") ; のように呼び出す。
sub print_page {
	my ($title ,$msg) = @_;
	if ($lang eq "euc"){
		$cset = "EUC-JP";
	} else {
		$cset = "Shift_JIS";
	}
	print "Content-type: text/html\n\n";
print <<"_HTML_";
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=$cset">
<title>$title</title>
</head>
<body>
$msg
<P><hr>
<p align="center"><a href="JavaScript:history.go(-1)">前の画面に戻る</a>
</body>
</html>
_HTML_

exit;
}

# formftpの生成　==============================
# &form1; で呼び出す。</form>を後でつけるのを忘れずに。
sub form1{
	&jcode'convert( \$thisdir, $lang ); # 念のため
	&jcode'convert( \$updir, $lang ); # 念のため
	$form1 = ""; # 初期化/グローバル変数
# 上のディレクトリへ移動するform
	if ($thisdir ne ":"){ # ルートディレクトリでなければ
		$form1 .= "<form name=\"formmove\" action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n" ;
		$form1 .= "<input type=\"hidden\" name=\"id\" value=\"$id\">\n" ;
		$form1 .= "<input type=\"hidden\" name=\"pass\" value=\"$pass\">\n" ;
		$form1 .= "<input type=\"hidden\" name=\"mode\" value=\"move\">\n" ;
		$form1 .= "<input type=\"hidden\" name=\"thisdir\" value=\"$thisdir\">\n" ;
		$form1 .= "<select name=\"todir\">\n" ;
		$form1 .= "<option value=\":\">▲▲ルートへ\n" ;
		$form1 .= "<option value=\"$updir\" selected>▲ひとつ上へ\n" ;
		$form1 .= "</select>\n" ;
		$form1 .= "<input name=\"name\" type=\"submit\" value=\"移動\">" ;
		$form1 .= "</form>\n" ;
		$form1 .= "<p><hr></p>\n" ;
		$thisdir_p = "$thisdir"; # 表示用をセット
	} else {
		$thisdir_p = "ルートディレクトリ"; # 表示用をセット
	}
	$thisdir_p =~ s/\:/\//g ;
# 一覧に対する操作をするform
	$form1 .= "<form name=\"formftp\" action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n" ;
	$form1 .= "<h3>「<font color=\"blue\">$thisdir_p</font>」内の一覧です。</h3><p>　・ラジオボタンで選択し、操作を選んでください。<br>　・リンク先を保存すればファイルをダウンロードできます（バイナリファイル-Bはダウンできないものがあります。.jpgなどは大丈夫）。<br>　・半角カナが含まれている場合はうまく動きません。\n" ;
	$form1 .= "<!--■呼び出し元：$callfrom　CGIパス：$callurl■-->\n" ;
	$form1 .= "<input type=\"hidden\" name=\"id\" value=\"$id\">\n" ;
	$form1 .= "<input type=\"hidden\" name=\"pass\" value=\"$pass\">\n" ;
	$form1 .= "<input name=\"do\" type=\"hidden\" value=\"$do\">\n" ;
	$form1 .= "<input type=\"hidden\" name=\"thisdir\" value=\"$thisdir\">\n" ;
	$form1 .= "<p><select name=\"mode\">\n" ;
	$form1 .= "<option value=\"move\" selected>指定したディレクトリへ移動\n" ;
	$form1 .= "<option value=\"delete\">指定したファイル/ディレクトリの削除\n" ;
	$form1 .= "<option value=\"rename\">指定したファイル/ディレクトリの名前変更\n" ;
	$form1 .= "<option value=\"makedir\">ここにディレクトリを新規作成\n" ;
	$form1 .= "</select>\n" ;
	$form1 .= "<input name=\"name\" type=\"submit\" value=\"送信\">　<input name=\"name\" type=\"reset\" value=\"リセット\"><br>　※削除は確認画面が、名前変更・新規作成には入力画面がでます。</p>\n" ;
	$form1 .= "<p><hr></p>\n" ;
}