@@ -63,6 +63,9 @@ PostgresNode - class representing PostgreSQL server instance
63
63
# Stop the server
64
64
$node->stop('fast');
65
65
66
+ # Find a free, unprivileged TCP port to bind some other service to
67
+ my $port = get_free_port();
68
+
66
69
=head1 DESCRIPTION
67
70
68
71
PostgresNode contains a set of routines able to work on a PostgreSQL node,
@@ -102,6 +105,7 @@ use Scalar::Util qw(blessed);
102
105
103
106
our @EXPORT = qw(
104
107
get_new_node
108
+ get_free_port
105
109
) ;
106
110
107
111
our ($use_tcp , $test_localhost , $test_pghost , $last_host_assigned ,
@@ -1071,9 +1075,68 @@ sub get_new_node
1071
1075
my $class = ' PostgresNode' ;
1072
1076
$class = shift if scalar (@_ ) % 2 != 1;
1073
1077
my ($name , %params ) = @_ ;
1074
- my $port_is_forced = defined $params {port };
1075
- my $found = $port_is_forced ;
1076
- my $port = $port_is_forced ? $params {port } : $last_port_assigned ;
1078
+
1079
+ # Select a port.
1080
+ my $port ;
1081
+ if (defined $params {port })
1082
+ {
1083
+ $port = $params {port };
1084
+ }
1085
+ else
1086
+ {
1087
+ # When selecting a port, we look for an unassigned TCP port number,
1088
+ # even if we intend to use only Unix-domain sockets. This is clearly
1089
+ # necessary on $use_tcp (Windows) configurations, and it seems like a
1090
+ # good idea on Unixen as well.
1091
+ $port = get_free_port();
1092
+ }
1093
+
1094
+ # Select a host.
1095
+ my $host = $test_pghost ;
1096
+ if ($params {own_host })
1097
+ {
1098
+ if ($use_tcp )
1099
+ {
1100
+ $last_host_assigned ++;
1101
+ $last_host_assigned > 254 and BAIL_OUT(" too many own_host nodes" );
1102
+ $host = ' 127.0.0.' . $last_host_assigned ;
1103
+ }
1104
+ else
1105
+ {
1106
+ $host = " $test_pghost /$name " ; # Assume $name =~ /^[-_a-zA-Z0-9]+$/
1107
+ mkdir $host ;
1108
+ }
1109
+ }
1110
+
1111
+ # Lock port number found by creating a new node
1112
+ my $node = $class -> new($name , $host , $port );
1113
+
1114
+ # Add node to list of nodes
1115
+ push (@all_nodes , $node );
1116
+
1117
+ return $node ;
1118
+ }
1119
+
1120
+ =pod
1121
+
1122
+ =item get_free_port()
1123
+
1124
+ Locate an unprivileged (high) TCP port that's not currently bound to
1125
+ anything. This is used by get_new_node, and is also exported for use
1126
+ by test cases that need to start other, non-Postgres servers.
1127
+
1128
+ Ports assigned to existing PostgresNode objects are automatically
1129
+ excluded, even if those servers are not currently running.
1130
+
1131
+ XXX A port available now may become unavailable by the time we start
1132
+ the desired service.
1133
+
1134
+ =cut
1135
+
1136
+ sub get_free_port
1137
+ {
1138
+ my $found = 0;
1139
+ my $port = $last_port_assigned ;
1077
1140
1078
1141
while ($found == 0)
1079
1142
{
@@ -1090,63 +1153,38 @@ sub get_new_node
1090
1153
$found = 0 if ($node -> port == $port );
1091
1154
}
1092
1155
1093
- # Check to see if anything else is listening on this TCP port. This
1094
- # is *necessary* on $use_tcp (Windows) configurations. Seek a port
1095
- # available for all possible listen_addresses values, for own_host
1096
- # nodes and so the caller can harness this port for the widest range
1097
- # of purposes. The 0.0.0.0 test achieves that for post-2006 Cygwin,
1098
- # which automatically sets SO_EXCLUSIVEADDRUSE. The same holds for
1099
- # MSYS (a Cygwin fork). Testing 0.0.0.0 is insufficient for Windows
1100
- # native Perl (https://stackoverflow.com/a/14388707), so we also test
1156
+ # Check to see if anything else is listening on this TCP port.
1157
+ # Seek a port available for all possible listen_addresses values,
1158
+ # so callers can harness this port for the widest range of purposes.
1159
+ # The 0.0.0.0 test achieves that for post-2006 Cygwin, which
1160
+ # automatically sets SO_EXCLUSIVEADDRUSE. The same holds for MSYS (a
1161
+ # Cygwin fork). Testing 0.0.0.0 is insufficient for Windows native
1162
+ # Perl (https://stackoverflow.com/a/14388707), so we also test
1101
1163
# individual addresses.
1102
1164
#
1103
- # This seems like a good idea on Unixen as well, even though we don't
1104
- # ask the postmaster to open a TCP port on Unix. On Non-Linux,
1105
- # non-Windows kernels, binding to 127.0.0.1/24 addresses other than
1106
- # 127.0.0.1 might fail with EADDRNOTAVAIL. Binding to 0.0.0.0 is
1107
- # unnecessary on non-Windows systems.
1108
- #
1109
- # XXX A port available now may become unavailable by the time we start
1110
- # the postmaster.
1165
+ # On non-Linux, non-Windows kernels, binding to 127.0.0/24 addresses
1166
+ # other than 127.0.0.1 might fail with EADDRNOTAVAIL. Binding to
1167
+ # 0.0.0.0 is unnecessary on non-Windows systems.
1111
1168
if ($found == 1)
1112
1169
{
1113
1170
foreach my $addr (qw( 127.0.0.1) ,
1114
1171
$use_tcp ? qw( 127.0.0.2 127.0.0.3 0.0.0.0) : ())
1115
1172
{
1116
- can_bind($addr , $port ) or $found = 0;
1173
+ if (!can_bind($addr , $port ))
1174
+ {
1175
+ $found = 0;
1176
+ last ;
1177
+ }
1117
1178
}
1118
1179
}
1119
1180
}
1120
1181
1121
1182
print " # Found port $port \n " ;
1122
1183
1123
- # Select a host.
1124
- my $host = $test_pghost ;
1125
- if ($params {own_host })
1126
- {
1127
- if ($use_tcp )
1128
- {
1129
- $last_host_assigned ++;
1130
- $last_host_assigned > 254 and BAIL_OUT(" too many own_host nodes" );
1131
- $host = ' 127.0.0.' . $last_host_assigned ;
1132
- }
1133
- else
1134
- {
1135
- $host = " $test_pghost /$name " ; # Assume $name =~ /^[-_a-zA-Z0-9]+$/
1136
- mkdir $host ;
1137
- }
1138
- }
1139
-
1140
- # Lock port number found by creating a new node
1141
- my $node = $class -> new($name , $host , $port );
1142
-
1143
- # Add node to list of nodes
1144
- push (@all_nodes , $node );
1184
+ # Update port for next time
1185
+ $last_port_assigned = $port ;
1145
1186
1146
- # And update port for next time
1147
- $port_is_forced or $last_port_assigned = $port ;
1148
-
1149
- return $node ;
1187
+ return $port ;
1150
1188
}
1151
1189
1152
1190
# Internal routine to check whether a host:port is available to bind
0 commit comments