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
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);
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) {
20 "certs/ missing for $0, run ./certs/create-certs.perl";
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,
36 -primary_address => $addr,
37 indexlevel => 'basic',
39 $ibx = PublicInbox::InboxWritable->new($ibx, {nproc=>1});
42 open my $fh, '>', $pi_config or die "open: $!\n";
44 [publicinbox "nntpd-tls"]
51 close $fh or die "close: $!\n";
55 my $im = $ibx->importer(0);
56 my $eml = eml_load('t/data/0001.patch');
57 ok($im->add($eml), 'message added');
60 my $s = PublicInbox::SearchIdx->new($ibx, 1);
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" ];
71 # run_mode=0 ensures Test::More FDs don't get shared
72 my $td = start_script($cmd, $env, { 3 => $nntps, run_mode => 0 });
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',
79 my $ctx = IO::Socket::SSL::SSL_Context->new(%ssl_opt);
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 $@;
88 $ssl_opt{SSL_reuse_ctx} = $ctx;
89 $ssl_opt{SSL_startHandshake} = 0;
93 PeerAddr => $nntps_addr,
97 chomp(my $nfd = `/bin/sh -c 'ulimit -n'`);
99 ok($nfd > 0, 'positive FD count');
101 $nfd = $MAX_FD if $nfd >= $MAX_FD;
103 sub once { 0 }; # stops event loop
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);
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;
115 # one step through the event loop
116 # do a little work as we connect:
117 PublicInbox::DS::event_loop();
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 });
126 PublicInbox::DS::event_loop();
129 PublicInbox::DS->SetLoopTimeout(0);
130 PublicInbox::DS->SetPostLoopCallback(\&once);
133 my $pid = $td->{pid};
135 return if $^O ne 'linux';
136 open(my $f, '<', "/proc/$pid/status") or return;
137 diag(grep(/RssAnon/, <$f>));
141 # run the event loop normally, now:
143 PublicInbox::DS->SetLoopTimeout(-1);
144 PublicInbox::DS->SetPostLoopCallback(sub {
145 diag "done: ".time." $DONE";
148 PublicInbox::DS::event_loop();
151 is($nfd, $DONE, 'done');
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`;
157 PublicInbox::DS->Reset;
160 is($?, 0, 'no error in exited process');
165 use parent qw(PublicInbox::DS);
166 use PublicInbox::Syscall qw(EPOLLIN EPOLLOUT EPOLLONESHOT);
169 # return true if complete, false if incomplete (or failure)
170 sub connect_tls_step ($) {
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);
180 $self->drop('BUG? EAGAIN but '.PublicInbox::TLS::err());
187 # TLS negotiation happens in flush_write via {wbuf}
188 return unless $self->flush_write && $self->{sock};
190 if ($self->{step} == -2) {
191 $self->do_read(\(my $buf = ''), 128) or return;
192 $buf =~ /\A201 / or die "no greeting";
194 $self->write(\"COMPRESS DEFLATE\r\n");
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);
201 $self->write(\"DATE\r\n");
203 if ($self->{step} == 0) {
204 $self->do_read(\(my $buf = ''), 128) or return;
205 $buf =~ /\A201 / or die "no greeting";
207 $self->write(\"DATE\r\n");
209 if ($self->{step} == 1) {
210 $self->do_read(\(my $buf = ''), 128) or return;
211 $buf =~ /\A111 / or die 'no date';
214 $self->{step} = 2; # all done
216 die "$self->{step} Should never get here ". Dumper($self);
221 my ($class, $io) = @_;
222 my $self = bless {}, $class;
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
232 package NNTPCdeflate;
234 our @ISA = qw(NNTPC PublicInbox::DS);
235 use Compress::Raw::Zlib;
236 use PublicInbox::DSdeflate;
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;
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;