#!/usr/bin/perl
# SMTP email verifier
# A.Daviel, Vancouver Webpages
# Nov 1998 - add numeric address wrapping
# Nov 1999 - split off UUCP relay statement
sub disc {
  print <<EOM ;
$0 SMTP email relay check

 DISCLAIMER: This script is intended to test mail relaying capabilities.
 Unauthorized use of this script on non-local hosts may be interpreted as 
 a network attack.
 Each copy of this script is identified by a unique serial number and  
 may be traced back to the user.   

 THIS SOFTWARE IS PROVIDED BY THE AUTHOR "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 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. UNAUTHORIZED MODIFICATION OF THIS SOFTWARE IS FORBIDDEN
 UNDER COPYRIGHT LAW.

EOM
}


$here = `hostname -f` ; chop($here) ;
($hname,$aliases,$addrtype,$length,@addrs) =gethostbyname($here) ;
$me = `whoami` ; chop($me) ;

$good_address = $me.'@'.$here ;
$bad_address = 'spammer@spam.vancouver-webpages.com' ;
$bad_org = 'spam.vancouver-webpages.com' ;
$bad_user = 'baduser' ;

require 5.003;

use Socket;

$tout1 = 10 ;  # timeout on initial connection
$tout = 60 ;   # timeout on complete transaction

# typical errors from sendmail:
#220  connect
#250 command OK
#221 disconnect
#214 help
#252 not implemented
#252 is an alias

#500 command bad
#503 need mail
#550 User unknown
#551 Domain must resolve

# internal errors:
#901 getprotobyname
#902 inet_aton
#903 socket fail
#904 connect fail
#905 timed out
#906 node not found
#907 loop test

if ($ARGV[0] =~ /^-/) { $opt = shift(@ARGV) ;}
$_= unpack("%16C*", $(.$<.$]) ; $|=1 ; # flush buffers

$debug = ($opt eq '-t') ;

print STDERR "$0 S/N $_ Email Relay Checker Copyright 1997 A.Daviel; please read disclaimer ($0 -D)\n\n";
if ($opt =~ /-h/) { &help ; exit ; }
if ($opt =~ /-D/) { &disc ; exit ; }
$prstat = ($opt eq '-s') ;
$quiet = ($opt eq '-q' || $prstat) ;


$node = $ARGV[0] ;
$one = $ARGV[0] ;
$bad_address = $_.$bad_address ;

if ($node) {
  &checknode ($node) ;
  exit ;
}
while (<STDIN>) {
  chop ;
  s/^\s+// ; 
  if (/^#/) { next ; }
  s/\s.*// ;
  &checknode ($_) ;
}
if (!$nname) { &help ; }
sub checknode {
local($node) = $_[0] ;  local($xnode) =  $node ;
undef(@status) ; $timed_out=0 ; $sec=0 ;
($nname,$aliases,$addrtype,$length,@addrs) =gethostbyname($node) ;
if ($timed_out) { return ; }
@f = unpack('C4',$addrs[0]);
$xxnode = "[$f[0].$f[1].$f[2].$f[3]]" ;
unless ($nname) {
  push(@status,"906") ;
  &clean ; return ;
}
if (!$quiet) { print "Spam Test for $nname\n"; }
if (!$debug) { $SIG{'ALRM'} = "timed_out" ; alarm($tout1) ; }
if ($node =~ /[\d]+\.[\d]+\.[\d]+\.[\d]+/) { 
  $xnode = '['.$node.']' ; 
  if (!$quiet) { print "Info - $node is numeric; wrapping to $xnode\n" ; }
}
$start = time ;

$proto = getprotobyname('tcp') ; 
if ($timed_out) { return ; }
unless ($proto) {
  print STDERR "ERROR: getprotobyname fail ($!)\n"; 
   push(@status,"901") ;
   &clean ; return ; 
}

$port = 25;
$iaddr = inet_aton ($node) ; 
if ($timed_out) { return ; }
unless ($iaddr) {
  print STDERR "ERROR: inet_aton ($!)\n";
   push(@status,"902") ;
   &clean ; return ; 
}
 
$sin = sockaddr_in ($port, $iaddr);
$stat = socket(S, PF_INET, SOCK_STREAM, $proto) ; 
if ($timed_out) { return ; }
unless ($stat) {
  print STDERR "ERROR: socket fail ($!): $proto\n" ; 
   push(@status,"903") ;
   &clean ; return ; 
}

$stat = connect(S, $sin) ; 
if ($timed_out) { return ; }
unless ($stat) {
  #print STDERR "ERROR: connect fail ($!)\n"; 
   push(@status,"904") ;
   &clean ; return ;
} 
if (!$debug) { alarm($tout) ; }
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
$version = $_ ;
if (!$quiet) { print "$_\n"; }
&pstat ; #0 
if (!$quiet) { print "Check HELO\n";}
send S, "MAIL From:<".$good_address.">\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_\n"; }
&pstat ; #1

&rset ;
if (!$quiet) { print "HELO $bad_org .. " ;}
send S, "HELO ".$bad_org."\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_"; }
&pstat ; #2

