@EXPORT = qw(tmpdir tcp_server tcp_connect require_git require_mods
run_script start_script key2sub xsys xsys_e xqx eml_load tick
have_xapian_compact json_utf8 setup_public_inboxes
- test_lei $lei $lei_out $lei_err $lei_opt);
+ tcp_host_port test_lei $lei $lei_out $lei_err $lei_opt);
require Test::More;
my @methods = grep(!/\W/, @Test::More::EXPORT);
eval(join('', map { "*$_=\\&Test::More::$_;" } @methods));
}
sub tcp_server () {
- IO::Socket::INET->new(
- LocalAddr => '127.0.0.1',
+ my %opt = (
ReuseAddr => 1,
Proto => 'tcp',
Type => Socket::SOCK_STREAM(),
Listen => 1024,
Blocking => 0,
- ) or BAIL_OUT "failed to create TCP server: $!";
+ );
+ eval {
+ die 'IPv4-only' if $ENV{TEST_IPV4_ONLY};
+ require IO::Socket::INET6;
+ IO::Socket::INET6->new(%opt, LocalAddr => '[::1]')
+ } || eval {
+ die 'IPv6-only' if $ENV{TEST_IPV6_ONLY};
+ IO::Socket::INET->new(%opt, LocalAddr => '127.0.0.1')
+ } || BAIL_OUT "failed to create TCP server: $! ($@)";
+}
+
+sub tcp_host_port ($) {
+ my ($s) = @_;
+ my ($h, $p) = ($s->sockhost, $s->sockport);
+ my $ipv4 = $s->sockdomain == Socket::AF_INET();
+ if (wantarray) {
+ $ipv4 ? ($h, $p) : ("[$h]", $p);
+ } else {
+ $ipv4 ? "$h:$p" : "[$h]:$p";
+ }
}
sub tcp_connect {
my ($dest, %opt) = @_;
- my $addr = $dest->sockhost . ':' . $dest->sockport;
- my $s = IO::Socket::INET->new(
+ my $addr = tcp_host_port($dest);
+ my $s = ref($dest)->new(
Proto => 'tcp',
Type => Socket::SOCK_STREAM(),
PeerAddr => $addr,
use_ok 'PublicInbox::ExtSearchIdx';
use_ok 'PublicInbox::OverIdx';
my $sock = tcp_server();
-my $host_port = $sock->sockhost . ':' . $sock->sockport;
+my $host_port = tcp_host_port($sock);
my ($home, $for_destroy) = tmpdir();
local $ENV{HOME} = $home;
mkdir "$home/.public-inbox" or BAIL_OUT $!;
}
} elsif ($path eq '/host-port') {
$code = 200;
- push @$body, "$env->{REMOTE_ADDR}:$env->{REMOTE_PORT}";
+ push @$body, "$env->{REMOTE_ADDR} $env->{REMOTE_PORT}";
} elsif ($path eq '/callback') {
return sub {
my ($res) = @_;
require_mods(qw(Plack::Util Plack::Builder HTTP::Date HTTP::Status));
use Digest::SHA qw(sha1_hex);
use IO::Handle ();
-use IO::Socket;
use IO::Socket::UNIX;
use Fcntl qw(:seek);
use Socket qw(IPPROTO_TCP TCP_NODELAY SOL_SOCKET);
Listen => 1024,
Type => Socket::SOCK_STREAM(),
Local => $_[0],
- );
+ ) or BAIL_OUT "bind + listen $_[0]: $!";
$s->blocking(0);
$s;
}
my $upath = "$tmpdir/s";
my $unix = unix_server($upath);
-ok($unix, 'UNIX socket created');
my $td;
my $spawn_httpd = sub {
my (@args) = @_;
ok($u, 'unix socket connected');
$u->write("GET /host-port HTTP/1.0\r\n\r\n");
$u->read(my $buf, 4096);
- like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!,
+ like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!,
'set REMOTE_ADDR and REMOTE_PORT for Unix socket');
}
$conn->write("GET /host-port HTTP/1.0\r\n\r\n");
$conn->read(my $buf, 4096);
my ($head, $body) = split(/\r\n\r\n/, $buf);
- my ($addr, $port) = split(/:/, $body);
- is($addr, $conn->sockhost, 'host matches addr');
+ my ($addr, $port) = split(/ /, $body);
+ is($addr, (tcp_host_port($conn))[0], 'host matches addr');
is($port, $conn->sockport, 'port matches');
}
SKIP: {
my $curl = which('curl') or skip('curl(1) missing', 4);
- my $base = 'http://' . $sock->sockhost . ':' . $sock->sockport;
+ my $base = 'http://'.tcp_host_port($sock);
my $url = "$base/sha1";
my ($r, $w);
pipe($r, $w) or die "pipe: $!";
my $out = "$tmpdir/stdout.log";
my $https = tcp_server();
my $td;
-my $https_addr = $https->sockhost . ':' . $https->sockport;
+my $https_addr = tcp_host_port($https);
for my $args (
[ "-lhttps://$https_addr/?key=$key,cert=$cert" ],
ok(-S $unix, 'UNIX socket was bound by -httpd');
sub check_sock ($) {
my ($unix) = @_;
- my $sock = IO::Socket::UNIX->new(Peer => $unix, Type => SOCK_STREAM);
- warn "E: $! connecting to $unix\n" unless defined $sock;
- ok($sock, 'client UNIX socket connected');
+ my $sock = IO::Socket::UNIX->new(Peer => $unix, Type => SOCK_STREAM)
+ // BAIL_OUT "E: $! connecting to $unix";
ok($sock->write("GET /host-port HTTP/1.0\r\n\r\n"),
'wrote req to server');
ok($sock->read(my $buf, 4096), 'read response');
- like($buf, qr!\r\n\r\n127\.0\.0\.1:0\z!,
+ like($buf, qr!\r\n\r\n127\.0\.0\.1 0\z!,
'set REMOTE_ADDR and REMOTE_PORT for Unix socket');
}
$im->add($mime);
$im->done($mime);
}
- ok($sock, 'sock created');
$cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err" ];
$td = start_script($cmd, undef, { 3 => $sock });
- my $host = $sock->sockhost;
- my $port = $sock->sockport;
+ my $http_pfx = 'http://'.tcp_host_port($sock);
{
my $bad = tcp_connect($sock);
print $bad "GETT / HTTP/1.0\r\n\r\n" or die;
}
is(xsys(qw(git clone -q --mirror),
- "http://$host:$port/$group", "$tmpdir/clone.git"),
+ "$http_pfx/$group", "$tmpdir/clone.git"),
0, 'smart clone successful');
# ensure dumb cloning works, too:
qw(config http.uploadpack false)),
0, 'disable http.uploadpack');
is(xsys(qw(git clone -q --mirror),
- "http://$host:$port/$group", "$tmpdir/dumb.git"),
+ "$http_pfx/$group", "$tmpdir/dumb.git"),
0, 'clone successful');
ok($td->kill, 'killed httpd');
}
}
-my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport;
-my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport;
+my $imaps_addr = tcp_host_port($imaps);
+my $starttls_addr = tcp_host_port($starttls);
my $env = { PI_CONFIG => $pi_config };
my $td;
my $out = "$tmpdir/stdout.log";
my $cmd = [ '-imapd', '-W0', "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, undef, { 3 => $sock }) or BAIL_OUT("-imapd: $?");
-my %mic_opt = (
- Server => $sock->sockhost,
- Port => $sock->sockport,
- Uid => 1,
-);
+my ($ihost, $iport) = tcp_host_port($sock);
+my %mic_opt = ( Server => $ihost, Port => $iport, Uid => 1 );
my $mic = $imap_client->new(%mic_opt);
my $pre_login_capa = $mic->capability;
is(grep(/\AAUTH=ANONYMOUS\z/, @$pre_login_capa), 1,
my $url = "http://example.com/i1";
my $inboxdir = "$tmpdir/watchimap";
my $cmd = ['-init', '-V2', '-Lbasic', $name, $inboxdir, $url, $addr];
- my ($ihost, $iport) = ($sock->sockhost, $sock->sockport);
my $imapurl = "imap://$ihost:$iport/inbox.i1.0";
run_script($cmd) or BAIL_OUT("init $name");
xsys(qw(git config), "--file=$home/.public-inbox/config",
require_mods(qw(DBD::SQLite Search::Xapian));
my $sock = tcp_server();
my ($tmpdir, $for_destroy) = tmpdir();
-my $http = 'http://'.$sock->sockhost.':'.$sock->sockport.'/';
+my $http = 'http://'.tcp_host_port($sock);
my ($ro_home, $cfg_path) = setup_public_inboxes;
my $cmd = [ qw(-httpd -W0), "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ];
my $td = start_script($cmd, { PI_CONFIG => $cfg_path }, { 3 => $sock });
}
}
-my $nntps_addr = $nntps->sockhost . ':' . $nntps->sockport;
-my $starttls_addr = $starttls->sockhost . ':' . $starttls->sockport;
+my $nntps_addr = tcp_host_port($nntps);
+my $starttls_addr = tcp_host_port($starttls);
my $env = { PI_CONFIG => $pi_config };
my $td;
require_mods(qw(DBD::SQLite));
require PublicInbox::InboxWritable;
use PublicInbox::Eml;
-use IO::Socket;
use Socket qw(IPPROTO_TCP TCP_NODELAY);
use Net::NNTP;
use Sys::Hostname;
my %opts;
my $sock = tcp_server();
+my $host_port = tcp_host_port($sock);
my $td;
my $len;
}
}
- ok($sock, 'sock created');
my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ];
$td = start_script($cmd, undef, { 3 => $sock });
- my $host_port = $sock->sockhost . ':' . $sock->sockport;
my $n = Net::NNTP->new($host_port);
my $list = $n->list;
ok(delete $list->{'x.y.z'}, 'deleted x.y.z group');
my @of = xqx([$lsof, '-p', $td->{pid}], undef, $noerr);
is(scalar(grep(/\(deleted\)/, @of)), 0, 'no deleted files');
};
- SKIP: { test_watch($tmpdir, $sock, $group) };
+ SKIP: { test_watch($tmpdir, $host_port, $group) };
{
setsockopt($s, IPPROTO_TCP, TCP_NODELAY, 1);
syswrite($s, 'HDR List-id 1-');
}
sub test_watch {
- my ($tmpdir, $sock, $group) = @_;
+ my ($tmpdir, $host_port, $group) = @_;
use_ok 'PublicInbox::Watch';
use_ok 'PublicInbox::InboxIdle';
use_ok 'PublicInbox::Config';
my $url = "http://example.com/i1";
my $inboxdir = "$tmpdir/watchnntp";
my $cmd = ['-init', '-V1', '-Lbasic', $name, $inboxdir, $url, $addr];
- my ($ihost, $iport) = ($sock->sockhost, $sock->sockport);
- my $nntpurl = "nntp://$ihost:$iport/$group";
+ my $nntpurl = "nntp://$host_port/$group";
run_script($cmd) or BAIL_OUT("init $name");
xsys(qw(git config), "--file=$home/.public-inbox/config",
"publicinbox.$name.watch",
my ($out, $err) = map { "$inboxdir/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, $env, { 3 => $sock });
- my ($h, $p) = ($sock->sockhost, $sock->sockport);
+ my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
Plack::Test::ExternalServer::test_psgi(client => $client);
}
my ($out, $err) = map { "$inboxdir/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, $env, { 3 => $sock });
- my ($h, $p) = ($sock->sockhost, $sock->sockport);
+ my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
Plack::Test::ExternalServer::test_psgi(client => $client);
$td->join('TERM');
my ($out, $err) = map { "$inboxdir/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, $env, { 3 => $sock });
- my ($h, $p) = ($sock->sockhost, $sock->sockport);
+ my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
Plack::Test::ExternalServer::test_psgi(client => $client);
}
$ibx->cleanup;
my $sock = tcp_server();
-ok($sock, 'sock created');
my $cmd = [ '-httpd', '-W0', "--stdout=$tmpdir/out", "--stderr=$tmpdir/err" ];
my $td = start_script($cmd, undef, { 3 => $sock });
-my ($host, $port) = ($sock->sockhost, $sock->sockport);
+my ($host, $port) = tcp_host_port($sock);
$sock = undef;
my @cmd;
;
close $fh or die "close: $!\n";
my $sock = tcp_server();
- ok($sock, 'sock created');
my $len;
my $cmd = [ '-nntpd', '-W0', "--stdout=$out", "--stderr=$err" ];
my $env = { PI_CONFIG => $pi_config };
my $td = start_script($cmd, $env, { 3 => $sock });
- my $host_port = $sock->sockhost . ':' . $sock->sockport;
+ my $host_port = tcp_host_port($sock);
my $n = Net::NNTP->new($host_port);
$n->group($group);
my $x = $n->xover('1-');
my ($out, $err) = map { "$inboxdir/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, $env, { 3 => $sock });
- my ($h, $p) = ($sock->sockhost, $sock->sockport);
+ my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
Plack::Test::ExternalServer::test_psgi(client => $client);
}
my $cfgfile = "$tmpdir/config";
my $v2 = "$tmpdir/v2";
my $sock = tcp_server();
- ok($sock, 'sock created');
- my ($host, $port) = ($sock->sockhost, $sock->sockport);
+ my ($host, $port) = tcp_host_port($sock);
my @clone = qw(git clone -q -s --bare);
is(xsys(@clone, $bare->{git_dir}, $alt), 0, 'clone shared repo');
my $err = "$tmpdir/stderr.log";
my $out = "$tmpdir/stdout.log";
my $sock = tcp_server();
-my $host = $sock->sockhost;
-my $port = $sock->sockport;
+my ($host, $port) = tcp_host_port($sock);
my $td;
my $get_maxrss = sub {
};
{
- ok($sock, 'sock created');
my $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err", $psgi ];
$td = start_script($cmd, undef, { 3 => $sock });
}
# not using multiple workers, here, since we want to increase
# the chance of tripping concurrency bugs within PublicInbox/HTTP*.pm
my $cmd = [ '-httpd', "--stdout=$out", "--stderr=$err", '-W0' ];
- my $host_port = $http->sockhost.':'.$http->sockport;
+ my $host_port = tcp_host_port($http);
push @$cmd, "-lhttp://$host_port";
my $url = "$host_port/test/$endpoint";
print STDERR "# CMD ". join(' ', @$cmd). "\n";
my $c = tcp_connect($sock);
like(readline($c), qr/CAPABILITY /, 'got greeting');
}
+
+my $host_port = tcp_host_port($sock);
my ($host, $port) = ($sock->sockhost, $sock->sockport);
my %pids;
my $sec = $ENV{TEST_PERSIST} // 0;
diag "TEST_PERSIST=$sec";
if ($sec) {
- diag "sleeping ${sec}s, imap://$host:$port/$mailbox available";
+ diag "sleeping ${sec}s, imap://$host_port/$mailbox available";
diag "tmpdir=$tmpdir (Maildirs available)";
diag "stdout=$out";
diag "stderr=$err";
# not using multiple workers, here, since we want to increase
# the chance of tripping concurrency bugs within PublicInbox/IMAP*.pm
my $cmd = [ '-imapd', "--stdout=$out", "--stderr=$err", '-W0' ];
- push @$cmd, '-limap://'.$imap->sockhost.':'.$imap->sockport;
+ push @$cmd, '-limap://'.tcp_host_port($imap);
if ($test_tls) {
my $imaps = tcp_server();
$rdr->{4} = $imaps;
- push @$cmd, '-limaps://'.$imaps->sockhost.':'.$imaps->sockport;
+ push @$cmd, '-limaps://'.tcp_host_port($imaps);
push @$cmd, "--cert=$cert", "--key=$key";
my $tls_opt = [
SSL_hostname => 'server.local',
EOF
close $fh or die "close: $!\n";
}
-my $imaps_addr = $imaps->sockhost . ':' . $imaps->sockport;
+my $imaps_addr = tcp_host_port($imaps);
my $env = { PI_CONFIG => $pi_config };
my $arg = $TEST_TLS ? [ "-limaps://$imaps_addr/?cert=$cert,key=$key" ] : [];
my $cmd = [ '-imapd', '-W0', @$arg, "--stdout=$out", "--stderr=$err" ];
open my $fh, '>', $_ or die "truncate: $!";
}
my $sock = tcp_server();
- ok($sock, 'sock created');
- $host_port = $sock->sockhost . ':' . $sock->sockport;
+ $host_port = tcp_host_port($sock);
# not using multiple workers, here, since we want to increase
# the chance of tripping concurrency bugs within PublicInbox/NNTP*.pm
use Net::NNTP;
my $inboxdir = $ENV{GIANT_INBOX_DIR} // $ENV{GIANT_PI_DIR};
plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless defined($inboxdir);
-my ($host_port, $group, %opts, $s, $td, $tmp_obj);
+my ($host_port, $group, $s, $td, $tmp_obj);
use PublicInbox::TestCommon;
if (($ENV{NNTP_TEST_URL} || '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) {
($host_port, $group) = ($1, $2);
$host_port .= ":119" unless index($host_port, ':') > 0;
+ my $six = substr($host_port, 0, 1) eq '[' ? '6' : '';
+ my $cls = "IO::Socket::INET$six";
+ $cls->new(Proto => 'tcp', Timeout => 1, PeerAddr => $host_port);
} else {
$group = 'inbox.test.perf.nntpd';
my $ibx = { inboxdir => $inboxdir, newsgroup => $group };
}
my $sock = tcp_server();
- ok($sock, 'sock created');
my $cmd = [ '-nntpd', '-W0' ];
$td = start_script($cmd, { PI_CONFIG => $pi_config }, { 3 => $sock });
- $host_port = $sock->sockhost . ':' . $sock->sockport;
+ $host_port = tcp_host_port($sock);
+ $s = tcp_connect($sock);
}
-%opts = (
- PeerAddr => $host_port,
- Proto => 'tcp',
- Timeout => 1,
-);
-$s = IO::Socket::INET->new(%opts);
-$s->autoflush(1);
my $buf = $s->getline;
like($buf, qr/\A201 .* ready - post via email\r\n/s, 'got greeting');
my ($out, $err) = map { "$tmpdir/std$_.log" } qw(out err);
my $cmd = [ qw(-httpd -W0), "--stdout=$out", "--stderr=$err" ];
my $td = start_script($cmd, undef, { 3 => $sock });
- my ($h, $p) = ($sock->sockhost, $sock->sockport);
-
+ my ($h, $p) = tcp_host_port($sock);
local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = "http://$h:$p";
while (($ibx_name, $urls) = each %$todo) {
Plack::Test::ExternalServer::test_psgi(client => $client);