#!/usr/bin/perl
#
# addrcheck - mail address checker
# by tchrist@perl.com
# Copyright 1997 Tom Christiansen
# version 1.001 Fri Feb 14 15:20:02 MST 1997

####################################
# this program takes an email address as its argument
# and decides whether you're being spoofed or not.
# it exists 0 if it likes the address, and 1 if it doesn't.
# 
# can be tested interactively.  if not interactive, it will
# use syslog.
#
# should be rewritten instead of just growing via hacks.
####################################

$LOGGER   = '/usr/bin/logger';  # or /usr/ucb?
$NSLOOKUP = '/usr/bin/nslookup';  # or /usr/ucb?

$DEBUG = -t STDIN && -t STDOUT;
$address = shift || die "usage: $0 address\n";

for ($address) {
    s/^-+//;
    tr/A-Z/a-z/;
}

($user, $host) = split /\@/, $address;

# we check in this order because of speed;
# this way it will fail more quickly.

check_passwd($user);	# picky

if ($address =~ /\@./) { 
    check_host($host);
    ck822($address);   	# inscrutable
    dns_check($host);  	# slow
}

exit 0;

####################################
 
sub bad {
    # GLOBAL $hispass and $what
    if ($DEBUG) {
	print "$what `$hispass' is bad: @_\n";
    } else {
	system $LOGGER,
		    "-p", "daemon.notice", 
		    "-t", "ftpucheck",
		"BOGUS \U$what\E $hispass (@_)";
    } 
    exit 1;
} 

####################################

#############