&rset ;
if (!$quiet) { print "HELO $here .. " ;}
send S, "HELO ".$here."\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_"; }
&pstat ; #3

if (!$quiet) { print "\nCheck VRFY and EXPN\n"; }

if (!$quiet) { print "VRFY <postmaster> .. " ;}
send S, "VRFY <postmaster>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_"; }
&pstat ; #4

if (!$quiet) { print "EXPN  <postmaster> .. " ;}
send S, "EXPN  <postmaster>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_"; }
&pstat ; #5


# try bogus FROM
if (!$quiet) { print "\nTest  FROM spoofing\n";}
if (!$quiet) { print "From:<$bad_address> .. ";}
send S, "MAIL From:<".$bad_address.">\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ; #6

&rset ;

if (!$quiet) { print "From:<nosuchperson> .. " ; }
send S, "MAIL From:<nosuchperson>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ; #7

&rset ;

if (!$quiet) { print "From:<$good_address> .. " ;}
send S, "MAIL From:<".$good_address.">\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_\n";}
&pstat ; #8

if (!$quiet) { print "Test mail relay\n";}
if ($hname eq $nname && !$quiet) { print "$hname is local\n"; }

&do_check($bad_address) ;  # 9
&do_check($good_address) ; # 10
$address = $me.'%'.$here ; &do_check($address) ; # 11
$address = $here.'!'.$me ; &do_check($address) ; # 12
$address = '"'.$good_address.'"' ; &do_check($address) ; # 13
$address = '"'.$me.'%'.$here.'"' ; &do_check($address) ; # 14
$address = '"'.$here.'!'.$me.'"' ; &do_check($address) ; # 15

$address = $good_address.'@'.$xnode ; &do_check($address) ; # 16
$address = $me.'%'.$here.'@'.$xnode ; &do_check($address) ; # 17
$address = $here.'!'.$me.'@'.$xnode ; &do_check($address) ; # 18
$address = '@'.$xnode.':'.$good_address ; &do_check($address) ; # 19
$address = '"'.$good_address.'"@'.$xnode ; &do_check($address) ; # 20
$address = '"'.$good_address.'"@'.$xnode ; &do_check($address) ; # 21
$address = '"'.$me.'%'.$here.'"@'.$xnode ; &do_check($address) ; # 22
$address = '"'.$here.'!'.$me.'"@'.$xnode ; &do_check($address) ; # 23
 


$address = $good_address.'@'.$xxnode ; &do_check($address) ; # 24
$address = $me.'%'.$here.'@'.$xxnode ; &do_check($address) ; # 25
$address = $here.'!'.$me.'@'.$xxnode ; &do_check($address) ; # 26
$address = '@'.$xxnode.':'.$good_address ; &do_check($address) ; # 27
$address = '"'.$good_address.'"@'.$xxnode ; &do_check($address) ; # 28


if ($hname eq $nname) { $status[9] = '907'; }

if (!$quiet) { print "\nInvalid user\n";}
if (!$quiet) { print "To <no.such.user\@$xnode> .." ;}
send S, "RCPT To:<no.such.user\@$xnode>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ; # 29

if (!$quiet) { print "\nValid user\n";}
if (!$quiet) { print "To <postmaster\@$xnode> .." ;}
send S, "RCPT To:<postmaster\@$xnode>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ;  # 30

if (!$quiet) { print "To <webmaster\@$xnode> .." ;}
send S, "RCPT To:<webmaster\@$xnode>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ; # 31

if (!$quiet) { print "To <abuse\@$xnode> .." ;}
send S, "RCPT To:<abuse\@$xnode>\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_";}
&pstat ; # 32


if (!$quiet) { print "\nQuit.\n";}
send S, "QUIT\r\n",0 ;
recv S,$_,999,0 ; 
if ($timed_out) { return ; }
if (!$quiet) { print "$_\n";}


&clean ; 
} # end checknode

sub timed_out {
  #print STDERR "Port 25 timed out to $node\n";
  push(@status,"905") ;
  $timed_out=1 ; &clean ;
}

