File Coverage

blib/lib/Mail/EXPN.pm

Criterion	Covered	Total	%
statement	15	64	23.4
branch	0	34	0.0
condition	0	5	0.0
subroutine	5	11	45.4
pod	0	6	0.0
total	20	120	16.6

# $Id: EXPN.pm,v 1.3 2003/02/01 10:45:49 florian Exp $

package Mail::EXPN;

use Net::DNS;
use Net::SMTP;
use IO::Socket;
require Exporter;
use strict;
use vars qw(@ISA @EXPORT_OK $BAD $VERSION $first);
@ISA = qw(Exporter);
@EXPORT_OK = qw(isfake $BAD);

$VERSION = '0.04';

$BAD = "SMTP response not understood";


sub isfake ($;$) {
	my @tokens = split(/\@/, shift);
	my $mx = shift;
	unless ($mx) {
		return 'not in user@host format' unless @tokens == 2;
		foreach (@tokens) {
			return 'contains illegal characters' if /[;()<>]/;
		}
		return 'malformed mail domain' unless ($tokens[1] =~ /\./);
		my @mx = mx($tokens[1]);
		return 'bogus mail domain' unless @mx;
		##@mx = sort { $b->preference <=> $a->preference} @mx;
		$mx = $mx[0]->exchange;
	}
	my $sock = new IO::Socket::INET("$mx:25") || return undef;
	my $result = step1($sock, join('@', @tokens));
	$sock->close;
	$result;
}

sub step1 {
	my ($sock, $email) = @_;
	return $BAD unless code($sock) == 220;
	$first = 1;
	out($sock, "HELO Mail-Check");
	return $BAD unless code($sock) == 250;
	out($sock, "EXPN $email");
	my $code = code($sock);
	return step2($sock, $email) if ($code == 502);
	return "" if ($code == 250);
	return "bogus username" if ($code == 550);
	return $BAD;
}

sub step2 {
	my ($sock, $email) = @_;
	out($sock, "VRFY $email");
	my $code = code($sock);
	return step3($sock, $email) if ($code == 252);
	return "bogus username" if ($code == 550);
	return "" if ($code == 250);
	return $BAD;
}

sub step3 {
	my ($sock, $email) = @_;
	out($sock, "MAIL FROM:<>");
	return $BAD unless code($sock) == 250;
	out($sock, "RCPT TO:<$email>");
	my $code = code($sock);
	return "bogus username" if ($code == 550);
	return "" if ($code == 250);
	return $BAD;
}

sub out ($$) {
	my ($sock, $text) = @_;
	$sock->send("$text\n");
}

sub code ($) {
	my ($sock) = @_;
	my $line = <$sock>;
	my @tokens = split(/[- ]+/, $line);
	my $ret = $tokens[0];
	return code($sock) if $first && $ret == 220;
	$first = undef;
	return $ret;
}

1;
__END__