xt/mem-nntpd-tls.t

   1 #!perl -w
   2 # Copyright (C) all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 # Idle client memory usage test
   5 use v5.12.1;
   6 use PublicInbox::TestCommon;
   7 use File::Temp qw(tempdir);
   8 use Socket qw(SOCK_STREAM IPPROTO_TCP SOL_SOCKET);
   9 require_mods(qw(-nntpd));
  10 require PublicInbox::InboxWritable;
  11 require PublicInbox::SearchIdx;
  12 use PublicInbox::Syscall qw(:epoll);
  13 use PublicInbox::DS;
  14 my $version = 2; # v2 needs newer git
  15 require_git('2.6') if $version >= 2;
  16 use_ok 'IO::Socket::SSL';
  17 my ($cert, $key) = qw(certs/server-cert.pem certs/server-key.pem);
  18 unless (-r $key && -r $cert) {
  19         plan skip_all =>
  20                 "certs/ missing for $0, run ./certs/create-certs.perl";
  21 }
  22 use_ok 'PublicInbox::TLS';
  23 my ($tmpdir, $for_destroy) = tmpdir();
  24 my $err = "$tmpdir/stderr.log";
  25 my $out = "$tmpdir/stdout.log";
  26 my $mainrepo = $tmpdir;
  27 my $pi_config = "$tmpdir/pi_config";
  28 my $group = 'test-nntpd-tls';
  29 my $addr = $group . '@example.com';
  30 local $SIG{PIPE} = 'IGNORE'; # for NNTPC (below)
  31 my $nntps = tcp_server();
  32 my $ibx = PublicInbox::Inbox->new({
  33         inboxdir => $mainrepo,
  34         name => 'nntpd-tls',
  35         version => $version,
  36         -primary_address => $addr,
  37         indexlevel => 'basic',
  38 });
  39 $ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1});
  40 $ibx->init_inbox(0);
  41 {
  42         open my $fh, '>', $pi_config or die "open: $!\n";
  43         print $fh <<EOF
  44 [publicinbox "nntpd-tls"]
  45         mainrepo = $mainrepo
  46         address = $addr
  47         indexlevel = basic
  48         newsgroup = $group
  49 EOF
  50         ;
  51         close $fh or die "close: $!\n";
  52 }
  53
  54 {
  55         my $im = $ibx->importer(0);
  56         my $eml = eml_load('t/data/0001.patch');
  57         ok($im->add($eml), 'message added');
  58         $im->done;
  59         if ($version == 1) {
  60                 my $s = PublicInbox::SearchIdx->new($ibx, 1);
  61                 $s->index_sync;
  62         }
  63 }
  64
  65 my $nntps_addr = tcp_host_port($nntps);
  66 my $env = { PI_CONFIG => $pi_config };
  67 my $tls = $ENV{TLS} // 1;
  68 my $args = $tls ? ["--cert=$cert", "--key=$key", "-lnntps://$nntps_addr"] : [];
  69 my $cmd = [ '-nntpd', '-W0', @$args, "--stdout=$out", "--stderr=$err" ];
  70
  71 # run_mode=0 ensures Test::More FDs don't get shared
  72 my $td = start_script($cmd, $env, { 3 => $nntps, run_mode => 0 });
  73 my %ssl_opt = (
  74         SSL_hostname => 'server.local',
  75         SSL_verifycn_name => 'server.local',
  76         SSL_verify_mode => SSL_VERIFY_PEER(),
  77         SSL_ca_file => 'certs/test-ca.pem',
  78 );
  79 my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt);
  80
  81 # cf. https://rt.cpan.org/Ticket/Display.html?id=129463
  82 my $mode = eval { Net::SSLeay::MODE_RELEASE_BUFFERS() };
  83 if ($mode && $ctx->{context}) {
  84         eval { Net::SSLeay::CTX_set_mode($ctx->{context}, $mode) };
  85         warn "W: $@ (setting SSL_MODE_RELEASE_BUFFERS)\n" if $@;
  86 }
  87
  88 $ssl_opt{SSL_reuse_ctx} = $ctx;
  89 $ssl_opt{SSL_startHandshake} = 0;
  90
  91 my %opt = (
  92         Proto => 'tcp',
  93         PeerAddr => $nntps_addr,
  94         Type => SOCK_STREAM,
  95         Blocking => 0
  96 );
  97 chomp(my $nfd = `/bin/sh -c 'ulimit -n'`);
  98 $nfd -= 10;
  99 ok($nfd > 0, 'positive FD count');
 100 my $MAX_FD = 10000;
 101 $nfd = $MAX_FD if $nfd >= $MAX_FD;
 102 our $DONE = 0;
 103 sub once { 0 }; # stops event loop
 104
 105 # setup the event loop so that it exits at every step
 106 # while we're still doing connect(2)
 107 PublicInbox::DS->SetLoopTimeout(0);
 108 PublicInbox::DS->SetPostLoopCallback(\&once);
 109
 110 foreach my $n (1..$nfd) {
 111         my $io = tcp_connect($nntps, Blocking => 0);
 112         $io = IO::Socket::SSL->start_SSL($io, %ssl_opt) if $tls;
 113         NNTPC->new($io);
 114
 115         # one step through the event loop
 116         # do a little work as we connect:
 117         PublicInbox::DS::event_loop();
 118
 119         # try not to overflow the listen() backlog:
 120         if (!($n % 128) && $n != $DONE) {
 121                 diag("nr: ($n) $DONE/$nfd");
 122                 PublicInbox::DS->SetLoopTimeout(-1);
 123                 PublicInbox::DS->SetPostLoopCallback(sub { $DONE != $n });
 124
 125                 # clear the backlog:
 126                 PublicInbox::DS::event_loop();
 127
 128                 # resume looping
 129                 PublicInbox::DS->SetLoopTimeout(0);
 130                 PublicInbox::DS->SetPostLoopCallback(\&once);
 131         }
 132 }
 133 my $pid = $td->{pid};
 134 my $dump_rss = sub {
 135         return if $^O ne 'linux';
 136         open(my $f, '<', "/proc/$pid/status") or return;
 137         diag(grep(/RssAnon/, <$f>));
 138 };
 139 $dump_rss->();
 140
 141 # run the event loop normally, now:
 142 if ($DONE != $nfd) {
 143         PublicInbox::DS->SetLoopTimeout(-1);
 144         PublicInbox::DS->SetPostLoopCallback(sub {
 145                 diag "done: ".time." $DONE";
 146                 $DONE != $nfd;
 147         });
 148         PublicInbox::DS::event_loop();
 149 }
 150
 151 is($nfd, $DONE, 'done');
 152 $dump_rss->();
 153 if ($^O eq 'linux') {
 154         diag "  SELF lsof | wc -l ".`lsof -p $$ |wc -l`;
 155         diag "SERVER lsof | wc -l ".`lsof -p $pid |wc -l`;
 156 }
 157 PublicInbox::DS->Reset;
 158 $td->kill;
 159 $td->join;
 160 is($?, 0, 'no error in exited process');
 161 done_testing();
 162
 163 package NNTPC;
 164 use v5.12;
 165 use parent qw(PublicInbox::DS);
 166 use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT);
 167 use Data::Dumper;
 168
 169 # return true if complete, false if incomplete (or failure)
 170 sub connect_tls_step ($) {
 171         my ($self) = @_;
 172         my $sock = $self->{sock} or return;
 173         return 1 if $sock->connect_SSL;
 174         return $self->drop("$!") unless $!{EAGAIN};
 175         if (my $ev = PublicInbox::TLS::epollbit()) {
 176                 unshift @{$self->{wbuf}}, \&connect_tls_step;
 177                 PublicInbox::DS::epwait($self->{sock}, $ev | EPOLLONESHOT);
 178                 0;
 179         } else {
 180                 $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err());
 181         }
 182 }
 183
 184 sub event_step ($) {
 185         my ($self) = @_;
 186
 187         # TLS negotiation happens in flush_write via {wbuf}
 188         return unless $self->flush_write && $self->{sock};
 189
 190         if ($self->{step} == -2) {
 191                 $self->do_read(\(my $buf = ''), 128) or return;
 192                 $buf =~ /\A201 / or die "no greeting";
 193                 $self->{step} = -1;
 194                 $self->write(\"COMPRESS DEFLATE\r\n");
 195         }
 196         if ($self->{step} == -1) {
 197                 $self->do_read(\(my $buf = ''), 128) or return;
 198                 $buf =~ /\A20[0-9] / or die "no compression $buf";
 199                 NNTPCdeflate->enable($self);
 200                 $self->{step} = 1;
 201                 $self->write(\"DATE\r\n");
 202         }
 203         if ($self->{step} == 0) {
 204                 $self->do_read(\(my $buf = ''), 128) or return;
 205                 $buf =~ /\A201 / or die "no greeting";
 206                 $self->{step} = 1;
 207                 $self->write(\"DATE\r\n");
 208         }
 209         if ($self->{step} == 1) {
 210                 $self->do_read(\(my $buf = ''), 128) or return;
 211                 $buf =~ /\A111 / or die 'no date';
 212                 no warnings 'once';
 213                 $::DONE++;
 214                 $self->{step} = 2; # all done
 215         } else {
 216                 die "$self->{step} Should never get here ". Dumper($self);
 217         }
 218 }
 219
 220 sub new {
 221         my ($class, $io) = @_;
 222         my $self = bless {}, $class;
 223
 224         # wait for connect(), and maybe SSL_connect()
 225         $self->SUPER::new($io, EPOLLOUT|EPOLLONESHOT);
 226         $self->{wbuf} = [ \&connect_tls_step ] if $io->can('connect_SSL');
 227         $self->{step} = -2; # determines where we start event_step
 228         $self;
 229 };
 230
 231 1;
 232 package NNTPCdeflate;
 233 use v5.12;
 234 our @ISA = qw(NNTPC PublicInbox::DS);
 235 use Compress::Raw::Zlib;
 236 use PublicInbox::DSdeflate;
 237 BEGIN {
 238         *write = \&PublicInbox::DSdeflate::write;
 239         *do_read = \&PublicInbox::DSdeflate::do_read;
 240         *event_step = \&NNTPC::event_step;
 241         *flush_write = \&PublicInbox::DS::flush_write;
 242         *close = \&PublicInbox::DS::close;
 243 }
 244
 245 sub enable {
 246         my ($class, $self) = @_;
 247         my %ZIN_OPT = ( -WindowBits => -15, -AppendOutput => 1 );
 248         my ($in, $err) = Compress::Raw::Zlib::Inflate->new(%ZIN_OPT);
 249         die "Inflate->new failed: $err" if $err != Z_OK;
 250         bless $self, $class;
 251         $self->{zin} = $in;
 252 }
 253
 254 1;