#!/usr/bin/perl

################## 設定項目 ######################

use DBI;
$dbuser = 'beyond';
$dbpass = 'taka202';

require '../jcode.pl';
$script = "./urldel.cgi";
$domfile = "../dat/alldomain.dat";
$ipfile = './addr/url.dat';

$lockfile = './lock/url.lock';

# リファラー用
$base_url = "http://www.beyondnetwork.com/";

# 戻り先
$home = '../index.html';

# sendmailのパス
$sendmail = '/usr/sbin/sendmail';

# ヘッダーファイル
$headerfile = '../header.html';

# 送信先メールアドレス
$mailto = 'luca@beyondnetwork.com';

################## メイン処理 ######################
&decode;
if ($in{'mode'} eq "delete") { &delete; }
if ($in{'mode'} eq "kaijo") { &kaijo; }
&html;

################## ヘッダー表示 ####################
sub header {
	print "Content-type: text/html\n\n";

	open (OUT, "$headerfile") || &error("ヘッダーファイルが開けませんでした");
	while (<OUT>) {
		print $_;
	}
	close(OUT);
}

################## フッター表示 ####################
sub footer {
	print "</TD><TD width=2 bgcolor=#0072BC></TD>\n";
	print "</TR></TABLE>\n";
	print "</body>\n</html>\n";
}

################## HTML表示 ####################
sub html {

&header;
print <<"EOM";
<DIV align=center><br>
<table border=0 cellpadding=0 cellspacing=0><TR><TD>


<table border=0 cellpadding=0 cellspacing=0>
  <tr><td width=550 height=20 bgcolor="#6666CC">
  &nbsp;<font color="#FFFF99">■</font> <font color="#FFFFFF"><b>転送URLのご解約</b></font>
  </td></tr>
</table><br>

転送URLをご解約される場合は、ご利用の転送URLとパスワードを入力して<br>
「解約する」ボタンをクリックしてください。<br><br><br>


<form action="$script" method="POST">
  <input type=hidden name=mode value="delete">
  <table border=0 cellpadding=3>
<tr><td valign=top height=40><b>ご利用のURL</b>&nbsp;&nbsp;</td>
<td valign=top>
http://<select name="domain">
EOM

	open(IN,"$domfile") || &error("Open Error : domain file");
	@dom = <IN>;
	close(IN);

	foreach (@dom) {
		chomp $_;
		print "<option>$_</option>\n";
	}

print <<"EOM";
    </select>/<input type=text name="acount" size=16>
    </td></tr>
    <tr><td><b>パスワード</b></td><td><input type=password name="pass" size=12 maxlength=15></td></tr>
  </table>
<br><br>
<center><input type="submit" value=" 解約する "></center>

</form>
</TD></TR></TABLE>
<br><br>
</DIV>
EOM
&footer;
exit;
}

