#!/usr/bin/perl -wT
#Version: 0.1
#Author: Volodymyr M. Lisivka <lvm at mystery.lviv.net>
#License: GPL
#ChangeLog:
#  04 Oct 2002 Volodymyr M. Lisivka
#              First public relase, v0.1 
use strict;
use IO::Socket;
use Sys::Hostname;
use CGI qw(param);
use CGI::Carp qw(fatalsToBrowser);

#Disable buffering of STDOUT
$|=1;

my $verbose=1;   # 0 - disable, 1 - verbose, 2 - print data
my $defaultPort=110;

my %variables=('username'=>'guest', #INSERT LOGIN NAME OF TEST ACCOUNT HERE
               'password'=>''); #INSERT PASSWORD FOR TEST ACCOUNT HERE

my $server='';

if(param('server'))
{
  $server=param('server');
  print "Content-type: text/plain; charset=KOI8-U\n\n";
  $variables{'vaildemail'}=param('validemail') if(param('validemail'));
  $variables{'vaildhost'}=param('vaildhost') if(param('vaildhost'));
}else
{ 
  if(scalar(@ARGV)!=1)
  {
    print <<USAGE;
Usage:
  $0 hostname[:port]
USAGE
    exit 1;
  }else
  {
    $server=$ARGV[0];
  }
}


my $socket=openConnection($server);

my ($testName,$testComment,$testResult)=('','','OK');

while(<DATA>)
{
  next if(/^#/);
  
  s/<\?(.*?)\?>/$variables{$1}/ge;
  
  print if($verbose==2);
  
  s/[\r\n]//g;#remove \r\n
  
  if(/^<<< (.*)$/)
  {
    checkReply($socket,$1);
  }elsif(/^<<~ (.*)$/)
  {
    checkReplyRegEx($socket,$1);
  }elsif(/^>>> (.*)$/)
  {
    sendCommand($socket,$1);
  }elsif(/^:(.*?):(.*)$/)
  {
    newTest($1,$2);
  }
}

closeConnection($socket);

exit 0;

########################################################

sub checkReply
{
  my ($socket,$reply)=@_;
  
  my $serverReply=<$socket>;
  $serverReply=~s/[\r\n]//g;#remove \r\n
  
  if($serverReply ne $reply)
  {
    print "<<< [$reply]\nERR [$serverReply]\n" if($verbose);
    $testResult='ERR';
  }
}

sub checkReplyRegEx
{
  my ($socket,$reply)=@_;
  
  my $serverReply=<$socket>;
  $serverReply=~s/[\r\n]//g;#remove \r\n
  
  if($serverReply!~m/$reply/i)
  {
    print "<<~ [$reply]\nERR [$serverReply]\n" if($verbose);
    $testResult='ERR';
  }
}

sub sendCommand
{
  my ($socket,$command)=@_;
  print $socket "$command\r\n";
}

sub newTest
{
 if($testName ne '')
 {
   if($testResult ne 'OK')
   {
     print "$testName - $testResult ($testComment)\n";
   }else
   {
     print "$testName - $testResult\n";
   }

 }
 ($testName,$testComment,$testResult)=(@_,'OK');
}

sub openConnection
{
  my $server=shift;
  my ($remoteHost,$remotePort);
  
  if($server=~m/^(.+)(:(.+))?$/)
  {
    ($remoteHost,$remotePort)=($1,($3)?$3:$defaultPort);
  }else
  {
    die "Wrong server address! Must be  \"host[:port]\"!";
  }
  
  my $socket=IO::Socket::INET->new(PeerAddr=>$remoteHost, PeerPort=>$remotePort,
                                   Proto=>'tcp', Type=> SOCK_STREAM) or
             die "Couldn't connect to $remoteHost:$remotePort: $@\n";
  return $socket;
}

sub closeConnection
{
  close(shift);
}
########################################################

__DATA__

<<~ ^\+OK

:Login1:User <?username?> not found
>>> USER <?username?>
<<~ ^\+OK

:Login2:Password incorrect
>>> PASS <?password?>
<<~ ^\+OK

:Stat:Cannot stat mailbox
>>> STAT
<<~ ^\+OK

:End:End
>>> QUIT
<<~ ^\+OK