@ -63,6 +63,9 @@ PostgresNode - class representing PostgreSQL server instance
# Stop the server
$ node - > stop ( 'fast' ) ;
# Find a free, unprivileged TCP port to bind some other service to
my $ port = get_free_port ( ) ;
= head1 DESCRIPTION
PostgresNode contains a set of routines able to work on a PostgreSQL node ,
@ -102,6 +105,7 @@ use Scalar::Util qw(blessed);
our @ EXPORT = qw(
get_new_node
get_free_port
) ;
our ( $ use_tcp , $ test_localhost , $ test_pghost , $ last_host_assigned ,
@ -1071,9 +1075,68 @@ sub get_new_node
my $ class = 'PostgresNode' ;
$ class = shift if scalar ( @ _ ) % 2 != 1 ;
my ( $ name , % params ) = @ _ ;
my $ port_is_forced = defined $ params { port } ;
my $ found = $ port_is_forced ;
my $ port = $ port_is_forced ? $ params { port } : $ last_port_assigned ;
# Select a port.
my $ port ;
if ( defined $ params { port } )
{
$ port = $ params { port } ;
}
else
{
# When selecting a port, we look for an unassigned TCP port number,
# even if we intend to use only Unix-domain sockets. This is clearly
# necessary on $use_tcp (Windows) configurations, and it seems like a
# good idea on Unixen as well.
$ port = get_free_port ( ) ;
}
# Select a host.
my $ host = $ test_pghost ;
if ( $ params { own_host } )
{
if ( $ use_tcp )
{
$ last_host_assigned + + ;
$ last_host_assigned > 254 and BAIL_OUT ( "too many own_host nodes" ) ;
$ host = '127.0.0.' . $ last_host_assigned ;
}
else
{
$ host = "$test_pghost/$name" ; # Assume $name =~ /^[-_a-zA-Z0-9]+$/
mkdir $ host ;
}
}
# Lock port number found by creating a new node
my $ node = $ class - > new ( $ name , $ host , $ port ) ;
# Add node to list of nodes
push ( @ all_nodes , $ node ) ;
return $ node ;
}
= pod
= item get_free_port ( )
Locate an unprivileged ( high ) TCP port that ' s not currently bound to
anything . This is used by get_new_node , and is also exported for use
by test cases that need to start other , non - Postgres servers .
Ports assigned to existing PostgresNode objects are automatically
excluded , even if those servers are not currently running .
XXX A port available now may become unavailable by the time we start
the desired service .
= cut
sub get_free_port
{
my $ found = 0 ;
my $ port = $ last_port_assigned ;
while ( $ found == 0 )
{
@ -1090,63 +1153,38 @@ sub get_new_node
$ found = 0 if ( $ node - > port == $ port ) ;
}
# Check to see if anything else is listening on this TCP port. This
# is *necessary* on $use_tcp (Windows) configurations. Seek a port
# available for all possible listen_addresses values, for own_host
# nodes and so the caller can harness this port for the widest range
# of purposes. The 0.0.0.0 test achieves that for post-2006 Cygwin,
# which automatically sets SO_EXCLUSIVEADDRUSE. The same holds for
# MSYS (a Cygwin fork). Testing 0.0.0.0 is insufficient for Windows
# native Perl (https://stackoverflow.com/a/14388707), so we also test
# Check to see if anything else is listening on this TCP port.
# Seek a port available for all possible listen_addresses values,
# so callers can harness this port for the widest range of purposes.
# The 0.0.0.0 test achieves that for post-2006 Cygwin, which
# automatically sets SO_EXCLUSIVEADDRUSE. The same holds for MSYS (a
# Cygwin fork). Testing 0.0.0.0 is insufficient for Windows native
# Perl (https://stackoverflow.com/a/14388707), so we also test
# individual addresses.
#
# This seems like a good idea on Unixen as well, even though we don't
# ask the postmaster to open a TCP port on Unix. On Non-Linux,
# non-Windows kernels, binding to 127.0.0.1/24 addresses other than
# 127.0.0.1 might fail with EADDRNOTAVAIL. Binding to 0.0.0.0 is
# unnecessary on non-Windows systems.
#
# XXX A port available now may become unavailable by the time we start
# the postmaster.
# On non-Linux, non-Windows kernels, binding to 127.0.0/24 addresses
# other than 127.0.0.1 might fail with EADDRNOTAVAIL. Binding to
# 0.0.0.0 is unnecessary on non-Windows systems.
if ( $ found == 1 )
{
foreach my $ addr ( qw( 127.0.0.1 ) ,
$ use_tcp ? qw( 127.0.0.2 127.0.0.3 0.0.0.0 ) : ( ) )
{
can_bind ( $ addr , $ port ) or $ found = 0 ;
if ( ! can_bind ( $ addr , $ port ) )
{
$ found = 0 ;
last ;
}
}
}
}
print "# Found port $port\n" ;
# Select a host.
my $ host = $ test_pghost ;
if ( $ params { own_host } )
{
if ( $ use_tcp )
{
$ last_host_assigned + + ;
$ last_host_assigned > 254 and BAIL_OUT ( "too many own_host nodes" ) ;
$ host = '127.0.0.' . $ last_host_assigned ;
}
else
{
$ host = "$test_pghost/$name" ; # Assume $name =~ /^[-_a-zA-Z0-9]+$/
mkdir $ host ;
}
}
# Lock port number found by creating a new node
my $ node = $ class - > new ( $ name , $ host , $ port ) ;
# Add node to list of nodes
push ( @ all_nodes , $ node ) ;
# Update port for next time
$ last_port_assigned = $ port ;
# And update port for next time
$ port_is_forced or $ last_port_assigned = $ port ;
return $ node ;
return $ port ;
}
# Internal routine to check whether a host:port is available to bind
Tom Lane
7 years ago