Net::Telnet and SMTP

Hi all,

I'm using Net::Telnet to test an SMTP proxy product and I've run into
an issue with it.

First, I'm trying to send a sequence of commands and then log both the
commands sent and the response from the server into a log file. The
responses need to match up EXACTLY to the commands to which they are in
response. Second, I've tried Net::SMTP and it doesn't quite do what I
need. Since the product I'm testing may have to deal with......er,
impolite SMTP clients (read: crackers) I want to make sure that if the
SMTP protocol being sent is broken that the proxy reponds in a correct
(read: secure) way. Unfortunately Net::SMTP doesn't give me the level
of control I need....mostly because it's too polite. ;)

I've included the script and a sample text file (that feeds the scripts
the commands) below. It's been since sometime in v4 since I last did
anything with PERL (unfortunately) so I apologize in advance for the
mess. :)

Thanks,

crr

************************************Script****************** ********************
#This script reads from a generated smtp test file and writes to a log
file in
#the logs directory, which will be created under the directory from
which the
#test is run. I recommend that you place the test file in the same dir
as the
#script, if for no other reason than that you won't have to maintain in
the
#script the location from which you're running the file.
#
#test file format note:
#The first line of the test file *must* contain the dns name (if you're
using
# DNS) or the IP address of the server under test, followed by a colon
(:) and
# the port to which you're connecting, typically 25
# You can place comments in the test file by prepending the line with a
#. Note
# that this can only be placed at the start of the line
# Each test should beging with "***Start test" (without quotes) and end
with
# "***Stop test"

use strict;
#no strict 'refs';
use Net::Telnet;

#set the test and log file names, and some globals
my $testfilename = "smtptests.txt";
my $t = localtime(time());
my $logfilename = "./logs/smtplog${t}.txt";
our $testcount = 0;
our $debug = 1;

open TESTFILE, $testfilename or die "Cannot open test file,
${testfilename}";

#print $logfilename;
if (-e $logfilename) {
die "Log file ${logfilename} already exists!";
}
mkdir 'logs', 0744;

open LOGFILE, ">${logfilename}" or die "Cannot open log file,
${logfilename}";
if ($debug) {print "*****Created log file\n";}

#grab the server and port out of the first line of the file
my ($server, $port) = split (/\:/, getline(*TESTFILE));

#create the telnet object and set some initial values
our $telnet = new Net::Telnet (Timeout => 660,
Telnetmode => 0,
Host => $server,
Port => $port,
Prompt => '//',
Errmode => 'die');
#need to set the prompt to null, since SMTP doesn't have a prompt,
large timeout is
#for testing our timeout

#timeout exception for debugging the script
$telnet->timeout(30) if ($debug);

if ($debug) {print "*****Telnet object created\n";}

$t = localtime(time());
print LOGFILE "Starting test of server ${server} at ${t}\n";

#begin processing the main part of the file
processfile(*TESTFILE, *LOGFILE);

close TESTFILE;
close LOGFILE;

#print "${server}";
#print $port;

#processfile is where the main work of the program is coordinated. it
reads
#commands from the test file and organizes the starting and stopping of
each
#test
sub processfile {
if ($debug) {print "*****Entering processfile\n";}
my $TF = shift;
my $LOG = shift;
my $line = getline($TF);

if ($line eq eof) {return 0;}

if ($debug) {print $line;}
while ($line ne eof) {
# checks the line and read if it's a command to start a test
if ($line eq "***Start test\n") {
print "*****Starting test\n" if ($debug);
$testcount++;
print $LOG "Starting test ${testcount}\n";
if (defined(dotest($TF, $LOG))) {
print $LOG "Test ${testcount} finished\n";
} else {
print $LOG "Test ${testcount} failed\n";
}#end else
}#end if
#We should never encounter a stop test line in processfile
if ($line eq "***Stop test\n") {die "Error in test file!"}

$line = getline($TF);
if ($debug) {print $line;}
}#end while

return 0;

#once we've started a test, dotest actually runs the commands,
including opening
#the telnet session
sub dotest {
my $TF = shift;
my $LOG = shift;
my @response = ();

print "*****Entered dotest\n" if ($debug);

my $line = getline($TF);
$telnet->input_log($LOG);
print $LOG "Recd: ";
$telnet->open();
print "*****Telnet session open\n" if ($debug);

#Try a short delay
delay(.1);

$telnet->get(); #read output for input_log
#my $firstline = $telnet->getline();
#print $LOG "Recd: ${firstline}";

while($line ne "***Stop test\n"){
print $LOG "Sent: ${line}";
print $LOG "Recd: ";
print $LOG $telnet->cmd(String => $line);

#Try a short delay between sending command and reading output
delay(5);
$telnet->getline();

#if (substr($line, 0, 4) eq "ehlo") {
#@response = $telnet->getlines(All => "");
#} else {@response = $telnet->getline();}

#print $LOG "Recd: @{response}";
$line = getline($TF);
}#end while
#$telnet->dump_log('') if ($debug);

$telnet->cmd(String => localtime(time())) if ($debug);
$telnet->close();

return 0;
}#end dotest
}#end processfile

#Small sub to strip out comments in the test file and exit gracefully
if we've
#reached the end of the input file
sub getline {
my $TF = shift;
my $gotline = 0;
my $line = '';

while (!($gotline)) {
$line = <$TF>;
if (eof($TF)) {
print "*****EOF reached\n" if ($debug);
print $line if ($debug);
exit;}
$gotline = 1;
my @a = split (//, $line);
if ($a[0] eq '#') {$gotline = 0;}
}#end while

#print "${line}";
return $line;
}#end getline

#small sub to insert a variable length time delay
sub delay {
my $delaytime = shift;

my $returntime = (time + $delaytime);
while(1) {
if (time >= $returntime) {return;}
}
}#end delay

************************************text
file*******************************************
10.113.15.66:25
#Test comment
***Start test
ehlo test.com
mail from: bob@test.com
rcpt to: nadmin@ace66.roke.com
data
To: bob
From: Bill
Subject: test
This is a test email
..
***Stop test