# ver0.12　2005/11/1
# ・MacPerl 5.6で動作。
# ・Windowsからもアップロード可能。
# ・ログ出力が上書きモードになっていたバグを修正。出力内容の順番を変更。
# ver0.1　2005/10/25
# ・Windowsからはアップできない。
# 水沢・penguin-19・和彦

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

$callurl = "http://xxxx.com/macupload/macupload.html"; # このCGIを呼び出すhtmlのurl

# 許可する拡張子を半角スペースで区切る。「.」を忘れずに。
$suffix = ".jpg .jpeg .gif .png .html .htm .shtml .txt"; 

$maxkirobyte = "100"; # アップできる最大ファイル容量。100kbなら100と記述

# メール送信するならUVJ Mailerに登録してあるニックネームを書く。
# 空にすると送信しない。
# また、UVJ Mailerはあらかじめ立ち上がっている必要がある。
$mailto = "ニックネーム" ; 

# メール送信するときの発信元メールアドレス。送信しないなら空でOK。
$frommail = "name\@xxxx.ne.jp"; 

# ログファイルの名前。空なら出力しない。
$logfile = "upload.log";

# ====================================================
# 　メインルーチン
# ====================================================
# モジュールの宣言
use CGI ; # CGI.pm/標準モジュール
$query = new CGI; # オブジェクトの生成

# 入力データの取得==============================
$filedata = $query->upload('upfile'); # ファイル/uploadは
$file = $query->param ('upfile'); # ファイル名
	$file=~s/.*[\\\/]//;	#ファイル名だけ取り出す
$savedir = $query->param ('savedir'); # ディレクトリ名
$adminwd = $query->param ('adminwd'); # 管理者パスワード
$overwrite = $query->param ('overwrite'); # 上書きモード

$type = $query->uploadInfo($filedata)->{'Content-Type'}; # MIME情報の取得

&check_etc ; # いろいろチェックして
&fileupload ; # 合格ならファイルをアップ

exit;

# ===================================================
# 　サブルーチン
# ===================================================

# いろいろチェック==============================
sub check_etc{
	# 呼び出したホストのチェック==============================
	$called_html = $ENV{'HTTP_REFERER'};
	if($called_html !~ m/$callurl$/ ){ # 呼び出したurlが違っていたら
		&print_page("不正なアクセスです。") ;
	}
	
	# POSTメソッド限定==============================
	if ($ENV{'REQUEST_METHOD'} ne "POST") {
		&print_page("不正なアクセスです。") ;
	}
	
	# パスワードのチェック==============================
	if($passwd ne $adminwd){
		&print_page("パスワードが違います。") ;
	}
	
	# ディレクトリ名のチェック==============================
	if ($savedir eq ""){
		&print_page("ディレクトリ名が空です。ルートディレクトリには保存できません。") ;
	}
	
	# ディレクトリをMACタイプに変換==============================
	$macdir = "::".$savedir ; # 頭に:を追加
	$macdir =~ s/\//\:/g ; # /を:にする
	
	# ディレクトリが存在するかチェック==============================
	if(-d "$macdir"){
		$macdir = "$macdir$file" ; # 存在する。ファイルを追加
	} else {
		&print_page("措定されたディレクトリは存在しません。<br>$savedir") ;
	}
	
	# ファイル拡張子のチェック==============================
	if ($file) {
		$flag = "";
		foreach $tmp (split(/ +/, $suffix)) {# 拡張子を分解する
			$tmp =~ s/\./\\./g ; # 正規表現に
			if( $file =~ m/$tmp$/) {$flag = "1";} # 合致したらフラグをたてる
		}
		if ($flag ne "1") { # 拡張子がなかったら
			&print_page("許可されていない拡張子です。") ;
		}
	} else {
			&print_page("ファイルが選択されていません。");	
	}
	
	# 同名ファイルが存在するかチェック==============================
	if($overwrite eq "no"){ # 上書き禁止の場合
		if(-e "$macdir"){
			# 存在する。
			&print_page("措定されたファイルはすでに存在します。<br>$savedir$file") ;
		}
	}
	# ファイルの大きさをチェック==============================
	$maxbyte = $maxkirobyte * 1024 ; # kbをbyteに変換
	$size = (stat($filedata))[7];# ファイルサイズ取得
	if ($size > $maxbyte) { 
		&print_page("ファイルが大きすぎます。最大 $maxkirobyte KB までです。");
	}
}

# ファイルのアップロード==============================
sub fileupload{
	open (SAVEFILE, ">$macdir") || &print_page("ファイルを保存できません。");
	
	my ($data);
	while (read ($filedata, $data, 1024)) {
		print SAVEFILE $data;
		}
	close (SAVEFILE);	
	
	if ($mailto ne ""){ &mail_to;}# メール送信
	if($logfile ne ""){&print_log;} # ログ出力

	&print_page("<p>　ファイルのアップロードが完了しました。<br>　保存場所とファイル名は<b><A HREF=\"../$savedir$file\">$savedir$file</A></b>です。<br>　ファイルタイプは<b>$type</b>です。") ;
}

# メール送信==============================
sub mail_to{
	$mailSubject = "【ファイルがアップされました。】$file";
	$mailBody = "　ファイルがアップロードされました。\n\n　保存場所とファイル名は$savedir$fileです。\n\n　ファイルタイプは$type です。"; 

&MacPerl'DoAppleScript(<<END_SCRIPT);
tell application "UVJ Mailer 3.1 PPC"

activate
send mail "$mailBody" to "$mailto" from "$frommail" subject "$mailSubject"
end tell
END_SCRIPT
}

# 画面表示==============================
# &print_page("内容") ; のように呼び出す。
sub print_page {
my $msg = $_[0];
print "Content-type: text/html; charset=euc_jp;\n\n";
print <<"_HTML_";
<html>
<head>
<title>ファイルアップロード</title>
</head>
<body>
$msg
<p align="center"><a href="JavaScript:history.go(-1)">戻る</a>
</body>
</html>
_HTML_

exit;
}

# ログ出力==============================
sub print_log{
	&get_day; # 時刻の取得
	$logdata = "$this_day\t"; # 日時
	$logdata .= "$savedir\t"; # 保存位置
	$logdata .= "$file\t"; # ファイル名
	$logdata .= "$type\n"; # タイプ
	open (LOG, ">>$logfile")  || &print_page("ログファイルを保存できません。");
		print LOG $logdata;
	close (LOG);
}

# 日時を取得　==============================
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を付ける・秒
	$this_day = "$lyear/$lmon/$lmday  $lhour:$lmin:$lsec" ; # 2002/08/06　14:05:30形式
#	$this_day = "$lyear$lmon$lmday $lhour:$lminp･$lsec" ; # 20020806 140530形式
}