zt. gmail vrfy.pl

#!/usr/local/bin/perl
# vrfy.pl v.92b
# copyright 2004 Jeremy Kister.  http://jeremy.kister.net/
# released under Perl's Artistic License 20040812
#
# verify envelope sender can take mail
# (similar to rather decommissioned VRFY SMTP verb)
#
# I dont recommend using this; it's just concept code to show
# what Verizon and friends are doing.
#
# If you do use this, it's *very* important to cache your results
# as you dont want to DoS some poor little server.  The implemented
# sql commands are natively compatible with MySQL and MSSQL w/FreeTDS.
#
#CREATE TABLE `email_cache` (
#  `email` varchar(255) NOT NULL,
#  `time` int(4) unsigned NOT NULL,
#  `code` tinyint(1) unsigned NOT NULL,
#  PRIMARY KEY  (`email`)
#) TYPE=MyISAM;
use strict;
use IO::Socket::INET;
use Net::DNS;
use DBI;
my $VERBOSE=0;
my $email = shift;
die "invalid looking email: $email\n"
unless($email =~ /^([a-z0-9_\.\+\-\=\?\^\#])+\@(([a-z0-9\-])+\.)+([a-z0-9]{2,4})+$/i);
my $dsn = 'DBI:mysql:host=mysql.example.net;database=isp';
my $dbun = 'dbun';
my $dbpw = 'dbpw';
my $dbh = DBI->connect($dsn, $dbun, $dbpw, {RaiseError => 1});
my $sql = 'SELECT code FROM email_cache WHERE email = ' . $dbh->quote($email);
$sql .= ' AND time > ' . $dbh->quote($^T-43200); # 12 hours ago
my $sth = $dbh->prepare($sql);
$sth->execute;
my $row = $sth->fetchrow_hashref;
my $code = $row->{code};
if($code eq '1' || $code eq '0'){
        print $code;
        exit;
}
my $me;
if(open(F, "/var/qmail/control/helohost") || open(F, "/var/qmail/control/me") || open(F, "/etc/hostname")){
        chop($me = );
        close F;
}else{
        die "cannot determine helohost\n";
}
my ($user,$domain) = split /\@/, $email;
my $res = Net::DNS::Resolver->new;
my @mx = mx($res, $domain);
my $code = 0;
foreach my $rr (@mx){ # sorted by pref
        my $exchanger = $rr->exchange;
        if(($exchanger =~ /^(127|0|10|255|224)\./) ||
           ($exchanger =~ /^192\.168\./) ||
           ($exchanger =~ /^172\.(1(6|7|8|9)|2\d|3(0|1))\./) ||
           ($exchanger =~ /^192\.0\.2\./)){
                sqllog($dbh,$email,0);
                last;
        }else{
                my $sock = IO::Socket::INET->new(PeerAddr => $exchanger,
                                                 PeerPort => 25,
                                                 Proto    => 'tcp',
                                                 Timeout  => 12);
                if($sock){
                        my @banner = getlines($sock);
                        print "banner: @banner\n" if($VERBOSE);
                        unless($banner[-1] =~ /^220\s/){
                                print $sock "QUIT\r\n"; # be nice
                                next;
                        }
                        print $sock "HELO $me\r\n";
                        my @helo = getlines($sock);
                        print "helo: @helo\n" if($VERBOSE);
                        unless($helo[-1] =~ /^250\s/){
                                print $sock "QUIT\r\n"; # be nice
                                next;
                        }
                        print $sock "MAIL FROM:\r\n";
                        my @mf = getlines($sock);
                        print "mf: @mf\n" if($VERBOSE);
                        unless($mf[-1] =~ /^250\s/){
                                print $sock "QUIT\r\n"; # be nice
                                next;
                        }
                        print $sock "RCPT TO:\r\n";
                        my @rt = getlines($sock);
                        print "rt: @rt\n" if($VERBOSE);
                        if($rt[-1] =~ /^250\s/){
                                # host accepted
                                $code = 1;
                                print $sock "QUIT\r\n"; # be nice
                                last;
                        }elsif($rt[-1] =~ /^5\d{2}/){
                                # host rejected
                                $code = 0;
                                print $sock "QUIT\r\n"; # be nice
                                last;
                        }        # else tmp fail or dunno wtf, try next exchanger
                } # else try next exchanger.
        }
}
sqllog($dbh,$email,$code);
$dbh->disconnect;
print $code;
#exit $code;
sub getlines {
        my $sock = shift;
        my @lines;
        while(){
                if(/^\d+\s/){
                        chomp;
                        push @lines, $_;
                        last;
                }else{
                        push @lines, $_;
                }
        }
        return(@lines);
}
sub sqllog {
        my ($dbh,$email,$code) = @_;
        my $sql = 'SELECT COUNT(*) FROM email_cache WHERE email = ' . $dbh->quote($email);
        my $sth = $dbh->prepare($sql);
        $sth->execute;
        my $row = $sth->fetchrow_hashref;
        my ($count) = values %$row;
        my $sql;
        if($count > 0){
                $sql = 'UPDATE email_cache SET time = ' . $dbh->quote($^T);
                $sql .= ', code = ' . $dbh->quote($code) . ' WHERE email = ' . $dbh->quote($email);
        }else{
                $sql = 'INSERT INTO email_cache VALUES (' . $dbh->quote($email);
                $sql .= ',' . $dbh->quote($^T) . ',' . $dbh->quote($code) . ')';
        }
        my $sth = $dbh->prepare($sql);
        $sth->execute;
}