#!/usr/bin/perl
#
# $Id: rlytest,v 1.10 1997/11/14 00:56:46 chip Exp $
#
# rlytest - test mail host for third-party relay
# (see POD documentation at end)
#
# Chip Rosenthal
# Unicom Systems Development
# <chip@unicom.com>
#

require 5.002;
use strict;
use Getopt::Std;
use IO::Socket; # warning - IO::Socket was an optional add-on prior to 5.004
use Time::gmtime;
use vars qw($Usage $Dflt_hostname $Dflt_domain %Opts
        $Target_host $Timeout $Hostname $Username $Comment
        $Actual_sender $Sender_addr $Recip_addr $Mssg_body);

$0 =~ s!.*/!!;
$Usage = "usage: $0 [-u email_addr] [-c comment] [-t timeout] target_host";
#
# Host name configuration - Leave these commented out unless the
# calculate_fqdn() routine is unable to calculate your FQDN (fully
# qualified domain name) correctly.  You'll know if it fails, because
# the script will bomb out bitching about the FQDN.  If this happens,
# try setting $Dflt_domain to your domain.  Or, if you like, you
# may hardwire $Dflt_hostname to a particular FQDN.
#
### $Dflt_domain = "acme.com";
### $Dflt_hostname = "dopey.acme.com";

