#!/usr/bin/perl --
#
# MAIL FROM: のドメイン名の IP アドレス検査
#	Sat,11 Dec,2004 - Tue,21 Dec,2004
#	Copyright(C)2004 G-HAL
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# 概要:
#	　envelope from: のドメイン部分を正引きし IP アドレスを取得、
#	/etc/mail/access から該当 IP アドレスを検索し、
#	REJECT / DISCARD の該当があれば、REJECT / DISCARD を実行し、
#	該当が無ければ、組み込み検査(Basic_check_mail)へ移行します。
#
#
# 備考:
#	　/etc/mail/access の記述は、
#	From:[0.0.0.0]	REJECT
#	の様に、先頭に From: を付け、
#	IP アドレスを括弧で括って記述します。
#
#	　/etc/mail/access を変更した後は、
#	makemap hash /etc/mail/access < /etc/mail/access
#	makemap dbm /etc/mail/access < /etc/mail/access
#	等の、データベース更新作業をお忘れなく。
#
#
# バグ:
#	　Net::DNS モジュールがインストールされていなかった場合、
#	何が起こるかわかりません。
#
#	　ドメイン名とドメイン名に対応する mx が異なる場合、
#	最高優先順位の mx のみを検索します。
#
#
# 参考：
#	http://www.i-say.net/cgi/tips_view.php3?id=22
#	man Net::DNS::Resolver
#
#
# 使用法:
#
#   1) 本スクリプトを /etc/mail/resolv.pl に保存し、実行権限を付ける。
#   2) sendmail.mc ファイルの MAILER(*)dnl 定義以降に、
#	以下の定義を追加し、sendmail.cf を再作成する。
# 
#	dnl
#	dnl MAIL FROM: (envelope from)の検査
#	dnl
#	LOCAL_CONFIG
#	Kipresolv program /etc/mail/resolv.pl
#	
#	LOCAL_RULESETS
#	SLocal_check_mail
#	R$*			$: $(ipresolv $1 $)
#	dnl R<NO>$*			$#error $@ 5.7.1 $: "550 Access denied"
#	dnl R<FAIL>$*		$#error $@ 5.7.1 $: "550 Access denied"
#	R<$+>$*<@$+>		$: <@> <$1> <$2> $| $>SearchList <+ From> $| <D:$3> <>
#	R<@> <$+> <$*> $| <$*>	$: <$3> <$1> <$2>		reverse result
#	R<REJECT> <$*>		$#error $@ 5.7.1 $: "550 Access denied"
#	R<DISCARD> <$*>		$#discard $: discard
#	R<$+> <$*>		$@ <OKR>	ip ok: stop
#

use Net::DNS;

my $email = $ARGV[0];	#チェックする対象のメールアドレス
my $return;

$return = &check_email($email);
print $return;

exit 0;



sub check_email(){
	my $email = $_[0];
	my $domain = "";
	my $name = "";
	if ($email =~ /^([^@<]+)<?\@?\[?([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})\]?>?$/) {
		# 元から IP で書かれていた
		$name = $1;
		return "<IP>".$1."<@[".$2."]>";
	}elsif ($email =~ /^([^@<]+)<?\@?([-\.0-9a-zA-Z]+)>?$/) {
		# ドメイン部分を取得
		$name = $1;
		$domain = $2;
	}else{
		# ドメイン部分の取得失敗
		return "<FAIL>".$email."";
	}
	{
		# MXレコードの取得
		my $r = new Net::DNS::Resolver;	# 逆引きの結果オブジェクト
		my @mx = mx($r, $domain);
		if (@mx) {
			my $prefernce = 65535;
			foreach $_(@mx) {
				if( $_->preference < $prefernce ){
					$prefernce = $_->preference;
					$domain = $_->exchange;
					#print $prefernce." ".$domain."\n";
				}
			}
		}
		# Aレコードの取得
		my $s = $r->search($domain);
		if ($s) {
			foreach $_($s->answer) {
				if ($_->type eq "A") {
					return "<OK>".$name."<\@\[".$_->rdatastr."\]\>";
				}
			}
		}
	}
	return "<NO>".$email."";	# MX,Aレコード取得できず
}

__END__
# [ EOF ]