rlytest.pl

In rete Ŕ presente un notevole numero di script per verificare la possibilitÓ
che il server effettui il relay.

Di seguito Ŕ riportato lo script in Perl scritto da Chip Rosenthal della
Unicom Systems Development.
Lo script non va eseguito come root, le sue opzioni sono:
-f sender_address
-u recipient_address
-c comment
-t timeout

#sotto linux il path del comando perl e' /usr/bin/perl   
#!/usr/local/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.
#
# 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  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
#
#

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 $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";
#Inserire qui l'hostname da controllare di default
$Dflt_hostname = "GIOVE";

#
# 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: \n"
    . "Sender: $Actual_sender\n"
    . qq[
This message is a test probe, to ensure that your mail server is secured
against third-party mail relay.  This is NOT an attempt to hack or
crack your system, but just to ensure the system are secured against
this common vulnerability.  This test usually is performed by a system
administrator 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 vandals
and spammers.  For information on how to secure a mail server against
third-party relay, visit .

This probe was generated by the "rlytest" utility.  For more information,
visit .

    Target host = $Target_host
    Test performed by

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:\n");
write_command($sock, "RCPT TO:\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);

}

Privacy Policy