cvs commit: qpsmtpd/t/Test Qpsmtpd.pm

cvsuser     04/07/15 19:22:27

  Modified:    t        qpsmtpd-address.t
  Added:       t        addresses.t helo.t
               t/Test   Qpsmtpd.pm
  Log:
  add basic tests (mail from and helo and ehlo)
  
  Revision  Changes    Path
  1.2       +7 -1      qpsmtpd/t/qpsmtpd-address.t
  
  Index: qpsmtpd-address.t
  ===================================================================
  RCS file: /cvs/public/qpsmtpd/t/qpsmtpd-address.t,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -w -r1.1 -r1.2
  --- qpsmtpd-address.t	14 Jul 2004 23:58:47 -0000	1.1
  +++ qpsmtpd-address.t	16 Jul 2004 02:22:27 -0000	1.2
  @@ -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 @@
   is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
   
   
  +$as = '[email protected]';
  +$ao = Qpsmtpd::Address->new($as);
  +ok ($ao, "parse $as");
  +is ($ao->address, $as, "address $as");
  +
  +
  
  
  
  1.1                  qpsmtpd/t/addresses.t
  
  Index: addresses.t
  ===================================================================
  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:<[email protected]>'))[0], 250, 'MAIL FROM:<[email protected]>');
  is($smtpd->transaction->sender->address, '[email protected]', '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:[email protected]'))[0], 250, 'MAIL FROM:[email protected]');
  is($smtpd->transaction->sender->format, '<[email protected]>', 'got the right sender');
  
  my $command = 'MAIL FROM:<[email protected]> SIZE=1230';
  is(($smtpd->command($command))[0], 250, $command);
  is($smtpd->transaction->sender->format, '<[email protected]>', 'got the right sender');
  
  
  
  
  1.1                  qpsmtpd/t/helo.t
  
  Index: helo.t
  ===================================================================
  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');
  
  
  
  
  1.1                  qpsmtpd/t/Test/Qpsmtpd.pm
  
  Index: Qpsmtpd.pm
  ===================================================================
  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;