#!/usr/bin/perl -w
# Send virus/spam/normal messages to a named host with named sender/recipients
# and optionnal message size or smtp auth
#
# Require perl modules: Net::SMTP, AppConfig
#
# Copyright (C) 2006-2010 Emmanuel Lacour <elacour@home-dn.net>
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# This file is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY 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 file; see the file COPYING.  If not, write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
# 02110-1301, USA.
#

use strict;
use Net::SMTP;
use AppConfig qw(:expand :argcount);

my $NAME = 'smtpt';
my $VERSION = '0.2';
my $AUTHOR = 'Emmanuel Lacour, <elacour@home-dn.net>';

my %count;
my $smtp;
my $user;
my $pass;
my $size;
my %sample;

# Spam sample email
$sample{spam} = 'Subject: Test spam mail (GTUBE)
From: Sender <{FROM}>
To: {TO}
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

This is the GTUBE, the
	Generic
	Test for
	Unsolicited
	Bulk
	Email

If your spam filter supports it, the GTUBE provides a test by which you
can verify that the filter is installed correctly and is detecting incoming
spam. You can send yourself a test mail containing the following string of
characters (in upper case and with no white spaces and line breaks):

XJS*C4JDBQADN1.NSBN3*2IDNEN*GTUBE-STANDARD-ANTI-UBE-TEST-EMAIL*C.34X

You should send this test mail from an account outside of your network.
';

# Nospam/novirus sample email
$sample{normal} = 'Subject: Test mail nospam/novirus
From: Sender <{FROM}>
To: {TO}
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


Essai  nospam/novirus
';

# Virus sample email
$sample{virus} = 'From: Sender <{FROM}>
To: {TO}
Subject: Test virus
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="C7zPtVaVf+AK4Oqc"
Content-Disposition: inline
Content-Transfer-Encoding: 8bit
Content-Length: 650


--C7zPtVaVf+AK4Oqc
Content-Type: text/plain; charset=iso-8859-1
Content-Disposition: inline
Content-Transfer-Encoding: 8bit

Test virus.

--C7zPtVaVf+AK4Oqc
Content-Type: application/x-msdos-program
Content-Disposition: attachment; filename="EICAR.COM"
Content-Transfer-Encoding: quoted-printable

X5O!P%@AP[4{DEACTIVATED}\PZX54(P^)7CC)7}$EICAR-STANDARD-ANTIVIRUS-TEST-FILE!$H+H*=0A
--C7zPtVaVf+AK4Oqc--
';

# Close properly smtp connection before exiting on error
sub error {
    my $mesg = shift;
    print STDERR "E: ", $mesg;
    if ($smtp) {
        $smtp->quit();
    }
    exit (1);
}

# Prints out version information
sub version {
    print "$NAME $VERSION\n";
    print "Written by $AUTHOR\n";
    exit;
}

# Prints command-line help
sub usage {
    print "Usage: $NAME ARGUMENTS [OPTIONNALS ARGUMENTS]

ARGUMENTS:
 --host=HOST            the host to connect to
 --from=FROM            the sender email
 --to=TO                the recipient email (use it multiple time for more than
                        one recipient)
 --spam=SPAM_COUNT      the number of spam emails to sent
 --virus=VIRUS_COUNT    the number of virus emails to sent
 --normal=NORMAL_COUNT  the number of nonspam/nonvirus emails to sent

OPTIONNALS ARGUMENTS:
 --user=USER            an optionnal user for smtp authentication
 --pass=PASS            an optionnal password for smtp authentication
 --size=SIZE            an optionnal message size (integer optionnaly 
                        followed by M for megabytes or K for kilobytes 
                        (default: bytes))
 --help                 prints out command-line help
 --version              prints out version information\n";
    exit(1);
}


