# HG changeset patch # User Maxim Dounin # Date 1621387977 -10800 # Node ID d0025a0dead7440f16fa3743f574b08edf03c1e5 # Parent f13ead27f89c042ee11f4d310f01c9644005125e Tests: better timeout handling in mail tests. The eval + alarm model used previously does not work on Windows (see perlport(1) for alarm), so it was replaced with non-blocking I/O. 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 @@ -34,6 +34,7 @@ sub new { } $self->{_socket}->autoflush(1); + $self->{_read_buffer} = ''; return $self; } @@ -55,25 +56,39 @@ sub send { $self->{_socket}->print($cmd . CRLF); } +sub getline { + my ($self) = @_; + my $socket = $self->{_socket}; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + + while (IO::Select->new($socket)->can_read(8)) { + $socket->blocking(0); + my $n = $socket->sysread(my $buf, 1024); + $socket->blocking(1); + last unless $n; + + $self->{_read_buffer} .= $buf; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + }; +} + sub read { my ($self) = @_; my $socket = $self->{_socket}; - eval { - local $SIG{ALRM} = sub { die "timeout\n" }; - alarm(8); - while (<$socket>) { - log_in($_); - # XXX - next if m/^\d\d\d-/; - last; - } - alarm(0); - }; - alarm(0); - if ($@) { - log_in("died: $@"); - return undef; + + while (defined($_ = $self->getline())) { + log_in($_); + last; } + return $_; } 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 @@ -34,6 +34,7 @@ sub new { } $self->{_socket}->autoflush(1); + $self->{_read_buffer} = ''; return $self; } @@ -55,25 +56,39 @@ sub send { $self->{_socket}->print($cmd . CRLF); } +sub getline { + my ($self) = @_; + my $socket = $self->{_socket}; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + + while (IO::Select->new($socket)->can_read(8)) { + $socket->blocking(0); + my $n = $socket->sysread(my $buf, 1024); + $socket->blocking(1); + last unless $n; + + $self->{_read_buffer} .= $buf; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + }; +} + sub read { my ($self) = @_; my $socket = $self->{_socket}; - eval { - local $SIG{ALRM} = sub { die "timeout\n" }; - alarm(8); - while (<$socket>) { - log_in($_); - # XXX - next if m/^\d\d\d-/; - last; - } - alarm(0); - }; - alarm(0); - if ($@) { - log_in("died: $@"); - return undef; + + while (defined($_ = $self->getline())) { + log_in($_); + last; } + return $_; } 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 @@ -34,6 +34,7 @@ sub new { } $self->{_socket}->autoflush(1); + $self->{_read_buffer} = ''; return $self; } @@ -55,24 +56,40 @@ sub send { $self->{_socket}->print($cmd . CRLF); } +sub getline { + my ($self) = @_; + my $socket = $self->{_socket}; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + + while (IO::Select->new($socket)->can_read(8)) { + $socket->blocking(0); + my $n = $socket->sysread(my $buf, 1024); + $socket->blocking(1); + last unless $n; + + $self->{_read_buffer} .= $buf; + + if ($self->{_read_buffer} =~ /^(.*?\x0a)(.*)/ms) { + $self->{_read_buffer} = $2; + return $1; + } + }; +} + sub read { my ($self) = @_; my $socket = $self->{_socket}; - eval { - local $SIG{ALRM} = sub { die "timeout\n" }; - alarm(8); - while (<$socket>) { - log_in($_); - next if m/^\d\d\d-/; - last; - } - alarm(0); - }; - alarm(0); - if ($@) { - log_in("died: $@"); - return undef; + + while (defined($_ = $self->getline())) { + log_in($_); + next if m/^\d\d\d-/; + last; } + return $_; }