comparison 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
comparison
equal deleted inserted replaced
1862:7681a970f6bd 1863:dbb7561a9441
36 my $self = {}; 36 my $self = {};
37 bless $self, shift @_; 37 bless $self, shift @_;
38 38
39 unshift(@_, "PeerAddr") if @_ == 1; 39 unshift(@_, "PeerAddr") if @_ == 1;
40 40
41 $self->{_socket} = IO::Socket::INET->new( 41 eval {
42 Proto => "tcp", 42 local $SIG{ALRM} = sub { die "timeout\n" };
43 PeerAddr => '127.0.0.1', 43 local $SIG{PIPE} = sub { die "sigpipe\n" };
44 @_ 44 alarm(8);
45 )
46 or die "Can't connect to nginx: $!\n";
47 45
48 if ({@_}->{'SSL'}) { 46 $self->{_socket} = IO::Socket::INET->new(
49 require IO::Socket::SSL; 47 Proto => "tcp",
50 IO::Socket::SSL->start_SSL($self->{_socket}, @_) 48 PeerAddr => '127.0.0.1',
51 or die $IO::Socket::SSL::SSL_ERROR . "\n"; 49 @_
50 )
51 or die "Can't connect to nginx: $!\n";
52
53 if ({@_}->{'SSL'}) {
54 require IO::Socket::SSL;
55 IO::Socket::SSL->start_SSL(
56 $self->{_socket},
57 SSL_verify_mode =>
58 IO::Socket::SSL::SSL_VERIFY_NONE(),
59 @_
60 )
61 or die $IO::Socket::SSL::SSL_ERROR . "\n";
62
63 my $s = $self->{_socket};
64 log_in("ssl cipher: " . $s->get_cipher());
65 log_in("ssl cert: " . $s->peer_certificate('issuer'));
66 }
67
68 alarm(0);
69 };
70 alarm(0);
71 if ($@) {
72 log_in("died: $@");
52 } 73 }
53 74
54 $self->{_socket}->autoflush(1); 75 $self->{_socket}->autoflush(1);
55 76
56 return $self; 77 return $self;
78 }
79
80 sub DESTROY {
81 my $self = shift;
82 $self->{_socket}->close();
57 } 83 }
58 84
59 sub write { 85 sub write {
60 my ($self, $message, %extra) = @_; 86 my ($self, $message, %extra) = @_;
61 my $s = $self->{_socket}; 87 my $s = $self->{_socket};
133 sub sockport { 159 sub sockport {
134 my $self = shift; 160 my $self = shift;
135 return $self->{_socket}->sockport(); 161 return $self->{_socket}->sockport();
136 } 162 }
137 163
164 sub socket {
165 my ($self) = @_;
166 $self->{_socket};
167 }
168
138 ############################################################################### 169 ###############################################################################
139 170
140 1; 171 1;
141 172
142 ############################################################################### 173 ###############################################################################