#!/usr/local/bin/perl

# =============================================================
# 別サーバにおいてある画像ファイルなどを、ダウンロードしてきて保存するCGI。
# MacPerl 5.2/5.6で動作する。
# 
# ----------------------------------------------------------------------------------------
# ver.0.12　2005/11/5
# 　・取得URL欄が空かどうかチェックを追加。
# 　・ファイルを取得できなかった場合、正常に取得できたように表示されるバグを修正。
# ----------------------------------------------------------------------------------------
# ver.0.11　2005/11/3
# 　・メール送信で無意味な内容（ファイルのタイプ）が送信されるバグを修正。
# ----------------------------------------------------------------------------------------
# ver.0.1　2005/11/
# 　・最初のバージョン
# ----------------------------------------------------------------------------------------
# 水沢・penguin-19・和彦
# 配布場所　http://mizusawa.no-ip.info:8080/fileget/index.html
# フリーウェアです。私用・商用を問わず自由に利用・改造・改造品の再配布ができます。
# ただし、これを使って被ったいかなる損害も補償されません。
# =============================================================

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

$cginame = "fileget.acgi"; # このCGIの名前。必ず変更すること。

# ダウンロードを許可するファイルの拡張子を半角スペースで区切って指定
# .txtや.htmlも必要に応じて追加できる。「.」を忘れずに。
$suffix = ".jpg .jpeg .gif .png .html .htm .shtml .txt .js .css .cgi .acgi"; 

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

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

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

# =============================================================
# 　メインルーチン
# =============================================================
use LWP::Simple; # ソースとなるHTMLを取ってくるのに必要
require 'jcode.pl'; 
$lang = "euc"; # このスクリプトの文字コード

&input_get; # 入力内容を得る
$orgurl = $in{'orgurl'}; # 元ファイルのURL
	$file = $orgurl;
	$file =~s/.*[\\\/]//;	# ファイル名の取り出し
$savedir = $in{'savedir'}; # 保存ディレクトリ
$overwrite = $in{'overwrite'}; # 上書き許可 ok/no
$pass = $in{'pass'}; # パスワード
$admin = $in{'admin'}; # 管理者名
$mode = $in{'mode'}; # モード

if($mode eq ""){ # modeが空なら初期画面
	# クッキー取り出し。未実装。
	&startpage; # 初期画面表示
} else {
	if($mode eq "getfile"){ # 実行モード
		# クッキー出力。未実装。
		&check_etc ; # いろいろチェックして
		&getfile ; # 合格ならファイルを取ってくる
		# 結果表示
	} else {
		# ここに来たら変。
		&print_page("エラー","modeエラーです。$mode") ; 
	}
}

exit;

# =============================================================
# 　以下、サブルーチン
# =============================================================

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

	# パスワードのチェック==============================
	if($passwd ne $pass){
		&print_msg("エラー","パスワードが違います。") ;
	}
	
	# 取り出し先URLのチェック==============================
	if ($orgurl eq ""){
		&print_msg("エラー","ファイルの取得先URLが空です。") ;
	}

	# ディレクトリ名のチェック==============================
	if ($savedir eq ""){
		&print_msg("エラー","ディレクトリ名が空です。ルートディレクトリには保存できません。") ;
	}
	
	# ディレクトリをMACタイプに変換==============================
	$macdir = ":".$savedir ; # 頭に:を追加
	$macdir =~ s/\//\:/g ; # /を:にする
	
	# ディレクトリが存在するかチェック==============================
	if(-d "$macdir"){
		$macdir = "$macdir$file" ; # 存在する。ファイルを追加
	} else {
		&print_msg("エラー","措定されたディレクトリは存在しません。<br>$savedir") ;
	}
	
	# ファイル拡張子のチェック==============================
	if ($file) {
		$flag = "";
		foreach $tmp (split(/ +/, $suffix)) {# 拡張子を分解する
			$tmp =~ s/\./\\./g ; # 正規表現に
			if( $file =~ m/$tmp$/) {$flag = "1";} # 合致したらフラグをたてる
		}
		if ($flag ne "1") { # 拡張子がなかったら
			&print_msg("エラー","許可されていない拡張子です。「$file」") ;
		}
	} else {
			&print_msg("エラー","ファイルが指定されていません。");	
	}
	
	# 同名ファイルが存在するかチェック==============================
	if($overwrite eq "no"){ # 上書き禁止の場合
		if(-e "$macdir"){
			# 存在する。
			&print_msg("エラー","措定されたファイルはすでに存在します。<br>$savedir$file") ;
		}
	}
}