sub check_passwd {  
    local $what = 'user';
    local $hispass = shift;

    for (@rude) {
	bad("rude") if index($hispass, lc $_) != -1;
    } 

    for (@anywhere) {
	bad("inside") if index($hispass, lc $_) != -1;
    } 

    for (@full) {
	bad("full") if $hispass eq lc $_;
    } 

    for (@start) {
	bad("start") if index($hispass, lc $_) == 0;
    } 

    # single char
    bad("single") if length($hispass) == 1;

    study $hispass;

    bad("dup letters") if $hispass =~ /(\w)\1{3,}/;

    bad("white") if $hispass =~ /\s/;

    bad("junk") if $hispass =~ /[;,\/#^*]/;

    $V = 'aeiouy';
    if ($hispass =~ /netscape/ || $hispass =~ /^m[$V]*[sz]+[$V]*l+[$V]*\W*$/) {
	bad("mozilla");
    } 

    if ($hispass =~ /xyz+y/) {
	bad("xyzzy");
    } 

    # all same letter
    bad("dup letters") if $hispass =~ /^(.)\1+$/;

    # want letters
    bad("ugly") unless $hispass =~ /[a-z]/;

    bad("backspace") if $hispass =~ /[\010\177]/;

    $letters = "qwertyuiopasdfghjklzxcvbnmmnbvcxzlkjhgfrdsapoiuytrewq";

    # consecutive
    bad("consecutive") if 
	    length($hispass) > 2 &&
		( index($letters, $hispass) != -1
		    ||
		  ($hispass =~ /^(\w+)\1$/ && length($1) > 2
		    && index($letters, $1) != -1)
		);

    bad("repeats") if $hispass =~ /^(\w+?)\1{2,}$/;

    print "$what: $hispass is good\n" if $DEBUG;

}


#############

sub check_host {
    local $what = 'host';
    local $hispass = shift;

    bad("dotless") unless index($hispass, '.') >= 0;

    for (@rude) {
	bad("rude") if index($hispass, lc $_) != -1;
    } 

    for (@full) {
	bad("full") if $hispass eq lc $_;
    } 

    for (@bad_host) {
	bad("naughty host") if $hispass =~ /$_/i;
    } 

    # single char
    bad("single") if length($hispass) == 1;

    study $hispass;

    bad("white") if $hispass =~ /\s/;

    bad("junk") if $hispass =~ /[;,\/#^*]/;

    # want letters, darnit;  this will cause 127.1 to fail though
    bad("ugly") unless $hispass =~ /[a-z]/;

    bad("backspace") if $hispass =~ /[\010\177]/;

    $letters = "qwertyuiopasdfghjklzxcvbnmmnbvcxzlkjhgfrdsapoiuytrewq";

    # consecutive
    bad("consecutive") if 
	    length($hispass) > 2 &&
		( index($letters, $hispass) != -1
		    ||
		  ($hispass =~ /^(\w+)\1$/ && length($1) > 2
		    && index($letters, $1) != -1)
		);

    print "$what: $hispass is good\n" if $DEBUG;

}

sub dns_check {
    # first try an MX record, then an A rec (for badly configged hosts)

    my $host = shift;
    local $/ = undef;
    local $what = "DNS record";
    local $hispass = $host;


    # the following is comment out for security reasons:
    #	if ( `nslookup -query=mx $host` =~ /mail exchanger/
    # otherwise there could be naughty bits in $host
    # we'll bypass system() and get right at execvp()

    if (open(NS, "-|")) {
	if (<NS> =~ /mail exchanger/) {
	    print "$what MX: $hispass is good\n" if $DEBUG;
	    close NS;
	    return;
	}
    } else {
	open(SE, ">&STDERR");
	open(STDERR, ">/dev/null");
	exec $NSLOOKUP, '-query=mx', $host;
	open(STDERR, ">&SE");
	die "can't exec nslookup: $!";
    } 

    if (open(NS, "-|")) {
	$_ = <NS>;
	if (/answer:.*Address/s) {
	    print "$what A: $hispass is good\n" if $DEBUG;
	    close NS;
	    return;
	}
	if (/Name:.*$host.*Address:/si) {
	    print "$what A: $hispass is good\n" if $DEBUG;
	    close NS;
	    return;
	}
    } else {
	open(SE, ">&STDERR");
	open(STDERR, ">/dev/null");
	exec $NSLOOKUP, '-query=a', $host;
	open(STDERR, ">&SE");
	die "can't exec nslookup: $!";
    } 

    bad("No DNS");
} 


sub ck822 { 

    # ck822 -- check whether address is valid rfc 822 address
    # tchrist@perl.com
    #
    # pattern developed in program by jfriedl; 
    # see "Mastering Regular Expressions" from ORA for details

    # this will error on something like "ftp.perl.com." because
    # even though dns wants it, rfc822 hates it.  shucks.

    local $what = 'address';

    local $hispass = shift;
    local $_;

    $is_a_valid_rfc_822_addr = '';

    while (<DATA>) {
	chomp;
	$is_a_valid_rfc_822_addr .= $_;
    } 


    bad("rfc822 failure") unless $hispass =~ /^${is_a_valid_rfc_822_addr}$/o;
    print "$what: $hispass is good\n" if $DEBUG;
}

##############################
# initializations
##############################

BEGIN {

    @full = qw{

	admin
	alpha
	ananymous
	anon
	anonymous
	bar
	big-liar
	bin
	bizarre
	bla
	blah
	bogus
	bummy
	cache
	plukyou
	phukyou
	collect
	compuserve
	cool
	crud
	DeleGateMaster
	devnull
	dialup
	dork
	dummy
	dunno
	employee
	first1
	foo
	friendly
	ftpsearch-collect
	fu
	god
	guest
	gunk
	anonimouse
	gw
	hacker
	harvest
	hello
	here
	hi
	hostmaster
	howdy
	ident
	ie30user
	imaservice
	info
	informix
	interceptor
	internet
	junk
	lame
	lamer
	liar
	login
	lycos
	maxima
	me
	mirror
	mosaic
	source
	src
	nobody
	none
	none-known
	nouser
	ntcon
	ok
	outbound
	postmaster
	president
	public
	Put_Your_Email_Address
	report_abuse
	root
	sales
	satan
	sesame
	socks
	somebody
	spanky
	src
	sticky
	system
	there
	unknown
	Unknown_Netscape_User
	Unregistered
	unverified
	user
	UserName
	vice-president
	vividnet
	webmaster
	whoever
	WinGate
	wow
	xyz

    };

    @start = qw{

	aaa
	abc
	account
	anon
	anon
	asquid
	daemon 
	delegate
	ftp
	gopher
	gotch
	oracle
	otthttp
	pass
	satan
	squid
	student
	test
	web
	xx

    };

    @bad_host = qw{
	perl\.com
	cyberpromo\.com
	bar\.com
    };

    @anywhere = qw{

	adresse
	asdf
	address
	asfd
	sdf
	jkl
	hjk
	cache
	firewall
	private
	-gw
	http
	mail
	mirror
	mother
	service
	sdf
	lkj
	khj
	name
	nobody
	proxy
	sadf
	system
	user
	www

    }; 

    @rude = qw{

	asshole
	crap
	cunt
	damn
	fuck
	piss
	shit
	suck
	tits
	upyour

    };

}

# don't touch this stuff down here or you'll break the rfc822 matcher.
__END__
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\
xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"
]|\\[^\x80-\xff])*")(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[
^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;
:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))
*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\
n\015()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\04
0)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\(
(?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\
\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*|(?:[^(\040)<>@,;:".\\\[\]\000-\0
37\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xf
f\n\015"]|\\[^\x80-\xff])*")(?:[^()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\03
7]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff])*\))*\)|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")*<(?:[\04
0\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]
|\\[^\x80-\xff])*\))*\))*(?:@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x
80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
)|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\
\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff
])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-
\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\01
5()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*,(?
:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\0
15()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^
\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xf
f])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\x
ff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:
[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\00
0-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x8
0-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*)*:(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*)
?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000
-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")(?:(?:[\040\t]
|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[
^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\
\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:
[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*@
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff
]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\]))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x8
0-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*>)(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*