mirror of
https://github.com/nginx/nginx.git
synced 2026-05-13 09:36:42 +00:00
Tests: add PROXY protocol v2 TLV auto-fill tests.
Three test files cover the auto-fill paths in the stream module: stream_proxy_protocol_v2_auto.t verifies that an SSL downstream listener auto-populates PP2_TYPE_ALPN, PP2_TYPE_AUTHORITY, and PP2_TYPE_SSL with ssl_version + ssl_cipher sub-TLVs on the upstream PP v2 header. A non-SSL listener emits a base header with no TLVs (silent skip). stream_proxy_protocol_v2_auto_override.t verifies that an explicit proxy_protocol_tlv X <value> replaces the auto-filled value for type X while other TLVs continue to auto-populate. stream_proxy_protocol_v2_auto_suppress.t verifies that an empty value (proxy_protocol_tlv X "") suppresses the auto-filled TLV. Covers both top-level TLVs (AUTHORITY) and SSL sub-TLVs (ssl_cipher).
This commit is contained in:
Vadim Zhestikov
parent
3d2464ee5a
commit
8551629d46
3 changed files with 618 additions and 0 deletions
229
t/stream_proxy_protocol_v2_auto.t
Normal file
229
t/stream_proxy_protocol_v2_auto.t
Normal file
|
|
@ -0,0 +1,229 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# (C) Nginx, Inc.
|
||||
|
||||
# Tests for PROXY protocol v2 auto-fill from downstream SSL session.
|
||||
# When `proxy_protocol_version 2` is set and the downstream is SSL, the
|
||||
# upstream PP v2 header carries auto-populated PP2_TYPE_SSL (with
|
||||
# sub-TLVs ssl_version, ssl_cipher), PP2_TYPE_ALPN, and PP2_TYPE_AUTHORITY.
|
||||
|
||||
###############################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use IO::Select;
|
||||
use IO::Socket::INET;
|
||||
use Socket qw/ inet_aton /;
|
||||
|
||||
BEGIN { use FindBin; chdir($FindBin::Bin); }
|
||||
|
||||
use lib 'lib';
|
||||
use Test::Nginx;
|
||||
|
||||
###############################################################################
|
||||
|
||||
select STDERR; $| = 1;
|
||||
select STDOUT; $| = 1;
|
||||
|
||||
eval { require IO::Socket::SSL; };
|
||||
plan(skip_all => 'IO::Socket::SSL not installed') if $@;
|
||||
|
||||
my $t = Test::Nginx->new()->has(qw/stream stream_ssl/)->has_daemon('openssl')
|
||||
->plan(14);
|
||||
|
||||
$t->write_file_expand('nginx.conf', <<'EOF');
|
||||
|
||||
%%TEST_GLOBALS%%
|
||||
|
||||
daemon off;
|
||||
|
||||
events {
|
||||
}
|
||||
|
||||
stream {
|
||||
%%TEST_GLOBALS_STREAM%%
|
||||
|
||||
# SSL downstream listener: auto-fill should populate SSL TLV, ALPN,
|
||||
# AUTHORITY.
|
||||
server {
|
||||
listen 127.0.0.1:%%PORT_8080%% ssl;
|
||||
ssl_certificate localhost.crt;
|
||||
ssl_certificate_key localhost.key;
|
||||
ssl_protocols TLSv1.2 TLSv1.3;
|
||||
ssl_alpn h2 http/1.1;
|
||||
proxy_pass 127.0.0.1:%%PORT_8082%%;
|
||||
proxy_protocol on;
|
||||
proxy_protocol_version 2;
|
||||
}
|
||||
|
||||
# Non-SSL downstream listener: auto-fill silently skips, no TLVs.
|
||||
server {
|
||||
listen 127.0.0.1:%%PORT_8081%%;
|
||||
proxy_pass 127.0.0.1:%%PORT_8082%%;
|
||||
proxy_protocol on;
|
||||
proxy_protocol_version 2;
|
||||
}
|
||||
}
|
||||
|
||||
EOF
|
||||
|
||||
$t->write_file('openssl.conf', <<EOF);
|
||||
[ req ]
|
||||
default_bits = 2048
|
||||
encrypt_key = no
|
||||
distinguished_name = req_distinguished_name
|
||||
[ req_distinguished_name ]
|
||||
EOF
|
||||
|
||||
my $d = $t->testdir();
|
||||
|
||||
system('openssl req -x509 -new '
|
||||
. "-config $d/openssl.conf -subj /CN=localhost/ "
|
||||
. "-out $d/localhost.crt -keyout $d/localhost.key "
|
||||
. ">>$d/openssl.out 2>&1") == 0
|
||||
or die "Can't create certificate: $!\n";
|
||||
|
||||
$t->run_daemon(\&stream_daemon, port(8082));
|
||||
$t->run();
|
||||
$t->waitforsocket('127.0.0.1:' . port(8082));
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $SIG = "\x0D\x0A\x0D\x0A\x00\x0D\x0A\x51\x55\x49\x54\x0A";
|
||||
|
||||
# ---- Case 1: SSL downstream listener ----
|
||||
|
||||
my $sock = IO::Socket::SSL->new(
|
||||
PeerHost => '127.0.0.1',
|
||||
PeerPort => port(8080),
|
||||
SSL_hostname => 'example.com',
|
||||
SSL_alpn_protocols => ['h2'],
|
||||
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
|
||||
) or die "SSL connect failed: $!,$IO::Socket::SSL::SSL_ERROR";
|
||||
|
||||
$sock->syswrite('hello');
|
||||
|
||||
my $data = '';
|
||||
my $sel = IO::Select->new($sock);
|
||||
while ($sel->can_read(2)) {
|
||||
my $n = $sock->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$data .= $chunk;
|
||||
}
|
||||
|
||||
is(substr($data, 0, 12), $SIG, 'ssl-auto v2 signature');
|
||||
is(unpack('C', substr($data, 12, 1)), 0x21, 'ssl-auto version+command');
|
||||
|
||||
my $addr_len = unpack('n', substr($data, 14, 2));
|
||||
cmp_ok($addr_len, '>', 12, 'ssl-auto header length > addr block');
|
||||
|
||||
my $tlvs = parse_tlvs(substr($data, 28, $addr_len - 12));
|
||||
my $payload = substr($data, 16 + $addr_len);
|
||||
|
||||
is(defined($tlvs->{0x01}) ? 1 : 0, 1, 'ssl-auto ALPN TLV present');
|
||||
is($tlvs->{0x01}, 'h2', 'ssl-auto ALPN value');
|
||||
|
||||
is(defined($tlvs->{0x02}) ? 1 : 0, 1, 'ssl-auto AUTHORITY TLV present');
|
||||
is($tlvs->{0x02}, 'example.com', 'ssl-auto AUTHORITY value');
|
||||
|
||||
ok(defined($tlvs->{0x20}), 'ssl-auto SSL TLV present');
|
||||
|
||||
my $ssl_body = $tlvs->{0x20};
|
||||
# SSL TLV body: client(1) + verify(4) + sub-TLVs
|
||||
my $sub = parse_tlvs(substr($ssl_body, 5));
|
||||
ok(defined($sub->{0x21}), 'ssl-auto sub-TLV ssl_version present');
|
||||
like($sub->{0x21}, qr/^TLSv1\.[23]$/, 'ssl-auto ssl_version value');
|
||||
ok(defined($sub->{0x23}), 'ssl-auto sub-TLV ssl_cipher present');
|
||||
cmp_ok(length($sub->{0x23}), '>', 0, 'ssl-auto ssl_cipher non-empty');
|
||||
|
||||
is($payload, 'hello', 'ssl-auto payload after PP v2 header');
|
||||
|
||||
# ---- Case 2: Non-SSL downstream listener (auto-fill silent-skip) ----
|
||||
|
||||
my $plain = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
PeerAddr => '127.0.0.1:' . port(8081),
|
||||
) or die "plain connect failed: $!";
|
||||
|
||||
$plain->syswrite('hello');
|
||||
|
||||
my $pdata = '';
|
||||
my $psel = IO::Select->new($plain);
|
||||
while ($psel->can_read(2)) {
|
||||
my $n = $plain->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$pdata .= $chunk;
|
||||
}
|
||||
|
||||
# 16 fixed + 12 addr block, no TLVs
|
||||
my $plen = unpack('n', substr($pdata, 14, 2));
|
||||
is($plen, 12, 'plain-auto no TLVs (header len = addr block only)');
|
||||
|
||||
###############################################################################
|
||||
|
||||
# Parse a sequence of PP v2 TLV records into { type => value } pairs.
|
||||
sub parse_tlvs {
|
||||
my ($buf) = @_;
|
||||
my %tlvs;
|
||||
my $off = 0;
|
||||
while ($off + 3 <= length($buf)) {
|
||||
my $type = unpack('C', substr($buf, $off, 1));
|
||||
my $len = unpack('n', substr($buf, $off + 1, 2));
|
||||
last if $off + 3 + $len > length($buf);
|
||||
$tlvs{$type} = substr($buf, $off + 3, $len);
|
||||
$off += 3 + $len;
|
||||
}
|
||||
return \%tlvs;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
|
||||
sub stream_daemon {
|
||||
my ($port) = @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalAddr => '127.0.0.1:' . $port,
|
||||
Listen => 5,
|
||||
Reuse => 1,
|
||||
) or die "Can't create listening socket: $!\n";
|
||||
|
||||
my $sel = IO::Select->new($server);
|
||||
|
||||
local $SIG{PIPE} = 'IGNORE';
|
||||
|
||||
while (my @ready = $sel->can_read) {
|
||||
foreach my $fh (@ready) {
|
||||
if ($server == $fh) {
|
||||
my $new = $fh->accept;
|
||||
$new->autoflush(1);
|
||||
$sel->add($new);
|
||||
|
||||
} elsif (stream_handle_client($fh)) {
|
||||
$sel->remove($fh);
|
||||
$fh->close;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub stream_handle_client {
|
||||
my ($client) = @_;
|
||||
|
||||
my $buffer = '';
|
||||
my $csel = IO::Select->new($client);
|
||||
while ($csel->can_read(0.5)) {
|
||||
my $n = $client->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$buffer .= $chunk;
|
||||
}
|
||||
|
||||
$client->syswrite($buffer);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
192
t/stream_proxy_protocol_v2_auto_override.t
Normal file
192
t/stream_proxy_protocol_v2_auto_override.t
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# (C) Nginx, Inc.
|
||||
|
||||
# Tests for PROXY protocol v2 auto-fill override via proxy_protocol_tlv.
|
||||
# An explicit proxy_protocol_tlv <type> <value> directive replaces the
|
||||
# auto-filled value for that TLV type, while other auto-fills still apply.
|
||||
|
||||
###############################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use IO::Select;
|
||||
use IO::Socket::INET;
|
||||
|
||||
BEGIN { use FindBin; chdir($FindBin::Bin); }
|
||||
|
||||
use lib 'lib';
|
||||
use Test::Nginx;
|
||||
|
||||
###############################################################################
|
||||
|
||||
select STDERR; $| = 1;
|
||||
select STDOUT; $| = 1;
|
||||
|
||||
eval { require IO::Socket::SSL; };
|
||||
plan(skip_all => 'IO::Socket::SSL not installed') if $@;
|
||||
|
||||
my $t = Test::Nginx->new()->has(qw/stream stream_ssl/)->has_daemon('openssl')
|
||||
->plan(7);
|
||||
|
||||
$t->write_file_expand('nginx.conf', <<'EOF');
|
||||
|
||||
%%TEST_GLOBALS%%
|
||||
|
||||
daemon off;
|
||||
|
||||
events {
|
||||
}
|
||||
|
||||
stream {
|
||||
%%TEST_GLOBALS_STREAM%%
|
||||
|
||||
server {
|
||||
listen 127.0.0.1:%%PORT_8080%% ssl;
|
||||
ssl_certificate localhost.crt;
|
||||
ssl_certificate_key localhost.key;
|
||||
ssl_protocols TLSv1.2 TLSv1.3;
|
||||
ssl_alpn h2 http/1.1;
|
||||
proxy_pass 127.0.0.1:%%PORT_8081%%;
|
||||
proxy_protocol on;
|
||||
proxy_protocol_version 2;
|
||||
|
||||
# Override ssl_version with a forced literal; other SSL sub-TLVs
|
||||
# (ssl_cipher) still auto-populate.
|
||||
proxy_protocol_tlv ssl_version "forced-v1.0";
|
||||
|
||||
# Override ALPN with a different literal.
|
||||
proxy_protocol_tlv alpn "override-alpn";
|
||||
|
||||
# Override AUTHORITY with a different literal.
|
||||
proxy_protocol_tlv authority "override.example";
|
||||
}
|
||||
}
|
||||
|
||||
EOF
|
||||
|
||||
$t->write_file('openssl.conf', <<EOF);
|
||||
[ req ]
|
||||
default_bits = 2048
|
||||
encrypt_key = no
|
||||
distinguished_name = req_distinguished_name
|
||||
[ req_distinguished_name ]
|
||||
EOF
|
||||
|
||||
my $d = $t->testdir();
|
||||
|
||||
system('openssl req -x509 -new '
|
||||
. "-config $d/openssl.conf -subj /CN=localhost/ "
|
||||
. "-out $d/localhost.crt -keyout $d/localhost.key "
|
||||
. ">>$d/openssl.out 2>&1") == 0
|
||||
or die "Can't create certificate: $!\n";
|
||||
|
||||
$t->run_daemon(\&stream_daemon, port(8081));
|
||||
$t->run();
|
||||
$t->waitforsocket('127.0.0.1:' . port(8081));
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $sock = IO::Socket::SSL->new(
|
||||
PeerHost => '127.0.0.1',
|
||||
PeerPort => port(8080),
|
||||
SSL_hostname => 'example.com',
|
||||
SSL_alpn_protocols => ['h2'],
|
||||
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
|
||||
) or die "SSL connect failed: $!,$IO::Socket::SSL::SSL_ERROR";
|
||||
|
||||
$sock->syswrite('hello');
|
||||
|
||||
my $data = '';
|
||||
my $sel = IO::Select->new($sock);
|
||||
while ($sel->can_read(2)) {
|
||||
my $n = $sock->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$data .= $chunk;
|
||||
}
|
||||
|
||||
my $addr_len = unpack('n', substr($data, 14, 2));
|
||||
my $tlvs = parse_tlvs(substr($data, 28, $addr_len - 12));
|
||||
|
||||
is($tlvs->{0x01}, 'override-alpn', 'ALPN overridden by user value');
|
||||
is($tlvs->{0x02}, 'override.example', 'AUTHORITY overridden by user value');
|
||||
|
||||
ok(defined($tlvs->{0x20}), 'SSL TLV still emitted');
|
||||
|
||||
my $ssl_body = $tlvs->{0x20};
|
||||
my $sub = parse_tlvs(substr($ssl_body, 5));
|
||||
|
||||
is($sub->{0x21}, 'forced-v1.0', 'ssl_version overridden by user');
|
||||
ok(defined($sub->{0x23}), 'ssl_cipher still auto-populated');
|
||||
cmp_ok(length($sub->{0x23}), '>', 0, 'ssl_cipher value non-empty');
|
||||
|
||||
my $payload = substr($data, 16 + $addr_len);
|
||||
is($payload, 'hello', 'override payload after PP v2 header');
|
||||
|
||||
###############################################################################
|
||||
|
||||
sub parse_tlvs {
|
||||
my ($buf) = @_;
|
||||
my %tlvs;
|
||||
my $off = 0;
|
||||
while ($off + 3 <= length($buf)) {
|
||||
my $type = unpack('C', substr($buf, $off, 1));
|
||||
my $len = unpack('n', substr($buf, $off + 1, 2));
|
||||
last if $off + 3 + $len > length($buf);
|
||||
$tlvs{$type} = substr($buf, $off + 3, $len);
|
||||
$off += 3 + $len;
|
||||
}
|
||||
return \%tlvs;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
|
||||
sub stream_daemon {
|
||||
my ($port) = @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalAddr => '127.0.0.1:' . $port,
|
||||
Listen => 5,
|
||||
Reuse => 1,
|
||||
) or die "Can't create listening socket: $!\n";
|
||||
|
||||
my $sel = IO::Select->new($server);
|
||||
|
||||
local $SIG{PIPE} = 'IGNORE';
|
||||
|
||||
while (my @ready = $sel->can_read) {
|
||||
foreach my $fh (@ready) {
|
||||
if ($server == $fh) {
|
||||
my $new = $fh->accept;
|
||||
$new->autoflush(1);
|
||||
$sel->add($new);
|
||||
|
||||
} elsif (stream_handle_client($fh)) {
|
||||
$sel->remove($fh);
|
||||
$fh->close;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub stream_handle_client {
|
||||
my ($client) = @_;
|
||||
|
||||
my $buffer = '';
|
||||
my $csel = IO::Select->new($client);
|
||||
while ($csel->can_read(0.5)) {
|
||||
my $n = $client->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$buffer .= $chunk;
|
||||
}
|
||||
|
||||
$client->syswrite($buffer);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
197
t/stream_proxy_protocol_v2_auto_suppress.t
Normal file
197
t/stream_proxy_protocol_v2_auto_suppress.t
Normal file
|
|
@ -0,0 +1,197 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# (C) Nginx, Inc.
|
||||
|
||||
# Tests for PROXY protocol v2 auto-fill suppression via empty value.
|
||||
# An empty proxy_protocol_tlv <type> "" suppresses both user override
|
||||
# and auto-fill for that TLV type.
|
||||
|
||||
###############################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use IO::Select;
|
||||
use IO::Socket::INET;
|
||||
|
||||
BEGIN { use FindBin; chdir($FindBin::Bin); }
|
||||
|
||||
use lib 'lib';
|
||||
use Test::Nginx;
|
||||
|
||||
###############################################################################
|
||||
|
||||
select STDERR; $| = 1;
|
||||
select STDOUT; $| = 1;
|
||||
|
||||
eval { require IO::Socket::SSL; };
|
||||
plan(skip_all => 'IO::Socket::SSL not installed') if $@;
|
||||
|
||||
my $t = Test::Nginx->new()->has(qw/stream stream_ssl/)->has_daemon('openssl')
|
||||
->plan(8);
|
||||
|
||||
$t->write_file_expand('nginx.conf', <<'EOF');
|
||||
|
||||
%%TEST_GLOBALS%%
|
||||
|
||||
daemon off;
|
||||
|
||||
events {
|
||||
}
|
||||
|
||||
stream {
|
||||
%%TEST_GLOBALS_STREAM%%
|
||||
|
||||
server {
|
||||
listen 127.0.0.1:%%PORT_8080%% ssl;
|
||||
ssl_certificate localhost.crt;
|
||||
ssl_certificate_key localhost.key;
|
||||
ssl_protocols TLSv1.2 TLSv1.3;
|
||||
ssl_alpn h2 http/1.1;
|
||||
proxy_pass 127.0.0.1:%%PORT_8081%%;
|
||||
proxy_protocol on;
|
||||
proxy_protocol_version 2;
|
||||
|
||||
# Suppress top-level AUTHORITY auto-fill.
|
||||
proxy_protocol_tlv authority "";
|
||||
|
||||
# Suppress ssl_cipher sub-TLV inside auto-filled SSL TLV.
|
||||
proxy_protocol_tlv ssl_cipher "";
|
||||
}
|
||||
}
|
||||
|
||||
EOF
|
||||
|
||||
$t->write_file('openssl.conf', <<EOF);
|
||||
[ req ]
|
||||
default_bits = 2048
|
||||
encrypt_key = no
|
||||
distinguished_name = req_distinguished_name
|
||||
[ req_distinguished_name ]
|
||||
EOF
|
||||
|
||||
my $d = $t->testdir();
|
||||
|
||||
system('openssl req -x509 -new '
|
||||
. "-config $d/openssl.conf -subj /CN=localhost/ "
|
||||
. "-out $d/localhost.crt -keyout $d/localhost.key "
|
||||
. ">>$d/openssl.out 2>&1") == 0
|
||||
or die "Can't create certificate: $!\n";
|
||||
|
||||
$t->run_daemon(\&stream_daemon, port(8081));
|
||||
$t->run();
|
||||
$t->waitforsocket('127.0.0.1:' . port(8081));
|
||||
|
||||
###############################################################################
|
||||
|
||||
my $sock = IO::Socket::SSL->new(
|
||||
PeerHost => '127.0.0.1',
|
||||
PeerPort => port(8080),
|
||||
SSL_hostname => 'example.com',
|
||||
SSL_alpn_protocols => ['h2'],
|
||||
SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(),
|
||||
) or die "SSL connect failed: $!,$IO::Socket::SSL::SSL_ERROR";
|
||||
|
||||
$sock->syswrite('hello');
|
||||
|
||||
my $data = '';
|
||||
my $sel = IO::Select->new($sock);
|
||||
while ($sel->can_read(2)) {
|
||||
my $n = $sock->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$data .= $chunk;
|
||||
}
|
||||
|
||||
my $addr_len = unpack('n', substr($data, 14, 2));
|
||||
my $tlvs = parse_tlvs(substr($data, 28, $addr_len - 12));
|
||||
|
||||
# Suppressed
|
||||
is(defined($tlvs->{0x02}) ? 1 : 0, 0, 'AUTHORITY suppressed by empty value');
|
||||
|
||||
# Still auto-populated
|
||||
is($tlvs->{0x01}, 'h2', 'ALPN still auto-filled');
|
||||
ok(defined($tlvs->{0x20}), 'SSL TLV still present');
|
||||
|
||||
my $ssl_body = $tlvs->{0x20};
|
||||
my $sub = parse_tlvs(substr($ssl_body, 5));
|
||||
|
||||
# ssl_cipher suppressed
|
||||
is(defined($sub->{0x23}) ? 1 : 0, 0, 'ssl_cipher suppressed by empty value');
|
||||
|
||||
# ssl_version still auto-filled
|
||||
ok(defined($sub->{0x21}), 'ssl_version still auto-filled');
|
||||
like($sub->{0x21}, qr/^TLSv1\.[23]$/, 'ssl_version value sensible');
|
||||
|
||||
# Sanity: confirm both suppressions in one assertion that the SSL TLV
|
||||
# isn't unexpectedly large.
|
||||
cmp_ok(length($ssl_body), '<', 50, 'SSL TLV body shrunk by suppression');
|
||||
|
||||
my $payload = substr($data, 16 + $addr_len);
|
||||
is($payload, 'hello', 'suppress payload after PP v2 header');
|
||||
|
||||
###############################################################################
|
||||
|
||||
sub parse_tlvs {
|
||||
my ($buf) = @_;
|
||||
my %tlvs;
|
||||
my $off = 0;
|
||||
while ($off + 3 <= length($buf)) {
|
||||
my $type = unpack('C', substr($buf, $off, 1));
|
||||
my $len = unpack('n', substr($buf, $off + 1, 2));
|
||||
last if $off + 3 + $len > length($buf);
|
||||
$tlvs{$type} = substr($buf, $off + 3, $len);
|
||||
$off += 3 + $len;
|
||||
}
|
||||
return \%tlvs;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
|
||||
sub stream_daemon {
|
||||
my ($port) = @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalAddr => '127.0.0.1:' . $port,
|
||||
Listen => 5,
|
||||
Reuse => 1,
|
||||
) or die "Can't create listening socket: $!\n";
|
||||
|
||||
my $sel = IO::Select->new($server);
|
||||
|
||||
local $SIG{PIPE} = 'IGNORE';
|
||||
|
||||
while (my @ready = $sel->can_read) {
|
||||
foreach my $fh (@ready) {
|
||||
if ($server == $fh) {
|
||||
my $new = $fh->accept;
|
||||
$new->autoflush(1);
|
||||
$sel->add($new);
|
||||
|
||||
} elsif (stream_handle_client($fh)) {
|
||||
$sel->remove($fh);
|
||||
$fh->close;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub stream_handle_client {
|
||||
my ($client) = @_;
|
||||
|
||||
my $buffer = '';
|
||||
my $csel = IO::Select->new($client);
|
||||
while ($csel->can_read(0.5)) {
|
||||
my $n = $client->sysread(my $chunk, 65536);
|
||||
last unless $n;
|
||||
$buffer .= $chunk;
|
||||
}
|
||||
|
||||
$client->syswrite($buffer);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
Loading…
Add table
Add a link
Reference in a new issue