# HG changeset patch # User Sergey Kandaurov # Date 1428009098 -10800 # Node ID 481d705b8610a8404a5d1638ff6975eba49edea5 # Parent 3fcad5e66735886dc4c5c69f2b4fbd25f55a63a8 Tests: SSL support in mail backends. Socket is now embedded into every mail module. Socket methods are wrapped where appropriate. The new "SSL" extra flag specifies to accept connection over SSL. diff --git a/lib/Test/Nginx/IMAP.pm b/lib/Test/Nginx/IMAP.pm --- a/lib/Test/Nginx/IMAP.pm +++ b/lib/Test/Nginx/IMAP.pm @@ -15,35 +15,52 @@ use Socket qw/ CRLF /; use Test::Nginx; -use base qw/ IO::Socket::INET /; +sub new { + my $self = {}; + bless $self, shift @_; -sub new { - my $class = shift; - - my $self = $class->SUPER::new( + $self->{_socket} = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "127.0.0.1:8143", @_ ) or die "Can't connect to nginx: $!\n"; - $self->autoflush(1); + if ({@_}->{'SSL'}) { + require IO::Socket::SSL; + IO::Socket::SSL->start_SSL($self->{_socket}, @_) + or die $IO::Socket::SSL::SSL_ERROR . "\n"; + } + + $self->{_socket}->autoflush(1); return $self; } +sub eof { + my $self = shift; + return $self->{_socket}->eof(); +} + +sub print { + my ($self, $cmd) = @_; + log_out($cmd); + $self->{_socket}->print($cmd); +} + sub send { my ($self, $cmd) = @_; log_out($cmd); - $self->print($cmd . CRLF); + $self->{_socket}->print($cmd . CRLF); } sub read { my ($self) = @_; + my $socket = $self->{_socket}; eval { local $SIG{ALRM} = sub { die "timeout\n" }; alarm(3); - while (<$self>) { + while (<$socket>) { log_in($_); # XXX next if m/^\d\d\d-/; diff --git a/lib/Test/Nginx/POP3.pm b/lib/Test/Nginx/POP3.pm --- a/lib/Test/Nginx/POP3.pm +++ b/lib/Test/Nginx/POP3.pm @@ -15,35 +15,52 @@ use Socket qw/ CRLF /; use Test::Nginx; -use base qw/ IO::Socket::INET /; +sub new { + my $self = {}; + bless $self, shift @_; -sub new { - my $class = shift; - - my $self = $class->SUPER::new( + $self->{_socket} = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "127.0.0.1:8110", @_ ) or die "Can't connect to nginx: $!\n"; - $self->autoflush(1); + if ({@_}->{'SSL'}) { + require IO::Socket::SSL; + IO::Socket::SSL->start_SSL($self->{_socket}, @_) + or die $IO::Socket::SSL::SSL_ERROR . "\n"; + } + + $self->{_socket}->autoflush(1); return $self; } +sub eof { + my $self = shift; + return $self->{_socket}->eof(); +} + +sub print { + my ($self, $cmd) = @_; + log_out($cmd); + $self->{_socket}->print($cmd); +} + sub send { my ($self, $cmd) = @_; log_out($cmd); - $self->print($cmd . CRLF); + $self->{_socket}->print($cmd . CRLF); } sub read { my ($self) = @_; + my $socket = $self->{_socket}; eval { local $SIG{ALRM} = sub { die "timeout\n" }; alarm(3); - while (<$self>) { + while (<$socket>) { log_in($_); # XXX next if m/^\d\d\d-/; diff --git a/lib/Test/Nginx/SMTP.pm b/lib/Test/Nginx/SMTP.pm --- a/lib/Test/Nginx/SMTP.pm +++ b/lib/Test/Nginx/SMTP.pm @@ -15,35 +15,52 @@ use Socket qw/ CRLF /; use Test::Nginx; -use base qw/ IO::Socket::INET /; +sub new { + my $self = {}; + bless $self, shift @_; -sub new { - my $class = shift; - - my $self = $class->SUPER::new( + $self->{_socket} = IO::Socket::INET->new( Proto => "tcp", PeerAddr => "127.0.0.1:8025", @_ ) or die "Can't connect to nginx: $!\n"; - $self->autoflush(1); + if ({@_}->{'SSL'}) { + require IO::Socket::SSL; + IO::Socket::SSL->start_SSL($self->{_socket}, @_) + or die $IO::Socket::SSL::SSL_ERROR . "\n"; + } + + $self->{_socket}->autoflush(1); return $self; } +sub eof { + my $self = shift; + return $self->{_socket}->eof(); +} + +sub print { + my ($self, $cmd) = @_; + log_out($cmd); + $self->{_socket}->print($cmd); +} + sub send { my ($self, $cmd) = @_; log_out($cmd); - $self->print($cmd . CRLF); + $self->{_socket}->print($cmd . CRLF); } sub read { my ($self) = @_; + my $socket = $self->{_socket}; eval { local $SIG{ALRM} = sub { die "timeout\n" }; alarm(3); - while (<$self>) { + while (<$socket>) { log_in($_); next if m/^\d\d\d-/; last; diff --git a/mail_resolver.t b/mail_resolver.t --- a/mail_resolver.t +++ b/mail_resolver.t @@ -134,7 +134,6 @@ my $s = Test::Nginx::SMTP->new(); $s->send('QUIT'); $s->read(); -close $s; # Cached PTR prevents from querying bad ns on port 8083 @@ -150,7 +149,6 @@ close $s; $s->send('QUIT'); $s->read(); -close $s; # SERVFAIL @@ -166,7 +164,6 @@ close $s; $s->send('QUIT'); $s->read(); -close $s; # PTR with zero length RDATA @@ -182,7 +179,6 @@ close $s; $s->send('QUIT'); $s->read(); -close $s; # CNAME @@ -201,7 +197,6 @@ local $TODO = 'support for CNAME RR'; $s->send('QUIT'); $s->read(); -close $s; } @@ -222,7 +217,6 @@ local $TODO = 'support for uncompressed $s->send('QUIT'); $s->read(); -close $s; } @@ -241,7 +235,6 @@ local $TODO = 'PTR type checking'; $s->send('QUIT'); $s->read(); -close $s; } diff --git a/mail_smtp.t b/mail_smtp.t --- a/mail_smtp.t +++ b/mail_smtp.t @@ -214,7 +214,6 @@ my $s = Test::Nginx::SMTP->new(); $s = Test::Nginx::SMTP->new(); $s->read(); -log_out('HEL'); $s->print('HEL'); $s->send('O example.com'); $s->ok('split command');