#!/usr/bin/perl
#
# $Id: smtptest.pl,v 1.6 2006/01/16 11:21:23 martin Exp $
#
# Copyright (c) 2005 Martin Werthmoeller <mw@lw-systems.de>
#
use strict;

use Net::SMTP;
use Getopt::Std;

# Authen::SASL will be loaded by Net::SMTP if SMTP AUTH will be
# processed. We need there the Authen::SASL::Perl module, not the
# default Authen::SASL::Cyrus which is the default.
use Authen::SASL qw(Perl);

my $hellodomain = 'testsmtp.lw-systems.de';

our(%opts);
getopts('DhrSvVa:b:f:H:p:s:t:u:', \%opts);

my $verbose    = $opts{'v'};
my $relay_test = $opts{'r'};

my $attachment = $opts{'a'};
my $body       = $opts{'b'};
my $DEBUG      = $opts{'D'};
my $sender     = $opts{'f'} || 'testsender@lw-systems.de';
my $recipient  = $opts{'t'} || 'testrecipient@lw-systems.de';
my $subject    = $opts{'s'} || 'Test mail from smtptester';
my $user       = $opts{'u'};
my $pass       = $opts{'p'};
my $virustest  = $opts{'V'};
my $spamtest   = $opts{'S'};

my $smtphost   = $ARGV[0];

printUsage() if $opts{'h'};

# test if host parameter given
printUsage() unless $smtphost;

########################################################################
my $SMTP = new smtpTest($smtphost,$hellodomain,$verbose,$DEBUG);

$SMTP->auth($user,$pass) if ($user && $pass);

$SMTP->mail($sender);
$SMTP->to($recipient);

# exit before data comman in test mode
if ($relay_test) {
    print $SMTP->code," ",$SMTP->message if $verbose;
    $SMTP->quit(5);
}

my $MSG = new mailMessage($sender,$recipient,$subject);
$MSG->setBody($body)          if $body;
$MSG->setGtubeBody            if $spamtest;
$MSG->setEicarBody            if $virustest;
$MSG->attachFile($attachment) if $attachment;

# _mw_ FIXME
#--- # exit if relaying denied!!!!
$SMTP->data();                  # send DATA command to smtphost

# send the whole mail body
$SMTP->datasend($MSG->mailBody());

$SMTP->datasend();
$SMTP->quit;


########################################################################
# subs
########################################################################
sub printUsage
{
    print "Usage: smtptest [-r] [-h] [-v] [-D] [-f <senderaddr>] [-t <recipientaddr>]\n";
    print "                [-b <contentfile>] [-a attachment_file] [-V] [-S]\n";
    print "                <hostname>\n";
    print "\n";
    print "       -r   Relay test, do not send mail. Exit code 5\n";
    print "       -v   Verbose\n";
    print "       -D   Debug\n";
    print "       -f   Envelope from address (testsender\@lw-systems.de)\n";
    print "       -t   Recipient address (testrecipient\@lw-sytems.de)\n";
    print "       -s   Subject\n";
    print "       -b   File with mail body\n";
    print "       -a   File to attach\n";
    print "       -u   SMTP AUTH user\n";
    print "       -p   SMTP AUTH pass\n";
    print "       -V   Send mail with eicar test virus pattern.\n";
    print "       -S   Send mail with gtube spam test pattern.\n";
    print "       -h   Print this help\n";
    print "\n";
    exit 1;
}


1;
### EOP
########################################################################
package smtpTest;

use Carp;

#
# not possible to inherit from Net::SMTP (Not a GLOB reference ... at
# Net::SMTP line 205).
#use base qw/Net::SMTP/;

use strict;
our $AUTOLOAD;


sub AUTOLOAD
{
    my $self = shift;
    my $type = ref($self) or croak "$self is not an object";
    my $name = $AUTOLOAD;

    $name =~ s/.*://;           # strip fully-qualified portion
    $self->{'SMTP'}->$name(@_);
}


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my ($smtphost,$hellodomain,$verbose,$DEBUG) = @_;
    my $self = { '_verbose' => $verbose,
                 '_DEBUG'   => $DEBUG
               };
    bless $self, $class;

    if ($DEBUG) {
        $self->{'SMTP'} = new Net::SMTP($smtphost, Hello => $hellodomain,
                                        Debug => 1);
    } else {
        $self->{'SMTP'} = new Net::SMTP($smtphost, Hello => $hellodomain);
    }

    if ($self->{'SMTP'}) {
        return $self;
    }
    else {
        print STDERR "Cannot connect to host: \"$smtphost\".\n";
        exit 3;
    }
}


### error
sub error
{
    my $self = shift;
    print "ERROR: ",$self->{'SMTP'}->code()," ",$self->{'SMTP'}->message(),"\n";
    exit 2;
}


### quit
sub quit
{
    my $self = shift;
    my $ret  = shift;
    $self->{'SMTP'}->quit();
    exit $ret;
}

### EOP
1;
########################################################################
package mailMessage;