sub clean {
  $sec = time - $start ;
  if ($prstat) {
    print  "$node ";
    foreach $_ (@status) {
      print "$_ ";
    }
    print "\n";
  }
  if (!$prstat) {
    if ($status[0] eq '904') { print "$nname rejects SMTP mail\n"; 
    } elsif ($status[0] eq '905') { print "$nname could not be reached\n";
    } elsif ($status[0] eq '906') { print "$node not found\n";
    } elsif ($status[0] =~ /^9/) { print "Internal error\n" ;
    } else {
      if ($version) { print "$nname $version" ; }
      print "$nname requires HELO: " ; &npyn(1) ;
      print "$nname allows VRFY username verification: "; &pyn(4) ;
      print "$nname allows EXPN forwarding expansion: ";  &pyn(5) ;
      print "$nname allows bogus From: header: "; &pyn(6) ;
      if ($status[9] eq '907') {
        print "$nname is local\n";
      } else {
        print "$nname allows simple mail relaying: ";
        if (($status[9] =~ /^2/) ||
          ($status[10] =~ /^2/) ||
          ($status[11] =~ /^2/) ||
          ($status[13] =~ /^2/) ||
          ($status[14] =~ /^2/)) {
        print "YES\n"; 
        } else { print "NO\n"; }
        print "$nname may allow UUCP mail relaying: ";
        if (($status[12] =~ /^2/) ||
          ($status[15] =~ /^2/) ||
          ($status[23] =~ /^2/) ||
          ($status[26] =~ /^2/) ||
          ($status[18] =~ /^2/)) {
        print "YES\n"; 
        } else { print "NO\n"; }
        print "$nname allows other mail relaying: ";
        if (($status[16] =~ /^2/) ||
          ($status[19] =~ /^2/) ||
          ($status[20] =~ /^2/) ||
          ($status[21] =~ /^2/) ||
          ($status[22] =~ /^2/) ||
          ($status[24] =~ /^2/) ||
          ($status[25] =~ /^2/) ||
          ($status[27] =~ /^2/) ||
          ($status[28] =~ /^2/) ||
          ($status[17] =~ /^2/)) {
        print "YES\n"; 
        } else { print "NO\n"; }

      }
      print "$nname can mail to postmaster: ";  &pyn(30) ;
      print "$nname can mail to webmaster: ";  &pyn(31) ;
      print "$nname can mail to abuse (RFC 2142) : ";  &pyn(32) ;
      foreach $_ (@status) { 
        if ($_ eq '905') { print "$nname timed out\n"; }
      }
    }
    if ($sec>0) { print "$nname - $sec seconds\n"; }
  } 
   alarm(0);
}

sub rset {
  if (!$quiet) { print "Reset.. ";}
  send S, "RSET\r\n",0 ;
  recv S,$_,999,0 ;
  if (!$quiet) {  print "$_" ;}
}
sub pstat {
  tr/\n/ /; chop ; s/\D.*// ; push(@status,$_) ;
#$nstat = @status - 1 ; print "nstat $nstat\n" ;
}
sub npyn {
  if ($status[$_[0]] =~ /^25/) { print "NO\n"; } else { print "YES\n"; }
}
sub pyn {
  if (!($status[$_[0]] =~ /^25/)) { print "NO\n"; } else { print "YES\n"; }
}
sub help {
  print <<EOM ;
SMTP Email Relay Checker
Usage: $0 [-q|-s|-D|-t] <ip address> 
This program attempts to relay email messages through sendmail.
No actual messages are sent; only recipients are tested.
Please read the disclaimer ($0 -D)

If -s is specified, the test runs quietly and only generates a status line.
If -q is specified, the test runs quietly and only generates a summary.
If -t is specified, timeouts are disabled.
If  <ip address> is not present, will read a list of addresses from STDIN
such as that produced by "host -l <domain>".

The summary is designed to be fed to "grep", "sort", etc.
The status line is designed to be fed to e.g. another Perl script for statistics gathering.

The status elements (with -s) are from the following commands, sequentially:

connect, mail no helo, helo badorg, helo goodaddr, vrfy postmaster,
expn postmaster, from badaddr, from nosuchperson, from goodaddr,
to badaddr, to goodaddr, to good\@org\@node, to good%org\@node,
to org!good\@node, to nosuchuser, to postmaster, to webmaster,
to abuse

status values are from sendmail, except 900 series which indicate a local error.
904 is connect fail (SMTP mail not supported)
905 is timed out (tcp connect failed)
906 is not found (DNS lookup failure)
907 means you are testing this machine, so relay tests are pointless
EOM
}


sub do_check {
  if (!$quiet) { print "To:<$_[0]> .. ";}
  send S, "RCPT To:<$_[0]>\r\n",0 ;
  recv S,$_,999,0 ;
  if ($timed_out) { return ; }
  if (!$quiet) { print "$_";}
  &pstat ;
}