add basic tests (mail from and helo and ehlo)

git-svn-id: https://svn.perl.org/qpsmtpd/trunk@264 958fd67b-6ff1-0310-b445-bb7760255be9

t/Test/Qpsmtpd.pm

@@ -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;
+

t/addresses.t

@@ -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');
+

t/helo.t

@@ -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');
+

t/qpsmtpd-address.t

@@ -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");
+
+