#
# Unbuffered output.
#
select((select(STDOUT), $| = 1)[$[]);

#
# Crack command line.
#
getopts('c:t:u:', \%Opts)
        or die "$Usage";
die "$Usage\n"
        unless (@ARGV == 1);
$Target_host = shift;

#
# Initialize parameters.
#
$Timeout = $Opts{'t'} || 60;
$Hostname = calculate_fqdn()
        or die "$0: cannot determine FQDN\n";
$Username = $ENV{'LOGNAME'} || $ENV{'USER'} || die "$0: LOGNAME undefined\n";
$Actual_sender = $Username . "\@" . $Hostname;
$Sender_addr = $Opts{'u'} || $Actual_sender;
$Recip_addr = $Sender_addr;
$Comment = $Opts{'c'} . "\n"
        if ($Opts{'c'});

#
# Construct the test message.
#
$Mssg_body =
        "To: $Recip_addr\n"
        . "From: $Sender_addr\n"
        . "Subject: test for susceptibility to third-party mail relay\n"
        . "Date: " .  arpa_date(time()) . "\n"
        . "Message-Id: <rlytest-" . time() . "-" . $$ . "\@$Hostname>\n"
        . qq[
This is a test of third-party mail relay, generated by the
"rlytest" <URL:http://www.unicom.com/sw/#rlytest> utility.

    Target host = $Target_host
    Test performed by <$Actual_sender>

A well-configured mail server should NOT relay third-party email.
Otherwise, the server is subject to attack and hijack by Internet
vandals and spammers.

${Comment}
.
];

#
# Connect and execute SMTP diaglog.
#
print "Connecting to $Target_host ...\n";
my $sock = IO::Socket::INET->new(
                Proto => "tcp",
                PeerAddr => $Target_host,
                PeerPort => "smtp(25)",
                Timeout => $Timeout)
        or die "$0: socket failed [$!]\n";
read_response($sock);
write_command($sock, "HELO $Hostname\n");
write_command($sock, "MAIL FROM:<$Sender_addr>\n");
write_command($sock, "RCPT TO:<$Recip_addr>\n");
write_command($sock, "DATA\n");
write_command($sock, $Mssg_body, "(message body)\n");
my $code = write_command($sock, "QUIT\n");

#
# Dialog successful (which is bad -- that means the relay was accepted).
#
STDOUT->flush();
warn "$0: relay accepted - final response code $code\n";
exit(0);


#
# usage: write_command($sock, $data_to_send[, $mssg_to_display])
#
sub write_command
{
        my $sock = shift;
        my $data = shift;
        my $mssg = shift || $data;
        print ">>> $mssg";
        $data =~ s/\n/\r\n/g;
        $sock->print($data)
                or die "$0: socket write failed [$!]\n";
        $sock->flush()
                or die "$0: socket write failed [$!]\n";
        return read_response($sock);
}


#
# usage: $response_code = read_response($sock);
#
sub read_response
{
        my $sock = shift;
        my($code, $cont, $mssg);

        do {
                chop($_ = $sock->getline());
                ($code, $cont, $mssg) = /(\d\d\d)(.)(.*)/;
                print "<<< ", $_, "\n";
        } while ($cont eq "-");
        return $code
                if ($code >= 200 && $code < 400);

        STDOUT->flush();
        warn "$0: relay rejected - final response code $code\n";
        exit(0);
}


#
# usage: $hostname = calculate_fqdn();
#
sub calculate_fqdn
{
        my @trycmds = ("hostname", "hostname -f", "uname -n");
        my $cmd;
        my $hostname;

        return $Dflt_hostname
                if ($Dflt_hostname);

        foreach $cmd (@trycmds) {
                chop($hostname = `$cmd`);
                return $hostname
                        if ($hostname =~ /\./);
                return $hostname . "." . $Dflt_domain
                        if ($hostname && $Dflt_domain);
        }

        die "$0: cannot determine FQDN - please set \$Dflt_domain or \$Dflt_host
name\n"
}


#
# usage: $date_header = arpa_date($secs_since_epoch)
#
sub arpa_date
{
        my $gm = gmtime(shift);
        my @Day_name = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
        my @Month_name = (
                "Jan", "Feb", "Mar", "Apr", "May", "Jun",
                "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

        sprintf("%-3s, %02d %-3s %4d %02d:%02d:%02d GMT",
                $Day_name[$gm->wday],
                $gm->mday, $Month_name[$gm->mon], 1900+$gm->year,
                $gm->hour, $gm->min, $gm->sec);

}


__END__

=head1 NAME

rlytest - test mail host for third-party relay

=head1 SYNOPSIS

B<rlytest> [B<-u> I<email_addr>] [B<-c> I<comment>] [B<-t> I<timeout>]
I<target_host>

=head1 DESCRIPTION

The B<rlytest> utility performs a test on I<target_host> to determine
whether it will relay third-party email.  It will try to relay an
email message to yourself through that host.  A host that allows
third-party relay is subject to attack by Internet vandals, and
frequently is hijacked by spammers to relay massive amounts of junk
email.  A host that allows third-party relay should be B<immediately>
secured, disconnected, or shunned as a menace to the Internet.

The following options are available:

=over 4

=item B<-u> I<email_addr>

Specifies the email address to use (for both the C<MAIL FROM> and
C<RCPT TO>) commands.  Otherwise, B<rlytest> tries to calculate
your email address and use that.  For instance, specifying something
like C<nobody@foo.com> (substituting your own domain) may allow
you to run the test without crudding up your mailbox.

=item B<-c> I<comment>

Embed I<comment> in the body of the test message.  This may
be useful, for instance, if you are doing some automatic testing
and want to insert cookies into the messages.

=item B<-t> I<timeout>

Sets the timeout value (default is 60 seconds) for certain
operations.

=back

If the message was accepted, the program will terminate with a zero
exit status and display a message to I<stderr> similar to:

  rlytest: relay accepted - status code 221

If the remote host refused to relay the message, the program
will terminate with a zero exit status dislay a message to
I<stderr> similar to:

  rlytest: relay rejected - status code 571

A non-zero exit status indicates a program error, such as a
bad hostname or host not resopnding.

=head1 EXAMPLE

Here is an example, showing a host that refuses third-party relay:

  $ ./rlytest mail.example.dom
  Connecting to mail.example.dom ...
  <<< 220 mail.example.dom ready
  >>> HELO garcon.unicom.com
  <<< 250 Hello garcon.unicom.com, pleased to meet you
  >>> MAIL FROM:<chip@garcon.unicom.com>
  <<< 250 <chip@garcon.unicom.com>... Sender ok
  >>> RCPT TO:<chip@garcon.unicom.com>
  <<< 550 <chip@garcon.unicom.com>... Relaying Denied
  rlytest: relay rejected - status code 550

=head1 BUGS

The B<-u> option may be necessary if you are running behind a firewall.

There is no reliable and portable method to determine the local
host's fully qualified domain name.  If the utility bombs out
complaining about FQDN problems, read the "host name configuration"
information near the top of the script.

=head1 SEE ALSO

mail(1),
sendmail(8),
smtpd(8)

=head1 AUTHOR

  Chip Rosenthal
  Unicom Systems Development
  <chip@unicom.com>

$Id: rlytest,v 1.10 1997/11/14 00:56:46 chip Exp $