#!/usr/bin/perl## $Id: rlytest,v 1.22 2001/10/22 22:02:48 chip Exp $## $Log: rlytest,v $# Revision 1.22 2001/10/22 22:02:48 chip# updated message## Revision 1.21 2001/10/22 19:57:38 chip# updated URLs## Revision 1.20 2000/06/21 09:02:09 chip# Produce useful diagnostic if socket fails.# Thanks to Paul Ewing Jr. <ewing@ima.umn.edu>## Revision 1.19 2000/06/11 06:21:49 chip# now uses exit status 2 to indicate successful relay submission# added $EX_RELAY_ACCEPTED $EX_RELAY_REJECTED $EX_PROGRAM_ERROR## Revision 1.18 2000/04/04 08:25:32 chip# changed default domain from acme.com to example.com## Revision 1.17 1999/08/20 07:11:54 chip# moved uid=0 check before calculate_fqdn is called (oof!)# thanks to Paul David Fardy <pdf@morgan.ucs.mun.ca> for catching that## Revision 1.16 1999/05/25 15:51:57 chip# added $Root_check to avoid running as root# remove $! from socket creation failure, people were finding it confusing### 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.004use Time::gmtime;use vars qw($Usage $Dflt_hostname $Dflt_domain $Root_check %Opts $Target_host $Timeout $Hostname $Username $Comment $Actual_sender $MailFrom_addr $RcptTo_addr $Mssg_body);$0 =~ s!.*/!!;$Usage = "usage: $0 [-f sender_addr] [-u recip_addr] [-c comment] [-t timeout] target_host";use vars qw($EX_RELAY_ACCEPTED $EX_RELAY_REJECTED $EX_PROGRAM_ERROR);$EX_RELAY_REJECTED = 0;$EX_RELAY_ACCEPTED = 2;$EX_PROGRAM_ERROR = 1;## 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 = "example.com";### $Dflt_hostname = "dopey.example.com";## This utility does not need to be run as root. In fact, there is# a potential problem in doing so. In the "calculate_fqdn" subroutine,# one of the ways it tries to obtain the host name is with "hostname -f".# While this works on some systems, on others it will attempt to change# the local hostname to "-f"!#$Root_check = 1;if ($Root_check && $> == 0) { print STDERR q[ You should not be running this as root! Recommend you abort and run as a nonprivileged user. Pausing 10 seconds.]; foreach $_ (1 .. 10) { print STDERR "."; sleep 1; } print STDERR "\n";}## Unbuffered output.#autoflush STDOUT 1;## Crack command line.#getopts('c:f: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; $RcptTo_addr = $Opts{'u'} || $Actual_sender; $Comment = $Opts{'c'} . "\n" if ($Opts{'c'}); if ($Opts{'f'} ne "") { $MailFrom_addr = $Opts{'f'}; } elsif ($Target_host =~ /^\d+\.\d+\.\d+\.\d+$/) { $MailFrom_addr = "nobody\@[${Target_host}]"; } else { $MailFrom_addr = "nobody\@${Target_host}"; }## Construct the test message.#$Mssg_body ="To: $RcptTo_addr\n". "From: $MailFrom_addr\n". "Subject: test for susceptibility to third-party mail relay\n". "Date: " . arpa_date(time()) . "\n". "Message-Id: <rlytest-" . time() . "-" . $$ . "\@$Hostname>\n". "Sender: $Actual_sender\n". qq[This message is a test probe, to ensure that your mail server is securedagainst third-party mail relay. This is NOT an attempt to hack orcrack your system, but just to ensure the system are secured againstthis common vulnerability. This test usually is performed by a systemadministrator who is trying to determine the source of a spam email.A well-configured mail server should NOT relay third-party email.Otherwise, the server is subject to attack and hijack by Internet vandalsand spammers. For information on how to secure a mail server againstthird-party relay, visit <URL: http://mail-abuse.org/tsi/>.This probe was generated by the "rlytest" utility. For more information, visit <URL: http://www.unicom.com/sw/rlytest/>. Target host = $Target_host Test performed by <$Actual_sender> If you have any concern about this test, please contact the person listed in the "test performed by" line above. ${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: cannot connect to $Target_host: $@\n"; $SIG{'ALRM'} = sub { die "$0: timeout waiting for socket I/O\n"; };$sock->autoflush(1);read_response($sock);write_command($sock, "HELO $Hostname\n");write_command($sock, "MAIL FROM:<$MailFrom_addr>\n");write_command($sock, "RCPT TO:<$RcptTo_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).#warn "$0: relay accepted - final response code $code\n";exit($EX_RELAY_ACCEPTED);## 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; alarm($Timeout); $sock->print($data) or die "$0: socket write failed [$!]\n"; alarm(0); return read_response($sock);}## usage: $response_code = read_response($sock);#sub read_response{ my $sock = shift; my($code, $cont, $mssg); do { alarm($Timeout); chop($_ = $sock->getline()); alarm(0); ($code, $cont, $mssg) = /(\d\d\d)(.)(.*)/; print "<<< ", $_, "\n"; } while ($cont eq "-"); return $code if ($code >= 200 && $code < 400); alarm($Timeout); $sock->print("QUIT\r\n"); alarm(0); warn "$0: relay rejected - final response code $code\n"; exit($EX_RELAY_REJECTED);}## 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_hostname\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 NAMErlytest - test mail host for third-party relay=head1 SYNOPSISB<rlytest>[B<-f> sender_addr][B<-u> recip_addr][B<-c> I<comment>][B<-t> I<timeout>]I<target_host>=head1 DESCRIPTIONThe B<rlytest> utility performs a test on I<target_host> to determinewhether it will relay third-party email. It will try to relay anemail message to yourself through that host. A host that allowsthird-party relay is subject to attack by Internet vandals, andfrequently is hijacked by spammers to relay massive amounts of junkemail. 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<-f> I<sender_addr>Specifies the (C<MAIL FROM>) email address to use on the probe.By default, B<rlytest> tries to calculate an email address in thetarget domain. This is to ensure that the host is not using simple(and easily defeated) envelope checks for anti-relay protection.=item B<-u> I<recip_addr>Specifies the (C<RCPT TO>) email address to use on the probe. Bydefault, B<rlytest> tries to calculate your email address and usethat. A host that is susceptible to relay will deliver a probemessage to this address.=item B<-c> I<comment>Embed I<comment> in the body of the test message. This maybe useful, for instance, if you are doing some automatic testingand want to insert cookies into the messages.=item B<-t> I<timeout>Sets the timeout value (default is 60 seconds) for certainoperations.=backIf the remote host refused to relay the message, the programwill terminate with a zero exit status dislay a message toI<stderr> similar to:rlytest: relay rejected - status code 571If the message was accepted, the program will terminate with anexit status of 2 and display a message to I<stderr> similar to:rlytest: relay accepted - status code 221Any other (non-zero) exit status indicates a program error, such as abad hostname or host not resopnding.=head1 EXAMPLEHere is an example, showing a host that refuses third-party relay:$ ./rlytest mail.example.domConnecting to mail.example.dom ...<<< 220 mail.example.dom ready>>> HELO garcon.unicom.com<<< 250 Hello garcon.unicom.com, pleased to meet you>>> MAIL FROM:<nobody@mail.example.dom><<< 250 <chip@garcon.unicom.com>... Sender ok>>> RCPT TO:<chip@garcon.unicom.com><<< 550 <chip@garcon.unicom.com>... Relaying Deniedrlytest: relay rejected - status code 550=head1 BUGSThere is no reliable and portable method to determine the localhost's fully qualified domain name. If the utility bombs outcomplaining about FQDN problems, read the "host name configuration"information near the top of the script.=head1 SEE ALSOmail(1), sendmail(8),smtpd(8) =head1 AUTHOR Chip Rosenthal Unicom Systems Development <chip@unicom.com> $Id: rlytest,v 1.22 2001/10/22 22:02:48 chip Exp $ See http://www.unicom.com/sw/#rlytest for latest version.