################## 転送URLの解約処理 ####################
sub delete {

	if ($in{'acount'} eq "") { &error("ご利用のURLを入力してください。"); }
	if ($in{'pass'} eq "") { &error("パスワードを入力してください。"); }

	# アクセスチェック
	# $ref_url = $ENV{'HTTP_REFERER'};
	# $ref_url =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	# if ($ref_url !~ /$base_url/i) { &error("不正なアクセスです"); }

	# 時間とホストを取得
	&get_time;
	&get_host;

	# ロック処理
	&lock;

	$domain = "$in{'domain'}\/$in{'acount'}";

	$db = DBI->connect('DBI:mysql:BEYOND:localhost', $dbuser, $dbpass);
	$sth = $db->prepare("select gourl,pass from URL where domain=\'$domain\'");
	$sth->execute;
	@data = $sth->fetchrow_array;

	if ($data[0] eq "") { &error("ご入力されたURLは登録されていません。"); }
	if ($data[1] ne $in{'pass'}) { &error("パスワードが認証されませんでした。"); }

	$userdir = "/home/sites/$in{'domain'}/public_html/$in{'acount'}";
	if (-e $userdir) {
		unlink("$userdir/index.html") || &error("インデックスファイルの削除に失敗しました");
		rmdir($userdir) || &error("ユーザーディレクトリの削除に失敗しました");
	}

	$sth = $db->prepare("delete from URL where domain=\'$domain\'");
	$sth->execute;

	$sth->finish;
	$db->disconnect;

	# IPアドレスを削除
	open(IN,"$ipfile") || &error("Open Error : Address file");
	@adat = <IN>;
	close (IN);

	@new = ();
	foreach (@adat) {
		($ip,$ml) = split(/<>/, $_);
		if ($ip eq $addr || $ml eq $mail1) { next; }
		else { push (@new, $_); }
	}
	open(OUT,">$ipfile") || &error("Write Error : Address file");
	print OUT @new;
	close(IN);

	# ロック解除
	&unlock;

	# クッキーの削除
	&del_cookie;

	$mail_body = "転送URLのご解約\n\n";
	$mail_body .= "送信日時：$date\n";
	$mail_body .= "ブラウザ：$ENV{'HTTP_USER_AGENT'}\n";
	$mail_body .= "ホスト名：$host\n\n";
	$mail_body .= "利用アドレス：http://$in{'domain'}/$in{'acount'}\n\n";
	$mail_body .= "パスワード：$in{'pass'}\n\n";

	$subject = "転送URLのご解約";
	&jcode'convert(*subject,'jis');

	open(MAIL,"| $sendmail -t") || &error("メール送信に失敗しました");
	print MAIL "To: $mailto\n";
	print MAIL "From: $mail\n";
	print MAIL "Subject: $subject\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_body\n";
	close(MAIL);

# 完了メッセージ
&header;
print <<"EOM";
<br><br><br>
<div align=center>
<font size=3>
ご利用ありがとうございました。<br><br>
転送URLのご利用を解除させていただきました。<br><br>
</font>

<a href="$home">[もどる]</a>
EOM
&footer;
exit;
}

################## エラー処理 ####################
sub error {
	&unlock;
	&header;
	print "<DIV align=center><br><br><br>\n";
	print "<font size=3><b>ERROR</b>：<font color=red>$_[0]</font></font><br><br><br>\n";
	print "<a href=\"javascript:history.back()\">[もどる]</a>\n";
	print "</DIV>\n";
	if ($sth) {
		$sth->finish;
		$db->disconnect;
	}
	&footer;
	exit;
}

################## デコード処理 ####################
sub decode {

	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		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;

		# 文字コード変換 (Shift-JISコード)
		&jcode'convert(*value,'sjis');

		$in{$name} = $value;
	}
}

################## 時間の取得 ####################
sub get_time {
	$ENV{'TZ'} = "JST-9";
	local($min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[1..6];
	local(@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 get_host {
	$host = $ENV{'REMOTE_HOST'};
	$addr = $ENV{'REMOTE_ADDR'};

	if ($host eq "" || $host eq $addr) {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2) || $addr;
	}
}

##################  ロック処理  ########################
sub lock {
	# 1分以上古いロックは削除する
	if (-e $lockfile) {
		local($mtime) = (stat($lockfile))[9];
		if ($mtime < time - 60) { &unlock; }
	}
	local($retry) = 5;

	while (!mkdir($lockfile, 0755)) {
		if (--$retry <= 0) { &error("ただいま混み合っております。しばらく時間をおいてからお申\し込みください"); }
		sleep(1);
	}
	$lockflag=1;
}

##################  ロック解除  ########################
sub unlock {

	rmdir($lockfile);
	$lockflag=0;
}

##################  クッキーの削除  ####################
sub del_cookie {
	local($gmt, $cook, @w, @m, @t);

	@w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	@m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
	@t = gmtime(time - 1);
	$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
			$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);

	print "Set-Cookie: BEYOND_URL=check; expires=$gmt\n";
}

##################  凍結解除  ####################
sub kaijo {
	# ホストを取得
	&get_host;

	# IPアドレスを削除
	open(IN,"$ipfile") || &error("Open Error : Address file");
	@ip = <IN>;
	close (IN);

	@new = ();
	foreach (@ip) {
		chomp($_);
		if ($addr eq $_) { next; }
		else { push (@new, "$_\n"); }
	}
	open(OUT,">$ipfile") || &error("Write Error : Address file");
	print OUT @new;
	close(IN);

	# クッキーの削除
	&del_cookie;

	&error("凍結解除しました");
}