|
Posted by patterner on June 13, 2005, 11:01 am
Please log in for more thread options
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$.txt";
our $testcount = 0;
our $debug = 1;
open TESTFILE, $testfilename or die "Cannot open test file,
$";
#print $logfilename;
if (-e $logfilename) {
die "Log file $ already exists!";
}
mkdir 'logs', 0744;
open LOGFILE, ">$" or die "Cannot open log file,
$";
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 $ at $\n";
#begin processing the main part of the file
processfile(*TESTFILE, *LOGFILE);
close TESTFILE;
close LOGFILE;
#print "$";
#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 $\n";
if (defined(dotest($TF, $LOG))) {
print $LOG "Test $ finished\n";
} else {
print $LOG "Test $ 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: $";
while($line ne "***Stop test\n"){
print $LOG "Sent: $";
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: @";
$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 "$";
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)
}
}#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
|
| Similar Threads | Posted | | How do you telnet from 1 host to another using Telnet Module | December 21, 2005, 4:15 pm |
| net::telnet to ms telnet server | May 19, 2005, 12:28 am |
| SMTP::new() | October 11, 2005, 2:36 am |
| Net::SMTP | July 25, 2006, 8:44 am |
| net smtp help | October 24, 2006, 4:02 pm |
| Question on NET::SMTP new() | October 11, 2005, 2:32 am |
| SMTP: "to" or/and "recipient" question. | November 11, 2005, 8:52 am |
| Net::SMTP Can't get AUTH working... | November 2, 2006, 5:39 pm |
| Installing Net::SMTP as non-root | March 19, 2007, 4:03 pm |
| "Host =>" in the Net::SMTP module | August 15, 2007, 8:37 am |
|
XML Sitemap