sub main {

    # Read command line arguments
    my %opt = ();
    my $appconfig = AppConfig->new(
        'host=s', 
        'from=s', 
        'to=s@',
        'spam=s', 
        'virus=s', 
        'normal=s', 
        'user=s', 
        'pass=s', 
        'size=s', 
        'help', 
        'version'
    ) or exit(1);
    $appconfig->args();
    %opt = $appconfig->varlist('^.*$');

    # Check command line arguments
    usage if (defined $opt{help});
    version if (defined $opt{version});
    usage if ((!defined $opt{host}) || (! defined $opt{from}) || (! defined $opt{to}) || (! defined $opt{spam}) || (! defined $opt{virus}) || (! defined $opt{normal}));
    usage if ((defined $opt{user}) && (! defined $opt{pass}));
    usage if ((defined $opt{pass}) && (! defined $opt{user}));

    my $host = $opt{host};
    my $from = $opt{from};
    my @to = @{$opt{to}};
    my $to_formatted = join(", ", @to);
    $count{spam} = $opt{spam};
    $count{virus} = $opt{virus};
    $count{normal} = $opt{normal};
    $user = $opt{user} if ($opt{user});
    $pass = $opt{pass} if ($opt{pass});
    $size = $opt{size} if ($opt{size});
    if (defined $size) {
        if ($size =~ /^([0-9]+)M$/) {
            $size = $1 * 1024 * 1024;
        } elsif ($size =~ /^([0-9]+)K$/) {
            $size = $1 * 1024;
        } elsif ($size =~ /^([0-9]+)$/) {
            $size = $1;
        } else {
            die "Error, wrong size: $size\n";
        }
    }

    # Open an smtp connection
    $smtp = Net::SMTP->new($host, Debug => 0) or die "Couldn't connect to $host: $!\n";

    # Authenticate if needed
    if ($user && $pass) {
        $smtp->auth($user, $pass) or error("Auth failed: $!\n");
    }

    # Send emails
    foreach my $type (keys%count) {
        my $i = 0;
        while ($i < $count{$type}) {
            print "Sending $type: $from -> $to_formatted\n";
            $smtp->mail($from) or error("From failed: $!\n");
            $smtp->to(@to) or error("To failed: $!\n");
            $smtp->data() or error("Data failed: $!\n");
            my $sent_size = 0;
            my $body = $sample{$type};
            $body =~ s/{TO}/$to_formatted/g;
            $body =~ s/{FROM}/$from/g;
	    # Disable special virus mangling (needed for letting people using an http AV download this toool ;))
            $body =~ s/{DEACTIVATED}//g;
            $smtp->datasend($body) or error("Datasend failed: $!\n");
            $sent_size += length($body); 
            if ($size) {
                my $line = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa";
                while ($sent_size <= $size) {
                    $smtp->datasend($line) or error("Datasend failed: $!\n");
                    $sent_size += 72;
                }
            }
            $smtp->dataend() or error("Dataend failed: $!\n"); 
            $i++;
        }
    }
    $smtp->quit();
}


main();


# script documentation (POD style)

=head1 NAME

smtpt - simple command line for testing smtp server features

=head1 DESCRIPTION

This program let you send different kind of emails (spam, virus, normal) to a
specified smtp server. It can do smtp authentication and message size
adjustement.

=head1 COMMAND LINE PARAMETERS

Required command line parameters are:

=head2 B<--host>=I<HOST>
    
The host to connect to.

=head2 B<--from>=I<FROM>
    
The sender email.

=head2 B<--to>=I<TO>
    
The recipient email. (use it multiple time to specify more than one recipient)

=head2 B<--spam>=I<SPAM_COUNT>
    
The count of spam emails to sent.

=head2 B<--virus>=I<VIRUS_COUNT>
    
The count of virus emails to sent.

=head2 B<--normal>=I<NORMAL_COUNT>
    
The count of nonspam/nonvirus emails to sent.


=head1 OPTIONS

=head2 B<--user>=I<AUTH_USER>
    
An optionnal user for smtp authentication.

=head2 B<--pass>=I<AUTH_PASSWORD>
    
An optionnal password for smtp authentication.

=head2 B<--size>=I<MESSAGE_SIZE>
    
An optionnal message size (integer optionnaly followed 
by M for megabytes or K for kilobytes (default: bytes)).

=head2 B<--help>

Prints out command-line help.

=head2 B<--version>

Prints out version information.

=head1 AUTHOR

Emmanuel Lacour, elacour@home-dn.net

=cut