Mercurial > hg > nginx-tests
diff lib/Test/Nginx/Stream.pm @ 1863:dbb7561a9441
Tests: reworked stream SSL tests to use IO::Socket::SSL.
Relevant infrastructure is provided in Test::Nginx::Stream. This also
ensures that SSL handshake and various read operations are guarded
with timeouts.
The stream_ssl_verify_client.t test uses IO::Socket::SSL::_get_ssl_object()
to access the Net::SSLeay object directly, as it seems to be the only
way to obtain CA list with IO::Socket::SSL. While not exactly correct,
this seems to be good enough for tests.
| author | Maxim Dounin <mdounin@mdounin.ru> |
|---|---|
| date | Thu, 18 May 2023 18:07:12 +0300 |
| parents | 1197c152215b |
| children | 6d3a8f4eb9b2 |
line wrap: on
line diff
--- a/lib/Test/Nginx/Stream.pm +++ b/lib/Test/Nginx/Stream.pm @@ -38,17 +38,38 @@ sub new { unshift(@_, "PeerAddr") if @_ == 1; - $self->{_socket} = IO::Socket::INET->new( - Proto => "tcp", - PeerAddr => '127.0.0.1', - @_ - ) - or die "Can't connect to nginx: $!\n"; + eval { + local $SIG{ALRM} = sub { die "timeout\n" }; + local $SIG{PIPE} = sub { die "sigpipe\n" }; + alarm(8); + + $self->{_socket} = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => '127.0.0.1', + @_ + ) + or die "Can't connect to nginx: $!\n"; - if ({@_}->{'SSL'}) { - require IO::Socket::SSL; - IO::Socket::SSL->start_SSL($self->{_socket}, @_) - or die $IO::Socket::SSL::SSL_ERROR . "\n"; + if ({@_}->{'SSL'}) { + require IO::Socket::SSL; + IO::Socket::SSL->start_SSL( + $self->{_socket}, + SSL_verify_mode => + IO::Socket::SSL::SSL_VERIFY_NONE(), + @_ + ) + or die $IO::Socket::SSL::SSL_ERROR . "\n"; + + my $s = $self->{_socket}; + log_in("ssl cipher: " . $s->get_cipher()); + log_in("ssl cert: " . $s->peer_certificate('issuer')); + } + + alarm(0); + }; + alarm(0); + if ($@) { + log_in("died: $@"); } $self->{_socket}->autoflush(1); @@ -56,6 +77,11 @@ sub new { return $self; } +sub DESTROY { + my $self = shift; + $self->{_socket}->close(); +} + sub write { my ($self, $message, %extra) = @_; my $s = $self->{_socket}; @@ -135,6 +161,11 @@ sub sockport { return $self->{_socket}->sockport(); } +sub socket { + my ($self) = @_; + $self->{_socket}; +} + ############################################################################### 1;