# ===================================
# ファイルをダウンロードして保存
sub getfile{
	my $allfile = get($orgurl) ; # ファイルを取ってくる
	 if ($allfile eq ""){&print_msg("エラー","ファイルを取得できませんでした。取得先URLを確認してください。<p>　$orgurl");}
	&write_file("$macdir","$allfile","1"); # 保存

	if ($mailto ne ""){ &mail_to;}# メール送信
	if($logfile ne ""){&print_log;} # ログ出力

	my $html = "";
	$html .= "<p>正常に保存できました。\n";
	$html .= "<p>保存ファイルの確認　<a href=\"$savedir$file\">$savedir$file</a>\n";
	&print_msg("正常に保存できました。","$html");
}

# ===================================
# ファイルの書き出し
# &write_file(ファイル名,内容,モード); のように呼び出す。
# モードは0で上書き、1で追記
sub write_file {
	my $filename = @_[0];
	my $content = @_[1];
	my $mode = @_[2];
	# 書き込みファイルのオープン
	if ($mode eq "0") { # 上書き
		open (FILE,">$filename")|| &print_msg("エラー","ファイル「$filename」に出力できません。");
	} else {
		if ($mode eq "1") { # 追記
			open (FILE,">>$filename")|| &print_msg("エラー","ファイル「$filename」に出力できません。");
		}
	}
	print (FILE "$content") ; # ファイルに出力
	#ファイルのクローズ
	close (FILE) ;
}

# ===================================
# 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 {
		$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 mail_to{
	$mailSubject = "【ファイルがアップされました。】$file";
	$mailBody = "　ファイルがアップロードされました。\n\n　保存場所とファイル名は$savedir$fileです。\n"; 

&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
}

# ログ出力==============================
sub print_log{
	&get_day; # 時刻の取得
	my $host = $ENV{'REMOTE_HOST'}; # ホスト名
	my $addr = $ENV{'REMOTE_ADDR'}; # IPアドレス
	$logdata = "$this_day\t"; # 日時
	$logdata .= "$host\t"; # ホスト名
	$logdata .= "$addr\t"; # IPアドレス
	$logdata .= "$savedir\t"; # 保存位置
	$logdata .= "$file\n"; # ファイル名
	open (LOG, ">>$logfile")  || &print_msg("エラー","ログファイルを保存できません。");
		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形式
}

# =========================================================
# 　以下、画面表示関係
# =========================================================

# ===================================
# 画面出力
# &print_msg("タイトル","メッセージ");　のように使う
sub print_msg{
	my $title = $_[0];
	my $msg = $_[1];
print "Content-type: text/html\n\n";
print <<"_HTML_";
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=EUC-JP">
<TITLE>$title</TITLE>
</HEAD>
<BODY>
<h1>$title</h1>
<P>
　$msg
<P><hr>
<p align="center"><a href="JavaScript:history.go(-1)">前の画面に戻る</a>
_HTML_
exit;
}

# 初期画面の生成　==============================
# &startpage; で呼び出す。
sub startpage{
	my $html = "";# 初期化
	$html .= "<form action=\"$cginame\" enctype=\"x-www-form-urlencoded\" method=\"post\">\n";
	$html .= "<input name=\"mode\" type=\"hidden\" value=\"getfile\">\n";
	$html .= "<p>●取ってくるファイルのURL<br>\n";
	$html .= "転送可能なファイルは「$suffix」です。<br>\n";
	$html .= "例：http://www.aaa.co.jp/〜/xxx.jpg</p>\n";
	$html .= "<input name=\"orgurl\" type=\"text\" size=\"60\"></p>\n";
	
	$html .= "<p>●保存ディレクトリ（最期に/を忘れずに）<br>\n";
	$html .= "例：aaa/bbb/img/</p>\n";
	$html .= "<p><input name=\"savedir\" type=\"text\" size=\"60\"></p>\n";
	
	$html .= "同名ファイルの上書きを許可するか<br>\n";
	$html .= "<select name=\"overwrite\">\n";
	$html .= "<option selected  value=\"ok\">許可する\n";
	$html .= "<option value=\"no\">許可しない\n";
	$html .= "</select><p>\n";
	
	$html .= "<p>●管理者名</p>\n";
	$html .= "<p><input name=\"admin\" type=\"text\" size=\"30\"></p>\n";
	$html .= "<p>●管理者パスワード</p>\n";
	$html .= "<p><input name=\"pass\" type=\"password\" size=\"30\"></p>\n";
	
	$html .= "<p><input name=\"name\" type=\"submit\" value=\"送信\">\n";
	$html .= "</form>\n";

	&print_msg("ファイルを指定してください。","$html"); # 表示して終わり。
}