byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add basic tests (mail from and helo and ehlo)

Browse Source 
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@264 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2004-07-16 02:22:27 +00:00
parent 86c887fd59
commit 7889fa6990
4 changed files with 113 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
t/Test/Qpsmtpd.pm Normal file
View File

@ -0,0 +1,73 @@
package Test::Qpsmtpd;
use strict;
use Carp qw(croak);
use base qw(Qpsmtpd::SMTP);
use Test::More;
use Qpsmtpd::Constants;
sub new_conn {
ok(my $smtpd = __PACKAGE__->new(), "new");
ok(my $conn = $smtpd->start_connection(remote_host => 'localhost',
remote_ip => '127.0.0.1'), "start_connection");
is(($smtpd->response)[0], "220", "greetings");
($smtpd, $conn);
}
sub start_connection {
my $self = shift;
my %args = @_;
my $remote_host = $args{remote_host} or croak "no remote_host parameter";
my $remote_info = "test\@$remote_host";
my $remote_ip = $args{remote_ip} or croak "no remote_ip parameter";
my $conn = $self->SUPER::connection->start(remote_info => $remote_info,
remote_ip => $remote_ip,
remote_host => $remote_host,
@_);
$self->load_plugins;
my $rc = $self->start_conversation;
return if $rc != DONE;
$conn;
}
sub respond {
my $self = shift;
$self->{_response} = [@_];
}
sub response {
my $self = shift;
$self->{_response} ? (@{ delete $self->{_response} }) : ();
}
sub command {
my ($self, $command) = @_;
$self->input($command);
$self->response;
}
sub input {
my $self = shift;
my $command = shift;
my $timeout = $self->config('timeout');
alarm $timeout;
$command =~ s/\r?\n$//s; # advanced chomp
$self->log(LOGDEBUG, "dispatching $_");
defined $self->dispatch(split / +/, $command, 2)
or $self->respond(502, "command unrecognized: '$command'");
alarm $timeout;
}
# sub run
# sub disconnect
1;

21
t/addresses.t Normal file
View File

@ -0,0 +1,21 @@
use Test::More qw(no_plan);
use strict;
use lib 't';
use_ok('Test::Qpsmtpd');
ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost');
is(($smtpd->command('MAIL FROM:<ask@perl.org>'))[0], 250, 'MAIL FROM:<ask@perl.org>');
is($smtpd->transaction->sender->address, 'ask@perl.org', 'got the right sender');
is(($smtpd->command('MAIL FROM:<ask @perl.org>'))[0], 250, 'MAIL FROM:<ask @perl.org>');
is($smtpd->transaction->sender->address, 'ask @perl.org', 'got the right sender');
is(($smtpd->command('MAIL FROM:ask@perl.org'))[0], 250, 'MAIL FROM:ask@perl.org');
is($smtpd->transaction->sender->format, '<ask@perl.org>', 'got the right sender');
my $command = 'MAIL FROM:<ask@perl.org> SIZE=1230';
is(($smtpd->command($command))[0], 250, $command);
is($smtpd->transaction->sender->format, '<ask@perl.org>', 'got the right sender');

12
t/helo.t Normal file
View File

@ -0,0 +1,12 @@
use Test::More qw(no_plan);
use strict;
use lib 't';
use_ok('Test::Qpsmtpd');
ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
is(($smtpd->command('HELO localhost'))[0], 250, 'HELO localhost');
is(($smtpd->command('EHLO localhost'))[0], 503, 'EHLO localhost (duplicate!)');
ok(($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection");
is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost');

8
t/qpsmtpd-address.t
View File

@ -2,7 +2,7 @@
use strict;
use warnings;
use Test::More tests => 9;
use Test::More tests => 11;
BEGIN {
use_ok('Qpsmtpd::Address');
@ -36,3 +36,9 @@ ok ($ao, "parse $as");
is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
$as = 'foo@example.com';
$ao = Qpsmtpd::Address->new($as);
ok ($ao, "parse $as");
is ($ao->address, $as, "address $as");