### new ###
sub new {
    my $this = shift;
    my ($sender,$recipient,$subject) = @_;
    my $class = ref($this) || $this;

    my $self = { 'From'      => $sender,
                 'To'        => $recipient,
                 'Subject'    => $subject,
                 'Data'      => "Only a little test mail.\n\n",
               };
    bless $self, $class;
    return $self;
}


### setBody ###
sub setBody
{
    my $self = shift;
    my $file = shift;

    local $/ = undef;
    open BODY, "$file" or die "Cannot open content file: $!\n";
    $self->{'Data'} = <BODY>;
    close BODY;
    return $self;
}


### attachFile ###
sub attachFile
{
    my $self = shift;
    my $file = shift;

    # load the needed modules or exit with error 1.
    eval {
         require MIME::Lite;
         import MIME::Lite;
    };
    if ($@) {
        print STDERR "Cannot load module MIME::Lite.\n";
        exit 1;
    }

    my $msg = MIME::Lite->new(From     => $self->{'From'},
                              To       => $self->{'To'},
                              Subject  => $self->{'Subject'},
                              Type     => 'TEXT',
                              Encoding => 'quoted-printable',
                              Data     => $self->{'Data'},
                             );

    $msg->attach(Type => 'AUTO',
                 Path => $attachment,
                 );
    $self->{'_attachment'} = $msg->as_string();
    return $self;
}


### setSpamBody ###
sub setGtubeBody
{
    my $self = shift;
    $self->{'Data'} = "XJS*C4JDBQADN1.NSBN3*2IDNEN*GTUBE-STANDARD-ANTI-UBE-TEST-EMAIL*C.34X\n";
    return $self;
}


### setEicarBody ###
sub setEicarBody
{
    my $self = shift;
    $self->{'Data'} = 'X5O!P%@AP[4\PZX54(P^)7CC)7}$EICAR-STANDARD-ANTIVIRUS-TEST-FILE!$H+H*'."\n\n";
    return $self;
}


### fetchBody ###
sub mailBody {
    my $self = shift;

    # sets the whole message body (not envelope) to attachment content
    # or construct a new body.
    if ($self->{'_attachment'}) {
        $self->{'MSG_BODY'} = $self->{'_attachment'};
    }
    else {
        $self->{'MSG_BODY'} = "To: ".$self->{'To'}."\n"
            . "From: ".$self->{'From'}."\n"
            . "Subject: ".$self->{'Subject'}."\n\n"
            . $self->{'Data'};
    }

    return $self->{'MSG_BODY'};
}

### EOP
1;
__END__
=head1 NAME

    smtptest

=head1 SYNOPSIS

 smtptest [-r] [-h] [-v] [-D] [-f <senderaddr>] [-t <recipientaddr>]
          [-s subject] [-b <contentfile>] [-a attachment_file] [-V] [-S]
          <hostname>

=head1 DESCRIPTION

Smtptest is a program to check mail delivery directly via the SMTP
protocol. The smtptest program needs at least the hostname of the smtp
server to test.

Smtptest can be used to check your SMTP AUTH setup. In this case the
modules MIME::Base64 and Authen::SASL must be installed. If the
content filter at the smtp server should be tested with attachments,
the MIME::Lite module must be installed.


=head2 ARGUMENTS

=over

=item -r

Relay test. The communication with the smtp server will be dropped
before the DATA command.

=item -h

Print help text.

=item -v

Be verbose in relay test.

=item -D

Debug mode. Prints the SMTP communication to STDERR.

=item -f <senderaddress>

Sets the envelpe from and From: header address (default:
testsender@lw-systems.de)

=item -t <recipientaddress>

Sets the envelpe to and To: header address (default:
testrecipient@lw-systems.de)

=item -s <subject>

Sets the subject line of the test mail (default:'Test mail from
smtptester')

=item -b <contentfile>

Path to a file with the body text of the test mail.

=item -a <attachmentfile>

Path to a file which will be attached to the mail. This option needs
the MIME::Lite module to be installed.

=item -u <username>

Set the username for SMTP AUTH. If this parameter and the -p
<password> parameter is set, smtptest will try to authenticate at the
server. Requires the modules MIME::Base64 and Authen::SASL.

=item -p <password>

Set the password for SMTP AUTH. If this parameter and the -u
<username> parameter is set, smtptest will try to authenticate at the
server. Requires the modules MIME::Base64 and Authen::SASL.

=item -V

The eicar virus test pattern will be set to the body of the
mail. The signature will overwrite the body text given with the -b
switch or the -S switch.

=item -S

The GTUBE spam test pattern will be set to the body text
of the mail. This signature will take precendece over the body text
given by teh -b switch but will be overwritten by the virus test
signature of the -V switch.

=back


=head1 EXAMPLES

=head2 SMTP AUTH relay test

smtptest -r -u mailuser -p secret mail.lw-systems.de

=head2 Check if virus attachment will be stripped

smtptest -a virus.exe -t user@yourdomain.com smtp.yourdomain.com

=head1 BUGS

Bugs? Features!

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

 Copyright (c) 2005 Martin Werthmoeller <mw@werthmoeller.de>

   This program is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as
   published by the Fre e Software Foundation; either version 2 of
   the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILIT Y or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 5 9 Temple Place, Suite 330, Boston, MA
   02111-1307 USA

=cut