diff options
Diffstat (limited to 'xt/mem-nntpd-tls.t')
| -rw-r--r-- | xt/mem-nntpd-tls.t | 254 |
1 files changed, 254 insertions, 0 deletions
diff --git a/xt/mem-nntpd-tls.t b/xt/mem-nntpd-tls.t new file mode 100644 index 00000000..ec639a8b --- /dev/null +++ b/xt/mem-nntpd-tls.t @@ -0,0 +1,254 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# Idle client memory usage test +use v5.12.1; +use PublicInbox::TestCommon; +use File::Temp qw(tempdir); +use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET); +require_mods(qw(-nntpd)); +require PublicInbox::InboxWritable; +require PublicInbox::SearchIdx; +use PublicInbox::Syscall; +use PublicInbox::DS; +my $version = 2; # v2 needs newer git +require_git('2.6') if $version >= 2; +use_ok 'IO::Socket::SSL'; +my ($cert, $key) = qw(certs/server-cert.pem certs/server-key.pem); +unless (-r $key && -r $cert) { + plan skip_all => + "certs/ missing for $0, run ./certs/create-certs.perl"; +} +use_ok 'PublicInbox::TLS'; +my ($tmpdir, $for_destroy) = tmpdir(); +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $mainrepo = $tmpdir; +my $pi_config = "$tmpdir/pi_config"; +my $group = 'test-nntpd-tls'; +my $addr = $group . '@example.com'; +local $SIG{PIPE} = 'IGNORE'; # for NNTPC (below) +my $nntps = tcp_server(); +my $ibx = PublicInbox::Inbox->new({ + inboxdir => $mainrepo, + name => 'nntpd-tls', + version => $version, + -primary_address => $addr, + indexlevel => 'basic', +}); +$ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1}); +$ibx->init_inbox(0); +{ + open my $fh, '>', $pi_config or die "open: $!\n"; + print $fh <<EOF +[publicinbox "nntpd-tls"] + mainrepo = $mainrepo + address = $addr + indexlevel = basic + newsgroup = $group +EOF + ; + close $fh or die "close: $!\n"; +} + +{ + my $im = $ibx->importer(0); + my $eml = eml_load('t/data/0001.patch'); + ok($im->add($eml), 'message added'); + $im->done; + if ($version == 1) { + my $s = PublicInbox::SearchIdx->new($ibx, 1); + $s->index_sync; + } +} + +my $nntps_addr = tcp_host_port($nntps); +my $env = { PI_CONFIG => $pi_config }; +my $tls = $ENV{TLS} // 1; +my $args = $tls ? ["--cert=$cert", "--key=$key", "-lnntps://$nntps_addr"] : []; +my $cmd = [ '-nntpd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ]; + +# run_mode=0 ensures Test::More FDs don't get shared +my $td = start_script($cmd, $env, { 3 => $nntps, run_mode => 0 }); +my %ssl_opt = ( + SSL_hostname => 'server.local', + SSL_verifycn_name => 'server.local', + SSL_verify_mode => SSL_VERIFY_PEER(), + SSL_ca_file => 'certs/test-ca.pem', +); +my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt); + +# cf. https://rt.cpan.org/Ticket/Display.html?id=129463 +my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() }; +if ($mode && $ctx->{context}) { + eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) }; + warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@; +} + +$ssl_opt{SSL_reuse_ctx} = $ctx; +$ssl_opt{SSL_startHandshake} = 0; + +my %opt = ( + Proto => 'tcp', + PeerAddr => $nntps_addr, + Type => SOCK_STREAM, + Blocking => 0 +); +chomp(my $nfd = `/bin/sh -c 'ulimit -n'`); +$nfd -= 10; +ok($nfd > 0, 'positive FD count'); +my $MAX_FD = 10000; +$nfd = $MAX_FD if $nfd >= $MAX_FD; +our $DONE = 0; +sub once { 0 }; # stops event loop + +# setup the event loop so that it exits at every step +# while we're still doing connect(2) +$PublicInbox::DS::loop_timeout = 0; +local @PublicInbox::DS::post_loop_do = (\&once); + +foreach my $n (1..$nfd) { + my $io = tcp_connect($nntps, Blocking => 0); + $io = IO::Socket::SSL->start_SSL($io, %ssl_opt) if $tls; + NNTPC->new($io); + + # one step through the event loop + # do a little work as we connect: + PublicInbox::DS::event_loop(); + + # try not to overflow the listen() backlog: + if (!($n % 128) && $n != $DONE) { + diag("nr: ($n) $DONE/$nfd"); + $PublicInbox::DS::loop_timeout = -1; + @PublicInbox::DS::post_loop_do = (sub { $DONE != $n }); + + # clear the backlog: + PublicInbox::DS::event_loop(); + + # resume looping + $PublicInbox::DS::loop_timeout = 0; + @PublicInbox::DS::post_loop_do = (\&once); + } +} +my $pid = $td->{pid}; +my $dump_rss = sub { + return if $^O ne 'linux'; + open(my $f, '<', "/proc/$pid/status") or return; + diag(grep(/RssAnon/, <$f>)); +}; +$dump_rss->(); + +# run the event loop normally, now: +if ($DONE != $nfd) { + $PublicInbox::DS::loop_timeout = -1; + @PublicInbox::DS::post_loop_do = (sub { + diag "done: ".time." $DONE"; + $DONE != $nfd; + }); + PublicInbox::DS::event_loop(); +} + +is($nfd, $DONE, 'done'); +$dump_rss->(); +if ($^O eq 'linux') { + diag " SELF lsof | wc -l ".`lsof -p $$ |wc -l`; + diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`; +} +PublicInbox::DS->Reset; +$td->kill; +$td->join; +is($?, 0, 'no error in exited process'); +done_testing(); + +package NNTPC; +use v5.12; +use parent qw(PublicInbox::DS); +use PublicInbox::Syscall qw(EPOLLOUT EPOLLONESHOT); +use Data::Dumper; + +# return true if complete, false if incomplete (or failure) +sub connect_tls_step ($) { + my ($self) = @_; + my $sock = $self->{sock} or return; + return 1 if $sock->connect_SSL; + return $self->drop("$!") unless $!{EAGAIN}; + if (my $ev = PublicInbox::TLS::epollbit()) { + unshift @{$self->{wbuf}}, \&connect_tls_step; + PublicInbox::DS::epwait($self->{sock}, $ev | EPOLLONESHOT); + 0; + } else { + $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err()); + } +} + +sub event_step ($) { + my ($self) = @_; + + # TLS negotiation happens in flush_write via {wbuf} + return unless $self->flush_write && $self->{sock}; + + if ($self->{step} == -2) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A201 / or die "no greeting"; + $self->{step} = -1; + $self->write(\"COMPRESS DEFLATE\r\n"); + } + if ($self->{step} == -1) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A20[0-9] / or die "no compression $buf"; + NNTPCdeflate->enable($self); + $self->{step} = 1; + $self->write(\"DATE\r\n"); + } + if ($self->{step} == 0) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A201 / or die "no greeting"; + $self->{step} = 1; + $self->write(\"DATE\r\n"); + } + if ($self->{step} == 1) { + $self->do_read(\(my $buf = ''), 128) or return; + $buf =~ /\A111 / or die 'no date'; + no warnings 'once'; + $::DONE++; + $self->{step} = 2; # all done + } else { + die "$self->{step} Should never get here ". Dumper($self); + } +} + +sub new { + my ($class, $io) = @_; + my $self = bless {}, $class; + + # wait for connect(), and maybe SSL_connect() + $self->SUPER::new($io, EPOLLOUT|EPOLLONESHOT); + $self->{wbuf} = [ \&connect_tls_step ] if $io->can('connect_SSL'); + $self->{step} = -2; # determines where we start event_step + $self; +}; + +1; +package NNTPCdeflate; +use v5.12; +our @ISA = qw(NNTPC PublicInbox::DS); +use Compress::Raw::Zlib; +use PublicInbox::DSdeflate; +BEGIN { + *write = \&PublicInbox::DSdeflate::write; + *do_read = \&PublicInbox::DSdeflate::do_read; + *event_step = \&NNTPC::event_step; + *flush_write = \&PublicInbox::DS::flush_write; + *close = \&PublicInbox::DS::close; +} + +sub enable { + my ($class, $self) = @_; + my %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 ); + my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%ZIN_OPT); + die "Inflate->new failed: $err" if $err != Z_OK; + bless $self, $class; + $self->{zin} = $in; +} + +1; |