#!/bin/perl5 -w
# $Id: VRFY,v 1.8 1998-11-17 09:00:58-06 annis Exp annis $
#
# Copyright (c) 1998 William S. Annis.  All rights reserved.  This
# is free software; you can redistribute it and/or modify it under the
# same terms as Perl itself (the Artistic Licence).
#
# Connect to a mail server and do a VRFY on a given address.  Requires
# Net::DNS and Net::SMTP Perl library (Net::SMTP is part of libnet at
# CPAN).
#
# It will go through every MX found for the domain part of the address
# until it finds a match, or reaches the end.
#
# $Log: VRFY,v $
# Revision 1.8  1998-11-17 09:00:58-06  annis
# Reintroduced &get_mx as &get_mxen.  A machine may not have an MX
# record, in which case the A record should be consulted.  Added the
# code to do that in &get_mxen.
#
# Revision 1.7  1998-06-05 12:44:51-05  annis
# Removed sub get_mx().  It was redundant since &mx sorts by preference
# on it's own.
#
# Revision 1.6  1998-06-03 16:19:01-05  annis
# Added RCS insertion Log.  Does 'require 5.004' since I use the new
# 'foreach my $i (@)' syntax.
#

require 5.004;
use Net::SMTP;
use Net::DNS;
use File::Basename;
use strict;


# Tell the user they've had a thinko...
sub usage {
    print STDERR "Usage: ", basename($0), " user\@some.address\n";
}

# Find "A" record.
sub a {
    my ($res, $addr) = @_;
    my @a;

    my $query = $res->search($addr);
    if ($query) {
        my $rr;
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            push @a, $rr->address;
        }
    }

    return @a;
}


# Grab the MX record for this address.  If no MXen come back, grab the
# A records.
sub get_mxen {
    my ($res, $addr) = @_;

    my @mxen = mx($res, $addr);
    if ($#mxen == -1) {
        # No MX record found; try "A" now.
        @mxen = a($res, $addr);
    }

    return @mxen;
}


# Try to connect to the address given, and 1) verify it connects and
# 2) if it does, what does VRFY return?  Returns undef on refused connection
# and 0 on failed VRFY.
sub try_VRFY {
    my ($user, $address) = @_;

    # Here we go...
    my $smtp = Net::SMTP->new($address);
    return undef if ! defined $smtp;

    if ($smtp->verify($user)) {
        $smtp->quit;
        return $user;
    } else {
        # Not there; possibly refused, of course.
        return 0;
    }

    $smtp->quit;
}
    

######################################################################
# MAIN::

# Give me a resolver object.
my $res = new Net::DNS::Resolver;

ADDRESS: foreach my $argv (@ARGV) {
    my ($user, $address) = split '@', $argv;
    if (! defined $user || ! defined $address) {
        &usage;
        exit 1;
    }
    
    my @MXen = &get_mxen($res, $address);
    if ($#MXen == -1) {
        # No MX or A records found... is the address valid?
        print "$user\@$address not verified... no MX or A found.  Address correct?\n";
        next ADDRESS;
    }
    
    foreach my $mx (@MXen) {
        my $addr;
        if (ref $mx) {
            $addr = $mx->exchange;
        } else {
            $addr = $mx;
        }

        my $try = &try_VRFY($user, $addr);
        if (! defined $try) { 
            # Let the user know when there are network problems.
            print STDERR "Unable to connect to MX $addr.\n";
        } elsif ($try) {
            print "$user\@$addr verified.\n";
            next ADDRESS;
        }
    }
    
    print "$user\@$address was not verified.\n";
}

# EOF