Hello community,
here is the log from the commit of package perl-Test-TCP for openSUSE:Factory
checked in at 2016-04-22 16:23:12
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Test-TCP (Old)
and /work/SRC/openSUSE:Factory/.perl-Test-TCP.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Test-TCP"
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-Test-TCP/perl-Test-TCP.changes
2015-10-08 08:24:32.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.perl-Test-TCP.new/perl-Test-TCP.changes
2016-04-22 16:23:13.000000000 +0200
@@ -1,0 +2,10 @@
+Mon Mar 21 12:05:39 UTC 2016 - co...@suse.com
+
+- updated to 2.15
+ see /usr/share/doc/packages/perl-Test-TCP/Changes
+
+ 2.15 2016-03-15T00:25:52Z
+
+ - Add listen_socket function and listen option for race-free operation
+
+-------------------------------------------------------------------
Old:
----
Test-TCP-2.14.tar.gz
New:
----
Test-TCP-2.15.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Test-TCP.spec ++++++
--- /var/tmp/diff_new_pack.TMG6Xp/_old 2016-04-22 16:23:13.000000000 +0200
+++ /var/tmp/diff_new_pack.TMG6Xp/_new 2016-04-22 16:23:13.000000000 +0200
@@ -1,7 +1,7 @@
#
# spec file for package perl-Test-TCP
#
-# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Test-TCP
-Version: 2.14
+Version: 2.15
Release: 0
%define cpan_name Test-TCP
Summary: Testing Tcp Program
++++++ Test-TCP-2.14.tar.gz -> Test-TCP-2.15.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/Changes new/Test-TCP-2.15/Changes
--- old/Test-TCP-2.14/Changes 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/Changes 2016-03-15 01:26:52.000000000 +0100
@@ -1,5 +1,9 @@
Revision history for Perl module Test::TCP
+2.15 2016-03-15T00:25:52Z
+
+ - Add listen_socket function and listen option for race-free operation
+
2.14 2015-09-29T22:36:44Z
- Fix race condition in t/10_oo.t(exodist)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/MANIFEST new/Test-TCP-2.15/MANIFEST
--- old/Test-TCP-2.14/MANIFEST 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/MANIFEST 2016-03-15 01:26:52.000000000 +0100
@@ -22,6 +22,7 @@
t/11_net_empty_port.t
t/12_pass_wait_port_options.t
t/13_undef_port.t
+t/14_listen.t
t/Server.pm
xt/02_perlcritic.t
xt/04_dependents.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/META.json new/Test-TCP-2.15/META.json
--- old/Test-TCP-2.14/META.json 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/META.json 2016-03-15 01:26:52.000000000 +0100
@@ -67,7 +67,7 @@
},
"Test::TCP" : {
"file" : "lib/Test/TCP.pm",
- "version" : "2.14"
+ "version" : "2.15"
},
"Test::TCP::CheckPort" : {
"file" : "lib/Test/TCP/CheckPort.pm"
@@ -84,7 +84,7 @@
"web" : "https://github.com/tokuhirom/Test-TCP";
}
},
- "version" : "2.14",
+ "version" : "2.15",
"x_contributors" : [
"tokuhirom <tokuhirom@d0d07461-0603-4401-acd4-de1884942a52>",
"mattn <mattn@d0d07461-0603-4401-acd4-de1884942a52>",
@@ -105,7 +105,8 @@
"Christian Walde <walde.christ...@googlemail.com>",
"Tatsuhiko Miyagawa <miyag...@gmail.com>",
"Tatsuhiko Miyagawa <miyag...@bulknews.net>",
- "Chad Granum <exodi...@gmail.com>"
+ "Chad Granum <exodi...@gmail.com>",
+ "Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>"
],
"x_serialization_backend" : "JSON::PP version 2.27300"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/META.yml new/Test-TCP-2.15/META.yml
--- old/Test-TCP-2.14/META.yml 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/META.yml 2016-03-15 01:26:52.000000000 +0100
@@ -30,7 +30,7 @@
file: lib/Net/EmptyPort.pm
Test::TCP:
file: lib/Test/TCP.pm
- version: '2.14'
+ version: '2.15'
Test::TCP::CheckPort:
file: lib/Test/TCP/CheckPort.pm
requires:
@@ -44,7 +44,7 @@
bugtracker: https://github.com/tokuhirom/Test-TCP/issues
homepage: https://github.com/tokuhirom/Test-TCP
repository: git://github.com/tokuhirom/Test-TCP.git
-version: '2.14'
+version: '2.15'
x_contributors:
- 'tokuhirom <tokuhirom@d0d07461-0603-4401-acd4-de1884942a52>'
- 'mattn <mattn@d0d07461-0603-4401-acd4-de1884942a52>'
@@ -66,4 +66,5 @@
- 'Tatsuhiko Miyagawa <miyag...@gmail.com>'
- 'Tatsuhiko Miyagawa <miyag...@bulknews.net>'
- 'Chad Granum <exodi...@gmail.com>'
+ - 'Dagfinn Ilmari Mannsåker <ilm...@ilmari.org>'
x_serialization_backend: 'CPAN::Meta::YAML version 0.017'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/Makefile.PL
new/Test-TCP-2.15/Makefile.PL
--- old/Test-TCP-2.14/Makefile.PL 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/Makefile.PL 2016-03-15 01:26:52.000000000 +0100
@@ -12,7 +12,7 @@
my %WriteMakefileArgs = (
NAME => 'Test::TCP',
DISTNAME => 'Test-TCP',
- VERSION => '2.14',
+ VERSION => '2.15',
EXE_FILES => [glob('script/*'), glob('bin/*')],
CONFIGURE_REQUIRES => {
"ExtUtils::MakeMaker" => 0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/README.md new/Test-TCP-2.15/README.md
--- old/Test-TCP-2.14/README.md 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/README.md 2016-03-15 01:26:52.000000000 +0100
@@ -7,15 +7,16 @@
use Test::TCP;
my $server = Test::TCP->new(
+ listen => 1,
code => sub {
- my $port = shift;
+ my $socket = shift;
...
},
);
my $client = MyClient->new(host => '127.0.0.1', port => $server->port);
undef $server; # kill child process on DESTROY
-Using memcached:
+If using a server that can only accept a port number, e.g. memcached:
use Test::TCP;
@@ -30,17 +31,32 @@
my $memd = Cache::Memcached->new({servers => ['127.0.0.1:' .
$memcached->port]});
...
+**N.B.**: This is vulnerable to race conditions, if another process binds
+to the same port after
[Net::EmptyPort](https://metacpan.org/pod/Net::EmptyPort) found it available.
+
And functional interface is available:
use Test::TCP;
test_tcp(
+ listen => 1,
+ client => sub {
+ my ($port, $server_pid) = @_;
+ # send request to the server
+ },
+ server => sub {
+ my $socket = shift;
+ # run server, calling $socket->accept
+ },
+ );
+
+ test_tcp(
client => sub {
my ($port, $server_pid) = @_;
# send request to the server
},
server => sub {
my $port = shift;
- # run server
+ # run server, binding to $port
},
);
@@ -55,12 +71,13 @@
Functional interface.
test_tcp(
+ listen => 1,
client => sub {
my $port = shift;
# send request to the server
},
server => sub {
- my $port = shift;
+ my $socket = shift;
# run server
},
# optional
@@ -69,6 +86,9 @@
max_wait => 3, # seconds
);
+ If `listen` is false, `server` is instead passed a port number that
+ was free before it was called.
+
- wait\_port
wait_port(8080);
@@ -91,7 +111,9 @@
- $args{code}: CodeRef
- The callback function. Argument for callback function is:
`$code->($pid)`.
+ The callback function. Argument for callback function is:
+ `$code->($socket)` or `$code->($port)`,
+ depending on the value of `listen`.
This parameter is required.
@@ -103,6 +125,11 @@
_Default: 10_
+ - $args{listen} : Boolean
+
+ If true, open a listening socket and pass this to the callback.
+ Otherwise find a free port and pass the number of it to the callback.
+
- $server->start()
Start the server process. Normally, you don't need to call this method.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/lib/Net/EmptyPort.pm
new/Test-TCP-2.15/lib/Net/EmptyPort.pm
--- old/Test-TCP-2.14/lib/Net/EmptyPort.pm 2015-09-30 00:38:45.000000000
+0200
+++ new/Test-TCP-2.15/lib/Net/EmptyPort.pm 2016-03-15 01:26:52.000000000
+0100
@@ -6,12 +6,18 @@
use Time::HiRes ();
our @EXPORT = qw/ can_bind empty_port check_port wait_port /;
+our @EXPORT_OK = qw/ listen_socket /;
sub can_bind {
my ($host, $port, $proto) = @_;
- $port ||= 0;
+ defined _listen_socket($host, $port, $proto);
+}
+
+sub _listen_socket {
+ my ($host, $port, $proto) = @_;
+ $port ||= 0;
$proto ||= 'tcp';
- my $s = IO::Socket::IP->new(
+ IO::Socket::IP->new(
(($proto eq 'udp') ? () : (Listen => 5)),
LocalAddr => $host,
LocalPort => $port,
@@ -19,7 +25,12 @@
V6Only => 1,
(($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
);
- defined $s;
+}
+
+sub listen_socket {
+ my ($host, $proto) = @{$_[0]}{qw(host proto)};
+ $host = '127.0.0.1' unless defined $host;
+ return _listen_socket($host, undef, $proto);
}
# get a empty port on 49152 .. 65535
@@ -131,6 +142,9 @@
use Net::EmptyPort qw(empty_port check_port);
+ # get a socket listening on a random free port
+ my $socket = listen_socket();
+
# get a random free port
my $port = empty_port();
@@ -147,6 +161,30 @@
=over 4
+=item C<< listen_socket() >>
+
+=item C<< listen_socket(\%args) >>
+
+
+ my $socket = listen_socket();
+
+Returns a socket listening on a free port.
+
+The function recognizes the following keys in the hashref argument.
+
+=over 4
+
+=item C<< host >>
+
+The address on which to listen. Default is C<< 127.0.0.1 >>.
+
+=item C<< proto >>
+
+Name of the protocol. Default is C<< tcp >>.
+You can get an UDP socket by specifying C<< udp >>.
+
+=back
+
=item C<< empty_port() >>
=item C<< empty_port(\%args) >>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/lib/Test/TCP.pm
new/Test-TCP-2.15/lib/Test/TCP.pm
--- old/Test-TCP-2.14/lib/Test/TCP.pm 2015-09-30 00:38:45.000000000 +0200
+++ new/Test-TCP-2.15/lib/Test/TCP.pm 2016-03-15 01:26:52.000000000 +0100
@@ -2,9 +2,8 @@
use strict;
use warnings;
use 5.00800;
-our $VERSION = '2.14';
+our $VERSION = '2.15';
use base qw/Exporter/;
-use IO::Socket::INET;
use Test::SharedFork 0.12;
use Test::More ();
use Config;
@@ -69,7 +68,16 @@
_my_pid => $$,
%args,
}, $class;
- $self->{port} ||= empty_port({ host => $self->{host} });
+ if ($self->{listen}) {
+ $self->{socket} ||= Net::EmptyPort::listen_socket({
+ host => $self->{host},
+ proto => $self->{proto},
+ }) or die "Cannot listen: $!";
+ $self->{port} = $self->{socket}->sockport;
+ }
+ else {
+ $self->{port} ||= empty_port({ host => $self->{host} });
+ }
$self->start()
if $self->{auto_start};
return $self;
@@ -85,10 +93,11 @@
if ( $pid ) { # parent process.
$self->{pid} = $pid;
- Test::TCP::wait_port({ host => $self->{host}, port => $self->port,
max_wait => $self->{max_wait} });
+ Test::TCP::wait_port({ host => $self->{host}, port => $self->port,
max_wait => $self->{max_wait} })
+ unless $self->{socket};
return;
} else { # child process
- $self->{code}->($self->port);
+ $self->{code}->($self->{socket} || $self->port);
# should not reach here
if (kill 0, $self->{_my_pid}) { # warn only parent process still exists
warn("[Test::TCP] Child process does not block(PID: $$, PPID:
$self->{_my_pid})");
@@ -159,15 +168,16 @@
use Test::TCP;
my $server = Test::TCP->new(
+ listen => 1,
code => sub {
- my $port = shift;
+ my $socket = shift;
...
},
);
my $client = MyClient->new(host => '127.0.0.1', port => $server->port);
undef $server; # kill child process on DESTROY
-Using memcached:
+If using a server that can only accept a port number, e.g. memcached:
use Test::TCP;
@@ -182,17 +192,32 @@
my $memd = Cache::Memcached->new({servers => ['127.0.0.1:' .
$memcached->port]});
...
+B<N.B.>: This is vulnerable to race conditions, if another process binds
+to the same port after L<Net::EmptyPort> found it available.
+
And functional interface is available:
use Test::TCP;
test_tcp(
+ listen => 1,
+ client => sub {
+ my ($port, $server_pid) = @_;
+ # send request to the server
+ },
+ server => sub {
+ my $socket = shift;
+ # run server, calling $socket->accept
+ },
+ );
+
+ test_tcp(
client => sub {
my ($port, $server_pid) = @_;
# send request to the server
},
server => sub {
my $port = shift;
- # run server
+ # run server, binding to $port
},
);
@@ -209,12 +234,13 @@
Functional interface.
test_tcp(
+ listen => 1,
client => sub {
my $port = shift;
# send request to the server
},
server => sub {
- my $port = shift;
+ my $socket = shift;
# run server
},
# optional
@@ -223,6 +249,8 @@
max_wait => 3, # seconds
);
+If C<listen> is false, C<server> is instead passed a port number that
+was free before it was called.
=item wait_port
@@ -252,7 +280,9 @@
=item $args{code}: CodeRef
-The callback function. Argument for callback function is: C<< $code->($pid) >>.
+The callback function. Argument for callback function is:
+C<< $code->($socket) >> or C<< $code->($port) >>,
+depending on the value of C<listen>.
This parameter is required.
@@ -264,6 +294,11 @@
I<Default: 10>
+=item $args{listen} : Boolean
+
+If true, open a listening socket and pass this to the callback.
+Otherwise find a free port and pass the number of it to the callback.
+
=back
=item $server->start()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Test-TCP-2.14/t/14_listen.t
new/Test-TCP-2.15/t/14_listen.t
--- old/Test-TCP-2.14/t/14_listen.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Test-TCP-2.15/t/14_listen.t 2016-03-15 01:26:52.000000000 +0100
@@ -0,0 +1,32 @@
+use warnings;
+use strict;
+use Test::More;
+use Test::TCP;
+use Test::SharedFork;
+use IO::Socket::IP;
+
+test_tcp(
+ client => sub {
+ my ($port, $pid) = @_;
+ ok $port, 'got port';
+ ok my $sock = IO::Socket::IP->new(
+ PeerPort => $port,
+ PeerHost => '127.0.0.1',
+ Proto => 'tcp',
+ V6Only => 1,
+ ), 'connected' or die "Cannot open client socket: $!";
+
+ ok($sock->print("foo\n"), "send 1");
+ is(<$sock>, "foo\n", "recv 1");
+ },
+ server => sub {
+ my ($sock) = @_;
+ while (my $remote = $sock->accept) {
+ note "new request";
+ $remote->print(scalar <$remote>);
+ }
+ },
+ listen => 1,
+);
+
+done_testing;
